标题:【求助】图像的缩放
只看楼主
超级隐士
Rank: 1
等 级:新手上路
帖 子:42
专家分:0
注 册:2008-5-4
 问题点数:0 回复次数:0 
【求助】图像的缩放
我做一个地图文件,要求缩放功能,用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]]
搜索更多相关主题的帖子: 缩放 图像 Image 地图 PictureBox 
2008-05-20 23:16



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-215333-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.231282 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved