📄 m81.htm
字号:
<html>
<head>
<title>VB教程</title>
<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=9>
<div align=center class=H1> <font color="#FFFFFF">雨滴式的显示图片</font> </font> </font></div>
</td>
</tr>
<tr valign=top>
<td class=H1 height=76>
<p align="left"> <br>
<br>
<br>
本范例是以一个stdPicture物件来存图形，之後於PictureBox中以特殊效果来显示。因为我们想显示的只有一个图，所以不想多用另一个PictureBox来存原始图，而後再画到另一个PictureBox上，那只有用StdPicture
物件来取代PictureBox(存来源图)，但是BitBlt这个绘图函式需来源与目的的hDc，而StdPicture物件没有hDc，它只有一个Handle值，以本例来说，这Handle值便是图形的hBitmap值。所以我们只好使用MemoryDC的方式来做，产生一个MemoryDc後将BitMap图放於其上，之後便可以使用BitBlt来绘图了。</span></font> <br>
<br>
</font></p>
<table border=0 width="711">
<tbody>
<tr>
<td>
<p><font color="#000000" class="unnamed1">'需求一个PictureBox( Named
picture2)，一个Command按键)<br>
Option Explicit<br>
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As
Long, _<br>
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _<br>
ByVal nHeight As Long, ByVal hSrcDC As Long, _<br>
ByVal xSrc As Long, ByVal ySrc As Long, _<br>
ByVal dwRop As Long) As Long<br>
Private Declare Function CreateCompatibleDC Lib "gdi32" _<br>
(ByVal hdc As Long) As Long<br>
Private Declare Function SelectObject Lib "gdi32" _<br>
(ByVal hdc As Long, ByVal hObject As Long) As Long<br>
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long)
As Long<br>
Const SRCCOPY = &HCC0020<br>
Private Picture1 As New StdPicture<br>
<br>
Private Sub Command1_Click()<br>
Dim i As Long<br>
Dim j As Long<br>
Dim height5 As Long, width5 As Long<br>
Dim hMemDc As Long<br>
<br>
'stdPicture物件的度量单位是Himetric所以要转换成Pixel<br>
height5 = ScaleY(Picture1.Height, vbHimetric, vbPixels)<br>
If height5 > Picture2.ScaleHeight Then<br>
height5 = Picture2.ScaleHeight<br>
End If<br>
width5 = ScaleX(Picture1.Width, vbHimetric, vbPixels)<br>
If width5 > Picture2.ScaleWidth Then<br>
width5 = Picture2.ScaleWidth<br>
End If<br>
'Create Memory DC<br>
hMemDc = CreateCompatibleDC(Picture2.hdc)<br>
'将Picture1的BitMap图指定给hMemDc<br>
Call SelectObject(hMemDc, Picture1.Handle)<br>
For i = height5 To 1 Step -1<br>
Call BitBlt(Picture2.hdc, 0, i, width5, 1, _<br>
hMemDc, 0, i, SRCCOPY)<br>
For j = i - 1 To 1 Step -1<br>
Call BitBlt(Picture2.hdc, 0, j, width5, 1, _<br>
hMemDc, 0, i, SRCCOPY)<br>
Next j<br>
Next<br>
Call DeleteDC(hMemDc)<br>
End Sub<br>
<br>
Private Sub Form_Load()<br>
Dim i As Long<br>
Picture2.ScaleMode = 3 '设定成Pixel的度量单位<br>
'设定待Display的图<br>
Set Picture1 = LoadPicture("c:\windows\素还真.bmp")<br>
' ^^^^^^^^^^^^^^^^^^^^^^<br>
' Load the picture we want to show<br>
End Sub</font><br>
</p>
</td>
</tr>
</tbody>
</table>
<p align="left">
</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 + -