怎样在picturebox控件中添加滚动条，来实现图形的滚动显示 谢谢！

Question

怎样在picturebox控件中添加滚动条，来实现图形的滚动显示 谢谢！
有这样的资料和例子吗？ 谢谢！

Answer 1

p2在p1内。Option ExplicitPrivate Sub Form_Load()
P2_Resize
End SubPrivate Sub P2_Resize()
If P2.Width > P1.ScaleWidth Then
HS.Max = P2.Width - P1.ScaleWidth
Else
HS.Max = 0
End If
If P2.Height > P1.ScaleHeight Then
VS.Max = P2.Height - P1.ScaleHeight
Else
VS.Max = 0
End If
P2.Move 0, 0
End SubPrivate Sub HS_Scroll()
P2.Left = -HS.Value
End SubPrivate Sub VS_Scroll()
P2.Top = -VS.Value
End Sub

Answer 2

谢谢！ 我试验一下，p2在p1内。我要滚动显示p1，那就把p1放在另一个picturebox  p2 中是吧？

Answer 3

p2滚动，p1是容器。
p1不滚动的。
在p2里加载一幅比p1大的图，效果就出来了。

Answer 4

'>>Scan Image scroll
Private lngHorizontalScrollValue As Long
Private lngVerticalScrollValue As Long'>> Resize the scrool after resize the window
Sub ResizePicture()
On Error Resume Next    Dim lngValue1 As Long
    lngValue1 = FlatScrollBar1.Value
    FlatScrollBar1.Value = 0
        
    If FlatScrollBar1.Visible = True Then
         FlatScrollBar1.Value = lngValue1
    End If    Dim lngValue2 As Long
    lngValue2 = FlatScrollBar2.Value
    FlatScrollBar2.Value = 0
    If FlatScrollBar2.Visible = True Then
        FlatScrollBar2.Value = lngValue2
    End If
End Sub'>> Horizaotal Scroll
Sub SetScrollBar1()
On Error Resume Next    FlatScrollBar1.Min = 0
    Dim lngValue1 As Long
    'If FlatScrollBar2.Visible = True Then
        lngValue1 = picShow.Width - (picFrame.Width - FlatScrollBar2.Width)
    'Else
    '    lngValue1 = picShow.Width - picFrame.Width
    'End If
    
    If lngValue1 > 0 Then
        FlatScrollBar1.Visible = True
        FlatScrollBar1.Max = lngValue1
    Else
        FlatScrollBar1.Visible = False
    End If
    
    Dim sngScrollScale As Single
    If FlatScrollBar1.Max >= 2000 Then
        sngScrollScale = 10
    ElseIf FlatScrollBar1.Max > 1000 And FlatScrollBar1.Max < 2000 Then
        sngScrollScale = 5
    ElseIf FlatScrollBar1.Max <= 1000 Then
        sngScrollScale = 2
    End If
    
    FlatScrollBar1.SmallChange = FlatScrollBar1.Max / sngScrollScale
    FlatScrollBar1.LargeChange = FlatScrollBar1.Max / sngScrollScale
End SubPrivate Sub FlatScrollBar1_scroll()
    Call ChangeScrollValue1
End SubPrivate Sub FlatScrollBar1_change()
    Call ChangeScrollValue1
End SubSub ChangeScrollValue1()
On Error Resume Next
    
    If FlatScrollBar1.Value >= FlatScrollBar1.Min And FlatScrollBar1.Value <= FlatScrollBar1.Max Then
        If FlatScrollBar1.Value > lngHorizontalScrollValue Then
            picShow.Left = picShow.Left - (FlatScrollBar1.Value - lngHorizontalScrollValue)
        Else
            picShow.Left = picShow.Left + (lngHorizontalScrollValue - FlatScrollBar1.Value)
        End If
    End If
       
    lngHorizontalScrollValue = FlatScrollBar1.Value
End Sub'>> Vertical Scroll
Sub SetScrollBar2()
On Error Resume Next    FlatScrollBar2.Min = 0
    Dim lngValue2 As Long
    'If FlatScrollBar1.Visible = True Then
        lngValue2 = picShow.Height - (picFrame.Height - FlatScrollBar1.Height)
    'Else
    '    lngValue2 = picShow.Height - picFrame.Height
    'End If
    
    If lngValue2 > 0 Then
        FlatScrollBar2.Visible = True
        FlatScrollBar2.Max = lngValue2
    Else
        FlatScrollBar2.Visible = False
        '>> Expand the horizontal scrool width when vertical scroll not visible
        FlatScrollBar1.Width = FlatScrollBar1.Width + FlatScrollBar2.Width
    End If
    
    Dim sngScrollScale As Single
    If FlatScrollBar2.Max >= 2000 Then
        sngScrollScale = 10
    ElseIf FlatScrollBar2.Max > 1000 And FlatScrollBar2.Max < 2000 Then
        sngScrollScale = 5
    ElseIf FlatScrollBar2.Max <= 1000 Then
        sngScrollScale = 2
    End If
    
    FlatScrollBar2.SmallChange = FlatScrollBar2.Max / sngScrollScale
    FlatScrollBar2.LargeChange = FlatScrollBar2.Max / sngScrollScale
End SubPrivate Sub FlatScrollBar2_scroll()
    Call ChangeScrollValue2
End SubPrivate Sub FlatScrollBar2_change()
    Call ChangeScrollValue2
End SubSub ChangeScrollValue2()
On Error Resume Next
    
    If FlatScrollBar2.Value >= FlatScrollBar2.Min And FlatScrollBar2.Value <= FlatScrollBar2.Max Then
        If FlatScrollBar2.Value > lngVerticalScrollValue Then
            picShow.Top = picShow.Top - (FlatScrollBar2.Value - lngVerticalScrollValue)
        Else
            picShow.Top = picShow.Top + (lngVerticalScrollValue - FlatScrollBar2.Value)
        End If
    End If
       
    lngVerticalScrollValue = FlatScrollBar2.Value
End SubPrivate Sub Form_Load()
    FlatScrollBar2.Height = picFrame.Height
    FlatScrollBar1.Top = picFrame.Height - FlatScrollBar1.Height
    FlatScrollBar2.Left = picFrame.Width - FlatScrollBar2.Width
    FlatScrollBar1.Width = picFrame.Width - FlatScrollBar2.Width
    Call SetScrollBar1
    Call SetScrollBar2
    Call ResizePictureEnd Sub
加一个picture(picframe) 作容器，在上面加一个picture(picShow),两个FlatScrollBar

Answer 5

p1是个picturebox，装载一个大的图片，或者图片稍小但是窗体的尺寸小一点。
hs，vs是水平、垂直滚动条Private Sub Form_Resize()
hs.Left = Me.ScaleLeft
hs.Top = Me.ScaleHeight - hs.Height
hs.Width = Me.ScaleWidth - hs.Heightvs.Left = Me.ScaleWidth - vs.Width
vs.Top = Me.ScaleTop
vs.Height = Me.ScaleHeight - vs.Width
hs.Max = (p1.ScaleWidth - Me.ScaleWidth)
hs.LargeChange = 10
hs.SmallChange = 1vs.Max = (p1.ScaleHeight - Me.ScaleHeight)
vs.LargeChange = 10
vs.SmallChange = 1
End SubPrivate Sub hs_Change()
p1.Left = -hs.Value
Me.Caption = Str(p1.Left) + "---" + Str(p1.Top)
End SubPrivate Sub hs_Scroll()
p1.Left = -hs.Value
Me.Caption = Str(p1.Left) + "---" + Str(p1.Top)
End SubPrivate Sub vs_Change()
p1.Top = -vs.Value
Me.Caption = Str(p1.Left) + "---" + Str(p1.Top)
End SubPrivate Sub vs_Scroll()
p1.Top = -vs.Value
Me.Caption = Str(p1.Left) + "---" + Str(p1.Top)
End Sub

Answer 6

忘了加上
p1.left=me.scaleleft
p1.top=me.scaletop
......

Answer 7

移动picturebox应该不如paintpicture的效果好

Answer 8

在VB中制作可滚动的图像显示摘要：我们在制作多媒体程序时，不可避免的要涉及图像的显示，尽管VB中提
供的picturebox可以显示多种格式的图像文件，但由于没有提供滚动条和缩放功
能，在使用中多有不便。笔者在编制一多媒体程序时，就需要对图像进行缩放显
示。这通常有两种处理办法，一是利用第三方控件，如Windows自带的WANG图像控
件；二是利用VB的picturebox和滚动条控件自行编程实现。本文给出了利用这两
种方法制作的实例。在VB中制作可滚动的图像显示我们在制作多媒体程序时，不可避免的要涉及图像的显示，尽管VB中提供的
picturebox可以显示多种格式的图像文件，但由于没有提供滚动条和缩放功能，在
使用中多有不便。笔者在编制一多媒体程序时，就需要对图像进行缩放显示。这通
常有两种处理办法，一是利用第三方控件，如Windows自带的WANG图像控件；二是
利用VB的picturebox和滚动条控件自行编程实现。两种方法各有优缺点，可以根
据需要具体选用。
一，利用第三方控件实现
在“工程”中选取“部件”，将WANG 图像编辑控制添加到工具箱中，并在窗
体中绘制出合适大小，按鼠标右键，选取特性，设置好各种参数后加入程序代码就
行了，使用非常简单，如果需要，在程序中也可加入一定的图像编辑功能。
采用第三方控件，功能较强，程序编制也简单一些，不失为一种好方法。但存
在一些其他问题，比如本文采用的WANG 图像编辑控制，在使用中就经常出现“类
没有注册”的错误，解决此问题，要么修改注册表，要么重装系统，很麻烦，所以
在要求的功能不是很多的情况下，用第二种方法比较合适。以下就是使用WANG控
件的程序，可以看出，代码很简单。
Private Sub imgedit1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode '定义功能键，+，-用以缩放图像
Case vbKeyAdd
ImgEdit1.Zoom=imgedit1.zoom*1.2
Case vbKeySubtract
ImgEdit1.Zoom=imgedit1.zoom/1.2
End Select
ImgEdit1.Refresh
End SubPrivate Sub Form_Resize()
ImgEdit1.Top = 0
ImgEdit1.Left = 0
ImgEdit1.Height = Form1.ScaleHeight
ImgEdit1.Width = Form1.ScaleWidth
End SubPrivate Sub Form_Load()
imgedit1.image="a:\ddd.jpg"
ImgEdit1.ImagePalette = 3
ImgEdit1.Display
End Sub
二是利用VB的picturebox和滚动条控件编程实现
PICTUREBOX控件能支持许多种图像格式，但没有缩放功能并且不自动添加滚
动条，所以必须自行编程实现。 
应用程序使用两个图片框，一个作为包容器，可称之为父图片框，另一个作
为子图片框显示图形，配合滚动条控件在父图片框内移动子图片框就可实现画面
的滚动。
VB中提供了paintpicture方法，可以在窗体、图片框上的任何地方绘制图
形，语法为 object.PaintPicture picture, x1, y1, width1, height1, x2, 
y2, width2, height2, opcode,其中x1,y1为指定在 object 上绘制 picture 
的目标坐标；width1,height1 指定 picture 的目标宽度和高度；x2,y2指定 
picture 内剪贴区的坐标 width2,height2 指定 picture 内剪贴区的源宽度和高
度，当我们重新设定width1,height1时，就可以在子图片框内实现平滑的缩放图
片。虽然Paintpicture可以代替bitblt windows API函数，但没有API的执行
速度快，如程序对速度的要求比较高，可用API函数代替paintpicture方法 。
在窗体中先画出picture1作为父图片框,然后在其中中画出picture2，在窗
体中再画出滚动条，picture2的autosize属性为TRUE，borderstyle属性为0，
autoredraw属性为true,滚动条的largechange和smallchange属性设为合适大
小,窗体既设置完毕。
以下为可以直接使用的完整程序，可以用光标键移动画面，也可以拖放方式
移动画面；用加减号缩放画面。
Public c1, c2, c3, c4 As Integer
Public tf, d1, d2, d3, d4, blf As Integer
Public yk, yg As LongPrivate Sub Form_Load()
c1 = Form1.Width
c2 = Form1.Height
blf = 100
Picture2.Picture = LoadPicture("a:\ddd.jpg")
yk = Picture2.Width
yg = Picture2.Height
End SubPrivate Sub Form_Resize()
If Width > 1500 And Height > 1170 Then
c3 = Form1.Width - c1
c4 = Form1.Height - c2
Picture1.Move Picture1.Left, Picture1.Top, Picture1.Width + c3, Picture1.Height + c4
c1 = Form1.Width
c2 = Form1.Height
Call p
End If
Picture2.SetFocus
End Sub
'以拖放方式滚动画面
Private Sub Picture2_DragDrop(Source As Control, x As Single, y As Single)
If Picture2.Height > Picture1.Height Then '通过计算鼠标移动位置，调用vscroll_change事件
cccc = VScroll1.Value + (d2 - y) '移动画面
If cccc <= 0 Then
cccc = 0
End If
If cccc >= VScroll1.Max Then
cccc = VScroll1.Max
End If
VScroll1.Value = cccc
End If
If Picture2.Width > Picture1.Width Then
cccc1 = HScroll1.Value + (d1 - x)
If cccc1 <= 0 Then
cccc1 = 0
End If
If cccc1 >= HScroll1.Max Then
cccc1 = HScroll1.Max
End If
HScroll1.Value = cccc1
End If
End Sub
'设置功能键，光标键移动画面，加减号缩放画面
Private Sub Picture2_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
HScroll1.Value = IIf(HScroll1.Value - HScroll1.SmallChange < 0, 0, HScroll1.Value - 
HScroll1.SmallChange)
Case vbKeyRight
If Picture2.Width > Picture1.Width Then
HScroll1.Value = IIf(HScroll1.Value + HScroll1.SmallChange > HScroll1.Max, HScroll1.Max, 
HScroll1.Value + HScroll1.SmallChange)
End If
Case vbKeyUp
VScroll1.Value = IIf(VScroll1.Value - VScroll1.SmallChange < 0, 0, VScroll1.Value - 
VScroll1.SmallChange)
Case vbKeyDown
If Picture2.Height > Picture1.Height Then
VScroll1.Value = IIf(VScroll1.Value + VScroll1.SmallChange > VScroll1.Max, VScroll1.Max, 
VScroll1.Value + VScroll1.SmallChange)
End If
Case vbKeyAdd
If blf < 150 Then
blf = blf + 25
Call fs(blf)
End If
Case vbKeySubtract
If blf > 50 Then
blf = blf - 25
Call fs(blf)
End If
End Select
End SubPrivate Sub Picture2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
d1 = x
d2 = y
Picture2.Drag 1
Set Picture2.DragIcon = LoadPicture("a:\plane.ico")
End SubSub p()'画面和滚动条重设置程序
Picture2.Move 0, 0
HScroll1.Top = Picture1.Height + Picture1.Top
HScroll1.Left = Picture1.Left
HScroll1.Width = Picture1.Width
VScroll1.Top = Picture1.Top
VScroll1.Left = Picture1.Width + Picture1.Left
VScroll1.Height = Picture1.Height
HScroll1.Max = (Picture2.Width - Picture1.Width)
VScroll1.Max = (Picture2.Height - Picture1.Height)
VScroll1.Visible = (Picture1.Height < Picture2.Height)
HScroll1.Visible = (Picture1.Width < Picture2.Width)
End SubPrivate Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
Picture2.SetFocus
End Sub
Private Sub HSCROLL1_Change()
Picture2.Left = -HScroll1.Value
Picture2.SetFocus
End SubSub fs(bl1 As Variant) '画出缩放
Dim bl As Variant
bl = bl1 / 100
Form1.MousePointer = vbHourglass
Picture2.Width = yk * bl
Picture2.Height = yg * bl
Picture2.Refresh
Picture2.PaintPicture Picture2.Picture, 0, 0, yk * bl, yg * bl, 0, 0, yk, yg
Call p
If VScroll1.Visible Then
VScroll1.Value = IIf(VScroll1.Value * bl > VScroll1.Max, VScroll1.Max, VScroll1.Value * bl)
End If
If HScroll1.Visible Then
HScroll1.Value = IIf(HScroll1.Value * bl > HScroll1.Max, HScroll1.Max, HScroll1.Value * bl)
End If
Form1.MousePointer = vbDefault
End Sub
本文的两例程序均在VB5.0中使用通过。

Answer 9

首先给工程(Project)添加一个OCX控件，单击“工程” 菜单项，在弹出的下拉菜单中点击“组件”，选中其中的“Microsoft Common Dialog Control 5.0”，确定完成加载工作；然后画一个PictureBox，采用VB提供的默认名字Picture1，再在Picture1上面画一个PictureBox，默认名字为Picture2，注意别忘了设置Picture2.AutoSize=TRUE；接着，加上水平和垂直滚动条，默认名字分别为HScroll1和VScroll1；以后加载图形到Picture2上就可以了；最后，在窗体中引入其他控件：一个按钮(Command)，默认名为Command1和一个“Microsoft Common Dialog Control”，默认名为CommonDialog1。具体VB代码如下：Private Sub Form_Load()
Picture2.Left = 0
Picture2.Top = 0
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
VScroll1.Min = 0
HScroll1.Min = 0
HScroll1.Min = 0
VScroll1.Max = Picture2.Height - Picture1.Height
HScroll1.Max = Picture2.Width - Picture1.Width
If HScroll1.Max < 0 Then HScroll1.Enabled = False
If VScroll1.Max < 0 Then VScroll1.Enabled = False
End Sub
Private Sub Command1_Click()
On Error GoTo ErrExit
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowOpen
Picture2.Picture = LoadPicture(CommonDialog1.FileName)
VScroll1.Min = 0
HScroll1.Min = 0
VScroll1.Max = Picture2.Height - Picture1.Height
HScroll1.Max = Picture2.Width - Picture1.Width
If HScroll1.Max < 0 Then HScroll1.Enabled = False
If VScroll1.Max < 0 Then VScroll1.Enabled = False
ErrExit:
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub

Answer 10

你留給mail我給你控件得了，特別容易操作，對滾動條