关闭

VB6对图片进行漫游浏览的完整代码

1780人阅读 评论(0) 收藏 举报

要用到这么个程序,在网上找了半天未果,于是动手编了一个,效果不错,有空再把缩放添加进去。编制环境:VB6 SP5、WINDOWS XP SP2

'本程序用以显示图片,并对图片进行漫游浏览
'本程序包含1窗体(form1、2图片框(picture1、picture2)、2滚动条(HScroll1、VScroll1)
'picture1用以显示图像,picture2用以存放图像,picture2不可见

'声明API之BitBlt,完成从picture2到picture1的图像复制
Private Declare Sub BitBlt Lib "gdi32" _
    (ByVal hDestDC As Long, ByVal X As Long, _
    ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
    ByVal dwRop As Long)

'声明变量储存窗体加载时picture1的宽和高
'在先浏览小图片,再浏览大图片时,如果无此变量,将出现问题,问题就是……

Private picture1_width As Long
Private picture1_height As Long

'这个按钮是用来打开图像文件的
Private Sub Command1_Click()
    CommonDialog1.Filter = "*.jpg|*.jpg|*.bmp|*.bmp|*.gif|*.gif"
    CommonDialog1.ShowOpen
    Dim pathname As String
    pathname = CommonDialog1.FileName
    If pathname = "" Then
        Exit Sub
    End If
    '加载图像到Picture2
    Set Picture2.Picture = LoadPicture(pathname)
    '做必要的初始化工作
    Init_Picture
    '完成图像加载
    HVScroll
End Sub

Private Sub Form_Load()
    '统一几个CDC的坐标度量单位
    Form1.ScaleMode = 3
    Picture1.ScaleMode = 3
    Picture2.ScaleMode = 3
    '预存Picture1的宽、高以备用
    picture1_width = Picture1.Width
    picture1_height = Picture1.Height
    '预加载默认图片
    Set Picture2.Picture = LoadPicture(App.Path & "/Sample.jpg")
    '做必要的初始化工作
    Init_Picture
    '完成图像加载
    HVScroll
End Sub

'初始化工作,初始化项目包括:两图片框的大小、可见、两滚动条的大小及滚动单位
Private Sub Init_Picture()
    '预设预存Picture1的宽、高,用来和图片实际大小做比较,以调整自身大小
    Picture1.Width = picture1_width
    Picture1.Height = picture1_height
    '设置Picture2的属性:自动重绘、不可见、自动调整大小(以获取源图像真实大小)
    With Picture2
        .AutoRedraw = 1
        .Visible = 0
        .AutoSize = 1
    End With
    '设置Picture1的属性:不允许自动重绘、可见、宽、高
    With Picture1
        .Cls
        '当图片大小超出Picture1的初始大小时,Picture1保持初始大小;否则,Picture1的大小调整为图片大小
        If Picture1.Width >= Picture2.Width Then
            .Width = Picture2.Width
        End If
        If Picture1.Height >= Picture2.Height Then
            .Height = Picture2.Height
        End If
        '不允许自动重绘,否则将无法漫游图片
        .AutoRedraw = 0
        .Visible = 1
    End With
    '设置HScroll1的属性:和Picture1等宽、位于Picture1的下面、最大值、每次调整的单位
    With HScroll1
        .Width = Picture1.Width
        .Top = Picture1.Top + Picture1.Height
        .Left = Picture1.Left
        .Max = Picture2.Width - Picture1.Width
        If (.Max / 20) > 0 Then
            .SmallChange = .Max / 20
        Else
            .SmallChange = 1
        End If
        If (.Max / 20) > 0 Then
            .LargeChange = .Max / 5
        Else
            .LargeChange = 1
        End If
        .ZOrder (0)
        '滚动条预设位置为0
        .Value = 0
    End With
    '设置VScroll1的属性:和Picture1等高、位于Picture1的右边、最大值、每次调整的单位
    With VScroll1
        .Height = Picture1.Height
        .Top = Picture1.Top
        .Left = Picture1.Left + Picture1.Width
        .Max = Picture2.Height - Picture1.Height
        If (.Max / 20) > 0 Then
            .SmallChange = .Max / 20
        Else
            .SmallChange = 1
        End If
        If (.Max / 20) > 0 Then
            .LargeChange = .Max / 5
        Else
            .LargeChange = 1
        End If
        .ZOrder (0)
        '滚动条预设位置为0
        .Value = 0
    End With
    '加载图片
    HVScroll
End Sub

'实现当窗体自动重绘时,Picture1也能自动重绘
Private Sub Picture1_Paint()
    HVScroll
End Sub

'漫游实现,完成从Picture2到Picture1的部分图像拷贝
Private Sub HVScroll()
    BitBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, Picture2.hDC, HScroll1.Value, VScroll1.Value, vbSrcCopy
End Sub

'滚动条滚动时漫游图片
Private Sub HScroll1_Scroll()
    HVScroll
End Sub

'滚动条点击时漫游图片
Private Sub HScroll1_Change()
    HVScroll
End Sub

'滚动条滚动时漫游图片
Private Sub vScroll1_Scroll()
    HVScroll
End Sub

'滚动条点击时漫游图片
Private Sub vScroll1_Change()
    HVScroll
End Sub

 

0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:167418次
    • 积分:2111
    • 等级:
    • 排名:第18716名
    • 原创:32篇
    • 转载:38篇
    • 译文:1篇
    • 评论:15条
    文章分类
    最新评论