在窗体中先画出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
体中再画出滚动条,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