透明位圖繪製方法在網上見得很多，多數是採用事先做好一個Mask圖，這方法優點是速度快，但就是太麻煩，靈活性差。
任意指定透明色，當然經常也要用到，爲此，API提供了一個函數TransparentBlt，可這個函數，非常讓人遺憾，VB的API瀏覽器中不帶它是有道理的，因爲，它在Win98下有嚴重內存漏洞，你若有98系統，可試一下：
for i=1 to 20000
TransparentBlt ....
next
同樣的圖片，在我的XP下16毫秒可完成，但在98下用了14秒，而且，提示系統資源不足，當機了！
下面我寫了一個函數就是可以代替TransparentBlt的一種方法，速度當然會慢些，但在任何系統下都可放心使用。
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long) As Long
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 StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Function TranBlt(DestHdc As Long, X As Long, y As Long, w As Long, h As Long, srcHdcOrBmp As Long, Optional srcX As Long, Optional srcY As Long, Optional srcW As Long, Optional srcH As Long, Optional tc As Long = -1, Optional IsBmp As Boolean) As Long
'srcHdcOrBmp參數 傳入的可以是hdc也可以是Bmp對象的Handle，
'IsBmp參數 爲真時srcHdcOrBmp代表Bmp對象的Handle，爲假時代表hdc
'返回值 成功時返回透明色，不成功時返回-1
Dim tHdc(3) As MemHdc
Dim j As Long, oc As Long, i As Long, Bm As BITMAP, cc As Long, NewDc As Long
Dim sw As Long, sh As Long, sBmp As Long, sHdc As Long, obm As Long, NewX As Long, NewY As Long
If DestHdc = 0 Or srcHdcOrBmp = 0 Or w = 1 And h = 1 Then GoTo fail
If IsBmp Then '若傳入的是Bmp句柄，需爲其創建一個臨時DC
sBmp = srcHdcOrBmp
tHdc(3) = NewMyHdc(DestHdc, 0, 0, srcHdcOrBmp)
sHdc = tHdc(3).hdc
Else
sHdc = srcHdcOrBmp
If srcW = 0 Then sBmp = GetCurrentObject(sHdc, 7)
End If
If sHdc = 0 Or sBmp = 0 Then GoTo fail
If srcW = 0 Then '若沒有提供源圖大小，需取得整個源圖大小
GetObj sBmp, Len(Bm), Bm
sw = Bm.bmWidth - srcX
sh = Bm.bmHeight - srcY
Else
sw = srcW
sh = srcH
End If
If sw < 1 Or sh < 1 Then GoTo fail
If tc = -1 Then
cc = GetPixel(sHdc, srcX, srcY) '將左上角第一個像素作爲源圖背景色，用於透明
Else
cc = tc
End If
If w <> sw Or h <> sh Then
tHdc(2) = NewMyHdc(DestHdc, w, h)
StretchBlt tHdc(2).hdc, 0, 0, w, h, sHdc, srcX, srcY, sw, sh, vbSrcCopy
'先將源圖縮放，下面步驟就一樣了。
NewDc = tHdc(2).hdc
Else
NewDc = sHdc
NewX = srcX
NewY = srcY
End If
BitBlt DestHdc, X, y, w, h, NewDc, NewX, NewY, vbSrcInvert
'將源圖先反色（XOR）繪入目標圖，若源圖背景爲黑色，此步可省
'下面是製作Mask圖的方法
i = CreateBitmap(w, h, 1, 1, ByVal 0&) '建立單色位圖
tHdc(0) = NewMyHdc(DestHdc, 0, 0, i) '爲單色圖建立新DC，並選入
tHdc(1) = NewMyHdc(DestHdc, w, h) '另建一個彩色圖及DC，用於存放Mask圖
oc = SetBkColor(NewDc, cc) '將源圖背景色改爲透明色
BitBlt tHdc(0).hdc, 0, 0, w, h, NewDc, NewX, NewY, vbSrcCopy
'先將源圖繪入單色DC，由此產生只有正反的Mask圖，背景色（透明色）爲黑，其它爲白
SetBkColor NewDc, oc '恢復源圖背景色，不是必須的，但這是個好習慣。
BitBlt tHdc(1).hdc, 0, 0, w, h, tHdc(0).hdc, 0, 0, vbSrcCopy
'單色DC必須複製進彩色DC才能進行後面的的AND運算
'Mask圖完成，並已放入彩色DC
BitBlt DestHdc, X, y, w, h, tHdc(1).hdc, 0, 0, vbSrcAnd '標準透明繪圖：選將Mask圖用And運算繪入，
BitBlt DestHdc, X, y, w, h, NewDc, NewX, NewY, vbSrcInvert '再將源圖以反色(XOR)繪入一次
DelMyHdc tHdc(0)
DelMyHdc tHdc(1)
If tHdc(2).hdc <> 0 Then DelMyHdc tHdc(2)
If tHdc(3).hdc <> 0 Then DelMyHdc tHdc(3)
TranBlt = cc
Exit Function
fail:
If tHdc(3).hdc <> 0 Then DelMyHdc tHdc(3)
TranBlt = -1
End Function
Private Function NewMyHdc(dHdc As Long, w As Long, h As Long, Optional Bm As Long) As MemHdc
With NewMyHdc
.hdc = CreateCompatibleDC(dHdc)
If Bm = 0 Then
.Bmp = CreateCompatibleBitmap(dHdc, w, h)
Else
.Bmp = Bm
End If
.obm = SelectObject(.hdc, .Bmp)
End With
End Function
Private Function DelMyHdc(MyHdc As MemHdc, Optional nobmp As Boolean) As MemHdc
With MyHdc
If .hdc <> 0 And .obm <> 0 Then SelectObject .hdc, .obm
If nobmp = False And .Bmp <> 0 Then DeleteObject .Bmp
If .hdc <> 0 Then DeleteDC .hdc
End With
End Function
Private Sub Command1_Click()
TranBlt Picture1.hdc, 0, 0, Image1.Width, Image1.Height, Image1.Picture.handle, , , , , , True
End Sub
Private Sub Form_Load()
Me.ScaleMode = 3
End Sub
本篇中的公用函數NewMyHdc、DelMyHdc及相關結構與API聲明，可在以下文章中找到
http://blog.csdn.net/homezj/archive/2005/04/14/348001.aspx