Available in the LEADTOOLS Imaging toolkit. |
ShowMagGlass example for Visual Basic
' Global variables
Public ghMagGlassCursor As Long
Public gbLeftButton As Boolean
' Windows API functions headers
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Sub Form_Load()
LEAD1.EnableMethodErrors = False
LEAD1.Load App.Path & "\Sample1.cmp", 0, 1, 1
LEAD2.Load App.Path & "\Sample2.cmp", 0, 1, 1
LEAD1.MagGlassFlags = MAGGLASS_MANUAL_UPDATE
' Starting the Magnifying Glass
LEAD1.StartMagGlass 100, 100, 400, RGB(255, 0, 0), RGB(128, 128, 128), False, 1, False, CROSSHAIR_FINE, True, True
' Updating the Magnifying Glass bitmap of 1st control with bitmap of the
' 2nd control that has the same width and height.
LEAD1.UpdateMagGlassFromHandle LEAD2.Bitmap, True
' Use this Windows API function to load the MagGlass cursor from a file
ghMagGlassCursor = LoadCursorFromFile(App.Path & "\MagGlassCursor.cur")
End Sub
Private Sub LEAD1_MagGlassCursor()
' Check if the left button is not down and the Magnifying Glass is started
If ((Not gbLeftButton) And (LEAD1.HasMagGlass)) Then
SetCursor (ghMagGlassCursor)
End If
End Sub
Private Sub LEAD1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nStatus As Integer
' Check if this is a left button and the Magnifying Glass is started
If ((Button <> 1) Or Not (LEAD1.HasMagGlass)) Then
Exit Sub
End If
' Move the Magnifying Glass to the hit position
nStatus = SetMagGlassMousePosition (x, y)
If (nStatus <> 0) Then
MsgBox "Error while displaying Magnifying Glass, Error: " & CStr(nStatus)
Exit Sub
End If
' Show the Magnifying Glass
nStatus = LEAD1.ShowMagGlass(True)
If (nStatus <> 0) Then
MsgBox "Error while displaying Magnifying Glass, Error: " & CStr(nStatus)
Exit Sub
End If
' Left button is currently pressed
gbLeftButton = True
' Call this Windows API function to hide the cursor
ShowCursor (False)
End Sub
Private Sub LEAD1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nStatus As Integer
' Check if the left button is down and the Magnifying Glass is started
If ((Button <> 1) Or Not (LEAD1.HasMagGlass)) Then
Exit Sub
End If
' Move the Magnifying Glass to the mouse position
nStatus = SetMagGlassMousePosition(x, y)
If (nStatus <> 0) Then
MsgBox "Error while Moving Magnifying Glass, Error: " & CStr(nStatus)
End If
End Sub
Private Sub LEAD1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nStatus As Integer
' Check if the left button is down and the Magnifying Glass is started
If ((Button <> 1) Or Not (LEAD1.HasMagGlass)) Then
Exit Sub
End If
' Show the Magnifying Glass
nStatus = LEAD1.ShowMagGlass (False)
If (nStatus <> 0) Then
MsgBox "Error while Hiding Magnifying Glass, Error: " & CStr(nStatus)
End If
' Left button is released
gbLeftButton = True
' Call this Windows API function to show the cursor
ShowCursor (True)
End Sub
Private Function SetMagGlassMousePosition(xPos As Single, yPos As Single) As Integer
Dim nStatus As Integer
Dim nOldScaleMode As Long
' Save the current Scale mode
nOldScaleMode = LEAD1.ScaleMode
' Change the Scaling mode to Twip
LEAD1.ScaleMode = 1
' Set the MagGlass new position
nStatus = LEAD1.SetMagGlassPos(xPos, yPos)
' Switch back to the old Scale mode
LEAD1.ScaleMode = nOldScaleMode
SetMagGlassMousePosition = nStatus
End Function