需求一个PictureBox(
Named picture2),一个Command按键) Option Explicit Private Declare Function
BitBlt Lib "gdi32" (ByVal hDestDC As Long, _ ByVal x As Long, ByVal y As
Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal hSrcDC As Long,
_ ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dwRop As Long) As
Long Private Declare Function CreateCompatibleDC Lib "gdi32" _ (ByVal hdc
As Long) As Long Private Declare Function SelectObject Lib "gdi32"
_ (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare
Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Const SRCCOPY =
&HCC0020 Private Picture1 As New StdPicture
Private Sub
Command1_Click() Dim i As Long Dim j As Long Dim height5 As Long,
width5 As Long Dim hMemDc As
Long
stdPicture物件的度量单位是Himetric所以要转换成Pixel height5 =
ScaleY(Picture1.Height, vbHimetric, vbPixels) If height5 $#@62;
Picture2.ScaleHeight Then height5 = Picture2.ScaleHeight End If width5
= ScaleX(Picture1.Width, vbHimetric, vbPixels) If width5 $#@62;
Picture2.ScaleWidth Then width5 = Picture2.ScaleWidth End If Create
Memory DC hMemDc =
CreateCompatibleDC(Picture2.hdc) 将Picture1的BitMap图指定给hMemDc Call
SelectObject(hMemDc, Picture1.Handle) For i = height5 To 1 Step
-1 Call BitBlt(Picture2.hdc, 0, i, width5, 1, _ hMemDc, 0, i,
SRCCOPY) For j = i - 1 To Step -1 Call BitBlt(Picture2.hdc, 0, j, width5,
1, _ hMemDc, 0, i, SRCCOPY) Next j Next Call DeleteDC(hMemDc) End
Sub
Private Sub Form_Load() Dim i As Long Picture2.ScaleMode = 3
设定成Pixel的度量单位 设定待Display的图 Set Picture1 =
LoadPicture("c:\windows\素还真.bmp") ^^^^^^^^^^^^^^^^^^^^^^ Load the
picture we want to show End Sub
没有相关教程