Public dviewX1!, dviewX2!, dviewY1!, dviewY2! ' anchors for the viewport drag
Public savedDC&, RotAngle%
Dim mySize As SIZE, myPoint As POINTAPI
Public viewOrgX&, viewOrgY&, viewExtX&, viewExtY&
Public WinOrgX&, WinOrgY&, WinExtX&, WinExtY&
Public RectX1&, RectY1&, RectX2&, RectY2&
'**********************************
'** Type Definitions:
#If Win32 Then
Private Type XFORM
eM11 As Single
eM12 As Single
eM21 As Single
eM22 As Single
eDx As Single
eDy As Single
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const PS_SOLID& = 0
'**********************************
'** Function Declarations:
Private Declare Function LineTo& Lib "gdi32" (ByVal hdc As Long, ByVal X2 As Long, ByVal Y2 As Long)
Private Declare Function MoveToEx& Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, oldPoint As POINTAPI)
Private Declare Function Rectangle& Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Private Declare Function SetWorldTransform& Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM)
Private Declare Function ModifyWorldTransform& Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM, ByVal iMode As Long)
Private Declare Function GetWorldTransform& Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM)
Private Declare Function SetGraphicsMode& Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long)
Private Declare Function SetMapMode& Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long)
Private Declare Function LPtoDP& Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long)
Private Declare Function DPtoLP& Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long)
Private Declare Function GetViewportExtEx& Lib "gdi32" (ByVal hdc As Long, lpSize As SIZE)
Private Declare Function GetViewportOrgEx& Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI)
Private Declare Function SetViewportExtEx& Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpSize As SIZE)
Private Declare Function ScaleViewportExtEx& Lib "gdi32" (ByVal hdc As Long, ByVal nXnum As Long, ByVal nXdenom As Long, ByVal nYnum As Long, ByVal nYdenom As Long, lpSize As SIZE)
Private Declare Function SetViewportOrgEx& Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
Private Declare Function Ellipse& Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Private Declare Function SetWindowExtEx& Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpSize As SIZE)
Private Declare Function SetWindowOrgEx& Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
Private Declare Function GetWindowExtEx& Lib "gdi32" (ByVal hdc As Long, lpSize As SIZE)
Private Declare Function GetWindowOrgEx& Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI)
Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
Private Declare Function SaveDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function RestoreDC& Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long)
Private Declare Function ClipCursor& Lib "user32" (lpRect As RECT)
Private Declare Function ClipCursorBynum& Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Private Declare Function ClientToScreen& Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI)
Private Declare Function SetROP2& Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long)
Const GM_ADVANCED& = 2
Const MWT_IDENTITY& = 1
Const MM_ANISOTROPIC& = 8
Const MM_HIENGLISH& = 5
Const MM_HIMETRIC& = 3
Const MM_ISOTROPIC& = 7
Const R2_COPYPEN& = 13
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Const VER_PLATFORM_WIN32_NT& = 2
Const VER_PLATFORM_WIN32_WINDOWS& = 1
Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO)
#End If 'WIN32
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSettings_Click()
frmSettings.Show 1
End Sub
Private Sub Form_Load()
Dim myVer As OSVERSIONINFO
myVer.dwOSVersionInfoSize = 148
dummy& = GetVersionEx&(myVer) 'Get all the version info
If myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
txtRotate.Visible = True
lblRotate.Visible = True
End If
'Set the default values for all the variables controlling the painting:
'Viewport
viewOrgX& = 200&
viewOrgY& = 75&
viewExtX& = 100&
viewExtY& = 100&
'Logical Window
WinOrgX& = 0
WinOrgY& = 0
WinExtX& = 100
WinExtY& = 100
'Rectangle & Ellipse Dimensions
RectX1& = 0
RectY1& = 0
RectX2& = 100
RectY2& = 100
End Sub
Private Sub pctScreen_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim clipR As RECT, clipP As POINTAPI
If Button And vbLeftButton Then
'The first corner of the rectangle is recorded in the viewX1
'and dviewY1 variables. The other corner is set to the same point.
dviewX1! = X
dviewY1! = Y
dviewX2! = dviewX1!
dviewY2! = dviewY1!
'Clip the cursor to the picture control:
'Get the SCREEN coordinates of the form's origin
clipP.X = 0
clipP.Y = 0
dummy& = ClientToScreen(Me.hWnd, clipP)
'Set the clip rectangle
clipR.Top = pctScreen.Top + clipP.Y ' Top of pctScreen + top of form
clipR.Left = pctScreen.Left + clipP.X ' left of pctScreen + left of form, etc.
(.txt)