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

原创 2006年05月25日 16:17:00

要用到这么个程序,在网上找了半天未果,于是动手编了一个,效果不错,有空再把缩放添加进去。编制环境: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

 

版权声明:本文为博主原创文章,未经博主允许不得转载。

相关文章推荐

使用VB6对仪器进行控制实例

  • 2011年06月14日 13:38
  • 2KB
  • 下载

360 度全方位漫游.rar vb代码

  • 2010年07月15日 14:37
  • 566KB
  • 下载

VB6对系统自带的TextBox控件的扩展实现模糊查询的功能

由于需要维护很多的VB代码,而这些代码中,

VB PictureBox中图片长宽尺寸大于本身尺寸,却没有显示完整呢?

上面显示的三个尺寸: 图片框宽度,图片框内部宽度(不含边框),还有一个特殊的图片框内图片的宽度。 发现一个问题:  图片尺寸大于图片框,但是,,图片去没有占满图片框,这是什么原因呢? 水平...

vb6對類比信號轉數位信號

  • 2013年09月20日 13:37
  • 3KB
  • 下载

VB控制网页进行同义词下载代码.

  • 2011年12月09日 07:30
  • 71KB
  • 下载

利用tensorflow编写卷积神经网络(CNN)对CIFAR-10进行识别(附完整代码)

利用tensorflow编写卷积神经网络(CNN)对CIFAR-10进行识别,识别率达到80%左右,源码中附有详细注释,适合初学者!...
  • x_lock
  • x_lock
  • 2016年11月20日 19:55
  • 10763

卸载自身进行scoket完整jni代码

  • 2016年06月01日 10:28
  • 8KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB6对图片进行漫游浏览的完整代码
举报原因:
原因补充:

(最多只允许输入30个字)