圖形API-幻化圖形

需求:一個PictureBox一個Command按鍵)

主表單程式碼
Option Explicit
Private mypicture As New StdPicture

按下變化按鈕的事件程序
Private Sub Command1_Click()
Dim i As Long
Dim j As Long
Dim myheight As Long, mywidth As Long
Dim myDC As Long '畫布變數

'stdPicture物件的度量單位是Himetric所以要轉換成Pixel
myheight = ScaleY(mypicture.Height, vbHimetric, vbPixels)
If myheight > Picture1.ScaleHeight Then
myheight = Picture1.ScaleHeight
End If

mywidth = ScaleX(mypicture.Width, vbHimetric, vbPixels)
If mywidth > Picture1.ScaleWidth Then
mywidth = Picture1.ScaleWidth
End If

'建立記憶體中的畫布空間
myDC = CreateCompatibleDC(Picture1.hdc)

'將mypicture(預做轉移變化的圖形)的BitMap圖指定給myDC(偶們在記憶體中建立的畫布空間)
Call SelectObject(myDC, mypicture.Handle)

For i = myheight To 1 Step -1
Call BitBlt(Picture1.hdc, 0, i, mywidth, 1, myDC, 0, i, vbSrcCopy)
For j = i - 1 To 1 Step -1
Call BitBlt(Picture1.hdc, 0, j, mywidth, 1, myDC, 0, i, vbSrcCopy)
Next j
Next
'清除偶們在記憶體中建立的畫布空間
Call DeleteDC(myDC) 
End Sub

表單載入事件程序
Private Sub Form_Load()
'設定成Pixel的度量單
Picture1.ScaleMode = 3 
'指定要產生變化的來源圖片
Set mypicture = LoadPicture("a:\welcome.bmp")
End Sub

模組程式碼

'圖像轉移函數
Public 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

'hDestDC-->圖像轉移的目的地DC(畫布)
'x,y-->圖像轉移目的地的畫布位置
'hSrcDC-->圖像轉移的來源DC(畫布)
'xSrc,ySrc-->圖像轉移的來源畫布的位置
'dwRop-->圖像轉移方式
'-->vbSrcCopy 覆寫
'-->vbDstInvert 圖形反向

'建立記憶體中的畫布空間
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

'將指定的hBitmap指定為記憶體中畫布的Bitmap物件
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

'清除記憶體中的畫布DC空間
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

本網頁由昱得資訊工作室製作(C) Copyright Valor-Studio Since in 1993