''- aggiunti cursori, con relative proprietα ed eventi
''- modificato indicatore di posizione, sostituendo con oggetto linea
''- aggiunte pagine proprietα generale e cursori
''- aggiunta gestione del minimo per la scala
Public Enum rlrBorderStyle
rlrNoBorder = 0
rlrSunken = 1
rlrSunkenOuter = 2
rlrRaised = 3
rlrRaisedInner = 4
rlrBump = 5
rlrEtched = 6
End Enum
Public Enum rlrOrientationConstants
rlrHorizontal = 0
rlrVertical = 1
End Enum
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 ' tabella colori in RGB
Private Const pixR As Integer = 3
Private Const pixG As Integer = 2
Private Const pixB As Integer = 1
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Enum RulerModeConst
Millimetri = 0
Inch = 1
Pixel = 2
Twips = 3
End Enum
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Valori predefiniti proprietα:
Const m_def_Minimo = 0
Const m_def_Locked = False
Const m_def_Position = False
Const m_def_RulerScaleMode = 0
Const m_def_BorderStyle = 2
Const m_Def_Orientation = 0
'Variabili proprietα:
Dim m_Minimo As Single
Dim m_Locked As Boolean
Dim m_Position As Boolean
Dim m_MarginColor As OLE_COLOR
Dim m_lMargineSx As Long
Dim m_lMargineDx As Long
Dim m_lRulerSxTop As Long
Dim m_lRulerSxBot As Long
Dim m_lRulerDx As Long
Dim m_BorderStyle As rlrBorderStyle
Dim m_bPositionVisible As Boolean
Dim m_Orientation As rlrOrientationConstants
Dim m_RulerScaleMode As Variant
Dim X1 As Single
Dim RScale As Long
'Dichiarazioni di eventi:
Event Click()
Event DblClick()
Event MargineSxChanged(X As Long)
Event MargineDxChanged(X As Long)
Event RulerSxBotChanged(X As Long) 'MappingInfo=picRulerSxBot,picRulerSxBot,-1,MouseMove
Event RulerSxBotMouseDown()
Event RulerSxBotMouseUp()
Event RulerSxTopChanged(X As Long) 'MappingInfo=picRulerSxTop,picRulerSxTop,-1,MouseMove
Event RulerSxTopMouseDown()
Event RulerSxTopMouseUp()
Event RulerDxChanged(X As Long) 'MappingInfo=picRulerDx,picRulerDx,-1,MouseMove
Event RulerDxMouseDown()
Event RulerDxMouseUp()
Public Property Get BorderStyle() As rlrBorderStyle
Attribute BorderStyle.VB_Description = "Restituisce o imposta lo stile del bordo di un oggetto"
BorderStyle = m_BorderStyle
End Property
Public Property Let BorderStyle(New_Val As rlrBorderStyle)
m_BorderStyle = New_Val
picRighello.Cls
EdgeSubClass picRighello.hWnd, New_Val
pDrawRuler
PropertyChanged "BorderStyle"
End Property
Public Property Get Position() As Boolean
Attribute Position.VB_Description = "Visualizza o nasconde l'indicatore di posizione del cursore"
