在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 Sub Private Sub Form_Resize() ImgEdit1.Top = 0 ImgEdit1.Left = 0 ImgEdit1.Height = Form1.ScaleHeight ImgEdit1.Width = Form1.ScaleWidth End Sub Private 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 Long Private Sub Form_Load()
c1 = Form1.Width c2 = Form1.Height blf = 100 Picture2.Picture = LoadPicture("a:\ddd.jpg") yk = Picture2.Width yg = Picture2.Height End Sub Private 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 Sub Private 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 Sub Sub 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 Sub Private Sub VScroll1_Change() Picture2.Top = -VScroll1.Value Picture2.SetFocus End Sub Private Sub HSCROLL1_Change() Picture2.Left = -HScroll1.Value Picture2.SetFocus End Sub Sub 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中使用通过。