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