Private Type POINTAPI ' general use. Typically used for cursor location
X As Long
Y As Long
End Type
Private Type PosProps
pL As Boolean
pR As Boolean
pB As Boolean
pt As Boolean
End Type
Private Type Size
sWidth As Integer
sHeight As Integer
End Type
' Enums
Public Enum Appearance
[peFlat] = 0
[pe3D] = 1
End Enum
#If False Then
Private peFlat, pe3D
#End If
Public Enum AlignNB
[peLeft] = 0
[peRight] = 1
[peCenter] = 2
End Enum
#If False Then
Private peLeft, peRight, peCenter
#End If
Public Enum BorderStyle
[peNone] = 0
[peFixed_Single] = 1
End Enum
#If False Then
Private peNone, peFixed_Single
#End If
Public Enum LenzSizeProps
[peSmall] = 0
[peMedium] = 1
[peLarge] = 2
End Enum
#If False Then
Private peSmall, peMedium, peLarge
#End If
Public Enum MagnifyProperties
[pe150%] = 1.5
[pe200%] = 2
[pe250%] = 2.5
[pe300%] = 3
End Enum
#If False Then
Private pe150%, pe200%, pe250%, pe300%
#End If
'Constants
Private Const SrcCopy As Long = &HCC0020
Private Const mDefScrollSpeed As Integer = 50
Private Const mDefBorderStyle As Integer = 1
Private Const mDefAppearance As Integer = 1
Private Const mDefBackColor As Long = &H8000000F
Private Const mDefAlignNB As Integer = 2
Private Const mdefLS As Integer = 0
Private Const mDefMag As Integer = 2
Private Const SS As Integer = 250 ' minimum width & height
'Declarations
Private b As Picture
Private bw As Long
Private bh As Long
Private MagnifySize As Single
Private LenSize As LenzSizeProps
Private mAlignNB As AlignNB ' Controlbox alignment
Private SizeDiff As Size ' between picFrame & picMain (diff for each pic)
Private mScrollSpeed As Integer
Private bGate As Boolean
Private mBorderStyle As BorderStyle
Private mAppearance As Appearance
Private picGate As PictureGate
Private picMainpos As PosProps
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Makes it sleep
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, _
ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Property Get AlignNavBar() As AlignNB
AlignNavBar = mAlignNB
End Property
Public Property Let AlignNavBar(ByVal NewAlignNavBar As AlignNB)
mAlignNB = NewAlignNavBar
PropertyChanged "AlignNavBar"
UserControl_Resize
End Property
Public Property Get Appearance() As Appearance
Appearance = mAppearance
End Property
Public Property Let Appearance(ByVal NewAppearance As Appearance)
mAppearance = NewAppearance
PropertyChanged "Appearance"
picMain.Appearance = mAppearance
If Appearance = [pe3D] Then BorderStyle = [peFixed_Single]
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = picMain.BackColor
End Property
Public Property Let BackColor(ByVal NewBackColor As OLE_COLOR)
picMain.BackColor = NewBackColor
PropertyChanged "BackColor"
picFrame.BackColor = NewBackColor
picHolder.BackColor = NewBackColor
End Property
Public Property Get BorderStyle() As BorderStyle
BorderStyle = mBorderStyle
End Property
Public Property Let BorderStyle(ByVal NewBorderStyle As BorderStyle)
mBorderStyle = NewBorderStyle
picMain.BorderStyle = NewBorderStyle
PropertyChanged "BorderStyle"
End Property
Public Property Get LenzSize() As LenzSizeProps
LenzSize = LenSize
End Property
Public Property Let LenzSize(ByVal NewLenzSize As LenzSizeProps)
LenSize = NewLenzSize
PropertyChanged "LenzSize"
LenzSizer LenSize
End Property
Public Property Get Magnify() As MagnifyProperties
Magnify = MagnifySize
End Property
Public Property Let Magnify(ByVal NewMagnify As MagnifyProperties)
MagnifySize = NewMagnify
Combo3_SetText
PropertyChanged "Magnify"
If picZoom.Visible = True Then PaintZoomGlass
End Property
Public Property Get Picture() As Picture
Set Picture = picMain.Picture
End Property
'This property ables you to insert the controls picture to
'another picturebox outside the usercontrol. Elese you'll get
'an error
Public Property Let Picture(ByVal NewPicture As IPictureDisp)
Set Picture = NewPicture
End Property
Public Property Set Picture(ByVal NewPicture As Picture)
Set b = NewPicture
LockWindowUpdate picFrame.hwnd
' For main picture
PaintThePicture
PropertyChanged "Picture"
UserControl_Resize
If picZoom.Visible = True Then PaintZoomGlass
' For insert picture
With picInsert
If picGate.bWidth Then
.Left = picPosition.Width / 2 - .Width / 2
Else
.Left = 0
End If
If picGate.bHeight Then
.Top = picPosition.Height / 2 - .Height / 2
Else
.Top = 0
End If
End With
PaintThePictureCopy
PaintInsertGlass
' Check main pic position against insert position. Here we line them
' up cause left position is out by 1 (drop fractions in formula's)
