怎样使拥有水平与垂直滚动条或者有滚动条的作用?怎样使PictureBox内的图片按一定的比例缩小或扩大?

解决方案 »

  1.   

    用imagebox吧,把strength设为true 就行了
      

  2.   

    在窗体中先画出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