📄 ba32.htm
字号:
<HTML>
<HEAD>
<TITLE>在VB中制作可滚动的图像显示</TITLE>
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
</head>
<p align="center"><script src="../../1.js"></script></a>
<BODY topMargin=4 vLink=#0000ff>
<TABLE border=0 cellPadding=0 cellSpacing=0 width="100%">
<TBODY>
<TR>
<TD height="52">
<DIV align=center>
<CENTER>
<table border=0 cellpadding=0 cellspacing=0 width=679 align="center">
<tbody>
<tr>
<td width=200 height="59">
</TD></TR><!--msnavigation--></TBODY></TABLE>
<table border=0 cellpadding=0 cellspacing=0 width="100%">
<tbody>
<tr><!--msnavigation--><td valign=top height="123">
<div align=center>
<table border=1 bordercolor=#b9d9ff cellpadding=0 cellspacing=0
class=table width=755>
<center>
<tr>
<td width="100%" height="15">
<div align="center"> <strong><b>在VB中制作可滚动的图像显示</b> </strong></span></div>
</td>
</tr>
<tr>
<td
width="100%" class="unnamed1" height="124">
<div align="left"><br>
<br>
<font size="-1" face="宋体">摘要：我们在制作多媒体程序时，不可避免的要涉及图像的显示，尽管VB中提供的picturebox可以显示多种格式的图像文件，但由于没有提供滚动条和缩放功能，在使用中多有不便。笔者在编制一多媒体程序时，就需要对图像进行缩放显示。这通常有两种处理办法，一是利用第三方控件，如Windows自带的WANG图像控件；二是利用VB的picturebox和滚动条控件自行编程实现。本文给出了利用这两种方法制作的实例。<br>
<br>
<b>在VB中制作可滚动的图像显示</b><br>
<br>
我们在制作多媒体程序时，不可避免的要涉及图像的显示，尽管VB中提供的picturebox可以显示多种格式的图像文件，但由于没有提供滚动条和缩放功能，在使用中多有不便。笔者在编制一多媒体程序时，就需要对图像进行缩放显示。这通常有两种处理办法，一是利用第三方控件，如Windows自带的WANG图像控件；二是利用VB的picturebox和滚动条控件自行编程实现。两种方法各有优缺点,可以根据需要具体选用。<br>
<b><br>
一，利用第三方控件实现</b><br>
在“工程”中选取“部件”，将WANG 图像编辑控制添加到工具箱中，并在窗体中绘制出合适大小，按鼠标右键，选取特性，设置好各种参数后加入程序代码就行了，使用非常简单，如果需要，在程序中也可加入一定的图像编辑功能。采用第三方控件，功能较强，程序编制也简单一些，不失为一种好方法。但存在一些其他问题，比如本文采用的WANG
图像编辑控制，在使用中就经常出现“类没有注册”的错误，解决此问题，要么修改注册表，要么重装系统，很麻烦，所以在要求的功能不是很多的情况下，用第二种方法比较合适。以下就是使用WANG控件的程序，可以看出，代码很简单。<br>
<br>
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>
<b>二是利用VB的picturebox和滚动条控件编程实现</b><br>
PICTUREBOX控件能支持许多种图像格式，但没有缩放功能并且不自动添加滚动条，所以必须自行编程实现。 <br>
<br>
应用程序使用两个图片框，一个作为包容器，可称之为父图片框，另一个作为子图片框显示图形，配合滚动条控件在父图片框内移动子图片框就可实现画面的滚动。<br>
<br>
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属性设为合适大小,窗体既设置完毕。<br>
<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>
<br>
转载自popcool开发专区</font></div>
</td>
</tr>
</center>
<tr>
<td width="100%" class="unnamed1">
<p align=right><a href="ba31.htm">（上一页）</a>---<a href="ba33.htm">（下一页）</a></p>
</td>
</tr>
<tr>
<td width="100%" class="unnamed1">
</div>
</td>
</tr>
<!--msnavigation--></tbody>
</table>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -