雨滴式的顯示圖片

發表于:2007-07-14來源:作者:點擊數: 標簽:
本范例是以一個stdPicture物件來存圖形,之後於PictureBox中以特殊效果來顯示。 因為我們想顯示的只有一個圖,所以不想多用另一個PictureBox來存原始圖,而后再畫到另一個PictureBox上,那只有用StdPicture 物件來取代PictureBox(存來源圖),但是BitBlt這個
  本范例是以一個stdPicture物件來存圖形,之後於PictureBox中以特殊效果來顯示。 因為我們想顯示的只有一個圖,所以不想多用另一個PictureBox來存原始圖,而后再畫到另一個PictureBox上,那只有用StdPicture 物件來取代PictureBox(存來源圖),但是BitBlt這個繪圖函式需來源與目的的hDc,而StdPicture物件沒有hDc,它只有一個Handle值,以本例來說,這Handle值便是圖形的hBitmap值。所以我們只好使用 MemoryDC的方式來做,產生一個MemoryDc後將BitMap圖放於其上,之後便可以使用BitBlt來繪圖了。'需求一個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 > Picture2.ScaleHeight Then

height5 = Picture2.ScaleHeight

End If

width5 = ScaleX(Picture1.Width, vbHimetric, vbPixels)

If width5 > 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 1 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\aaa.bmp")

' ^^^^^^^^^^^^^^^^^^^^^^

' Load the picture we want to show

End Sub

原文轉自:http://www.anti-gravitydesign.com

国产97人人超碰caoprom_尤物国产在线一区手机播放_精品国产一区二区三_色天使久久综合给合久久97