【求助】图像的缩放
我做一个地图文件,要求缩放功能,用PictureBox做容器,Image装载地图,垂直水平滚动条,工具条放命令按钮,而且在地图上放标签数组用以定位。我的问题是Image可以按指定倍数缩放了,但是上面的Label不知怎么做到同步缩放,尤其是相对位置之间要相应拉开和拉进。(如果是滚动条就好办,因为移位相对位置不变,这个我已经实现),以下附代码,主要是 Toolbar1_ButtonClick 过程里面的,求高手帮忙哈!Public Sub ReSize() '调整Image、PictureBox和滚动条之间的协调关系,已经实现。
HScroll1.Max = Image1.Width - Picture1.ScaleWidth
If Image1.Width < Picture1.ScaleWidth Then
HScroll1.Visible = False
Image1.Left = (Picture1.ScaleWidth - Image1.Width) / 2
Else
HScroll1.Visible = True
Image1.Left = Picture1.ScaleLeft
End If
VScroll1.Max = Image1.Height - Picture1.ScaleHeight
If Image1.Height < Picture1.ScaleHeight Then
VScroll1.Visible = False
Image1.Top = (Picture1.ScaleHeight - Image1.Height) / 2
Else
VScroll1.Visible = True
Image1.Top = Picture1.ScaleTop
End If
End Sub
Private Sub Form_Load()
Image1.Picture = LoadPicture(App.Path & "\地图.jpg")
ReSize
End Sub
Private Sub HScroll1_Change() '水平滚动条,已经实现
Dim Label As Variant
For Each Label In Label1
Label.Left = Label.Left - Image1.Left - HScroll1.Value
Next
Image1.Left = -HScroll1.Value
End Sub
Private Sub Label1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) 'Label数组弹出菜单
If Button = 2 Then
PopupMenu Edit
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ‘工具条按钮
Static Cx As Long
Static Cy As Long
Static Lx As Long
Static Ly As Long
Cx = Image1.Width
Cy = Image1.Height
Lx = Label1(0).Width
Ly = Label1(0).Height
Dim Label As Variant
Select Case Button.Key
Case "Open"
Case "Save"
Case "Delete"
Case "Print"
Case "Magnify" '放大图像
Image1.Width = Cx * 1.25
Image1.Height = Cy * 1.25
ReSize
If Image1.Width > 32767 Or Image1.Height > 32767 Then Toolbar1.Buttons(7).Enabled = False
If Image1.Width > 5000 And Image1.Height > 5000 Then Toolbar1.Buttons(8).Enabled = True
For Each Label In Label1
Label.Width = Lx * 1.25
Label.Height = Ly * 1.25
Next
Case "Reduce" '缩小图像
Image1.Width = 0.8 * Cx
Image1.Height = 0.8 * Cy
If Image1.Width < 5000 Or Image1.Height < 5000 Then Toolbar1.Buttons(8).Enabled = False
If Image1.Width < 32767 And Image1.Height < 32767 Then Toolbar1.Buttons(7).Enabled = True
ReSize
For Each Label In Label1
Label.Width = Lx * 0.8
Label.Height = Ly * 0.8
Next
End Select
End Sub
Private Sub VScroll1_Change() '垂直滚动条,已经实现
Dim Label As Variant
For Each Label In Label1
Label.Top = Label.Top - Image1.Top - VScroll1.Value
Next
Image1.Top = -VScroll1.Value
End Sub
我的问题是Image可以按指定倍数缩放了,但是上面的Label不知怎么做到同步缩放,尤其是相对位置之间要相应拉开和拉进。
[[it] 本帖最后由 超级隐士 于 2008-5-20 23:21 编辑 [/it]]