Pàgines

Oct 3, 2010

MS-Acces

Runtime:

Convert Twips to Píxeles
'''''''''''' Per convertir twips a pixels
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Const WU_LOGPIXELSX = 88
Public Const WU_LOGPIXELSY = 90
Public Const X_HOR    As Long = &H0
Public Const X_VERT   As Long = &H1
'''''''''''' Per convertir twips a pixels


Public Function TwipsToPixels(lngTwips As Long, lngDirection As Long) As Long
   'Handle to device
   Dim lngDC As Long
   Dim lngPixelsPerInch As Long
   Const nTwipsPerInch = 1440
   lngDC = GetDC(0)


   Select Case lngDirection
    Case X_HOR                  ' els pixels no son quadrats
      lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
    Case X_VERT
      lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
   End Select
   lngDC = ReleaseDC(0, lngDC)
   TwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function


Public Function PixelsToTwips(lngTwips As Long, lngDirection As Long) As Long
   'Handle to device
   Dim lngDC As Long
   Dim lngPixelsPerInch As Long
   Const nTwipsPerInch = 1440
   lngDC = GetDC(0)


   Select Case lngDirection
    Case X_HOR                  ' els pixels no son quadrats
      lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
    Case X_VERT
      lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
   End Select
   lngDC = ReleaseDC(0, lngDC)
   PixelsToTwips = (lngTwips / lngPixelsPerInch) * nTwipsPerInch
End Function

Imprimir texto a la impresora predeterminada con Access Basic (1.x/2.0)
    'Obre el canal de la impressora
    Open "\\estacio4\zebra" For Output As #1
  
    'Configuració de la impressora
    Print #1, "^XA~TA-008~JSN^LT0^MMT^MNW^MTT^PON^PMN^LH0,0^JMA^PR4,4^MD0^JUS^LRN^CI27^XZ"
  
    'Nou format d'etiqueta i Llargada Etiqueta
    Print #1, "^XA^LL0200"
  
    'Amplada
    Print #1, "^PW639"
  
    'Codi de Barres de la 1ª Etiqueta
    Print #1, "^BY2,3,32^FT133,118^BCN,,N,N"
    Print #1, "^FD>;" & Ref_Imprimir & "^FS"
  
    'Codi de Barres de la 2ª Etiqueta
    Print #1, "^BY2,3,32^FT357,118^BCN,,N,N"
    Print #1, "^FD>;" & Ref_Imprimir & "^FS"
  
    'Referència 1ª etiqueta
    Print #1, "^FT162,139^A0N,23,24^FD" & Ref_Maca & "^FS"
  
    'Referència 2ª etiqueta
    Print #1, "^FT386,139^A0N,23,24^FD" & Ref_Maca & "^FS"
  
    'Imprimeix el nobre necessari d'etiquetes (Sortida de 2)
    Print #1, "^PQ" & CStr(Q2) & "," & CStr(Q2) & ",1,N^XZ"
  
    'Tanca el canal de la Impressora
    Close #1

.NET Framework Solutions—In Search of the Lost Win32 API
Per moure una finestra clicant el botó 'BotoDesp' (p.65)

'Constantes para SendMessage
Public Const WM_LBUTTONUP = &H202
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010
Public Const MOUSE_MOVE = &HF012
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Boolean


Private Sub BotoDesp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    BotoDesp.Picture = DirectoriRecursos & "P" & Right(BotoDesp.Picture, 9)
    Clicat = True
    Call SendMessage(Me.hwnd, WM_SYSCOMMAND, MOUSE_MOVE, 0)
End Sub

Private Sub BotoDesp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Clicat And Button = 1 Then
        Call SetWindowPos(Application.hWndAccessApp, HWND_TOP, -200, -200, 10, 10, 0)
        Call ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub


Private Sub BotoDesp_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    BotoDesp.Picture = DirectoriRecursos & Right(BotoDesp.Picture, 9)
    Clicat = False
End Sub

Espais de color HSL and HSV



Function RGBtoHSL(lh As Long, ls As Long, ll As Long, lR As Long, lG As Long, lB As Long)
  ' lR, lG, lB valors 0-255
  ' retorna
  ' lh angle en graus (0-360)
  ' ls i ll (0-100)
    Dim h As Double
    Dim s As Double
    Dim l As Double
    Dim r As Double         ' Valors 0 a 1
    Dim g As Double         ' Valors 0 a 1
    Dim B As Double         ' Valors 0 a 1
    Dim lmax As Double
    Dim lmin As Double
                                              
    r = lR / 255
    g = lG / 255
    B = lB / 255
  
    lmax = max(max(r, g), B)
    lmin = min(min(r, g), B)
    If lmax = lmin Then
        h = 0
    Else
        h = IIf(lmax = r, ((60 * (g - B) / (lmax - lmin)) + 360) Mod 360, h)
        h = IIf(lmax = g, (60 * (B - r) / (lmax - lmin)) + 120, h)
        h = IIf(lmax = B, (60 * (r - g) / (lmax - lmin)) + 240, h)
    End If
    s = IIf(lmax = 0, 0, 1 - (lmin / lmax))
    l = lmax

    lh = h
    ls = s * 100
    ll = l * 100
End Function

Function HSLtoRGB(lh As Long, ls As Long, ll As Long, lR As Long, lG As Long, lB As Long) As Long
  ' lh angle en graus (0-360)
  ' ls i ll (0-100)
  ' retorna  lR, lG, lB valors 0-255 i  HSLtoRGB com a long
    Dim s As Double
    Dim l As Double
    Dim r As Double         ' Valors 0 a 1
    Dim g As Double         ' Valors 0 a 1
    Dim B As Double         ' Valors 0 a 1
    Dim q As Double
    Dim p As Double
    Dim hi As Double
    Dim F As Double
    Dim t As Double
                                                    
    s = ls / 100            ' Valors en Percentatge
    l = ll / 100            ' Valors en Percentatge

    hi = Int(lh / 60) Mod 6
    F = (lh / 60) - Int(lh / 60)
    p = l * (1 - s)
    q = l * (1 - F * s)
    t = l * (1 - (1 - F) * s)
  
    r = Choose(hi + 1, l, q, p, p, t, l)
    g = Choose(hi + 1, t, l, l, q, p, p)
    B = Choose(hi + 1, p, p, t, l, l, q)

    lR = r * 255
    lG = g * 255
    lB = B * 255
    HSLtoRGB = &H10000 * lB + &H100 * lG + lR
End Function


Function LongToRGB(lColor As Long, lR As Long, lG As Long, lB As Long) As Long
    lR = lColor And &HFF
    lG = (lColor And &H100FF00) / &H100
    lB = (lColor And &HFF0000) / &H10000
End Function

s'usa:

    Dim r As Long
    Dim g As Long
    Dim b As Long
    Dim h As Long
    Dim s As Long
    Dim l As Long

    h = lTo     ' 0-259
    l = lLluminositat  ' 0-100
    s = lSaturacio    ' 0-100
    ctrl.BackColor = HSLtoRGB(h, s, l, r, g, b)    ' ens retorna el color com a 'long' i també r, g, b