Runtime:
Understanding the Microsoft Access Runtime Engine
Introducción a las Extensiones para programadores de Access 2007 y a Access 2007 Runtime
Introducción a las Extensiones para programadores de Access 2007 y a Access 2007 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 DoubleDim 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
