I would like to zoom in and out of a map on my form. The map is a bitmap. Does anyone knows any way to do so? Any help would be appreciated ;)
Printable View
I would like to zoom in and out of a map on my form. The map is a bitmap. Does anyone knows any way to do so? Any help would be appreciated ;)
Hi,
For dealing with raster backgrounds such as maps in the form of PCX, BMP, TIF formats, you could insert the WANG ImageEdit control onto your form. This control comes free with Win95/98/NT and has good facilties for zooming/panning & annotation.
If at all you do not want to use the WANG control, you would have implement your own zooming & panning algorithms using a picturebox as base.
Hope this satisfies your query.
Regards.
This code is a simple zoom algorithm for a picturebox. Just add a picturebox and a commondialog control to a form.
code:
Option Explicit
Dim lZM As Single
Private Sub Form_Activate()
On Error GoTo FileErr
If Picture1.Picture = 0 Then
With CommonDialog1
.CancelError = True
.DialogTitle = "Open Bitmap"
.Filter = "(*.bmp)|*.bmp"
.filename = ""
.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
.ShowOpen
Picture1.Picture = LoadPicture(.filename)
End With
Form1.Width = Picture1.Width
Form1.Height = Picture1.Height
End If
FileErr:
If Err.Number > 0 Then
MsgBox "Error loading bitmap " & Err.Description
Unload Me
End If
End Sub
Private Sub Form_Load()
Form1.Width = Picture1.Width
Form1.Height = Picture1.Height
Picture1.Left = 0
Picture1.Top = 0
lZM = 1
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Xsrc As Single, Ysrc As Single
Dim X1 As Single, Y1 As Single
If Button = vbLeftButton Then
lZM = lZM - 0.1
If lZM < 0.1 Then lZM = 0.1
Else
lZM = lZM + 0.1
If lZM > 1 Then lZM = 1
End If
Xsrc = X - ((Picture1.Width * lZM) / 2)
If Xsrc < 0 Then Xsrc = 0
If (Xsrc + (lZM * Picture1.Width)) > Picture1.Width Then
Xsrc = Picture1.Width * (1 - lZM)
End If
Ysrc = Y - ((Picture1.Height * lZM) / 2)
If Ysrc < 0 Then Ysrc = 0
If (Ysrc + (lZM * Picture1.Height)) > Picture1.Height Then
Ysrc = Picture1.Height * (1 - lZM)
End If
Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height, Xsrc, Ysrc, Picture1.Width * lZM, Picture1.Height * lZM, vbSrcCopy
End Sub
LM Ginn