From: http://blog.9cbs.net/homezj/archive/2005/04/17/351127.aspx
The transparent bit drawing method is much more in the Internet. Most is made in advance, this method is the advantage of being fast, but it is too trouble, flexible. Any specified transparent color, of course, often used, for this, the API provides a function transparentBLT, which can be a function, very unfortunate, vb's API browser does not make it feelings, because it is in Win98 There is a serious memory vulnerability. If you have 98 systems, try: for i = 1 to 20000transparentblt .... next, the same picture, 16 milliseconds under my XP, but in 98 for 14 seconds, Moreover, prompt system resources, when it is!
Below I wrote a function that can replace the transparentblt, which is of course slow, but can be used with confidence under any system.
Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As LongEnd TypePrivate Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As LongPrivate Declare Function GetObj Lib " GDI32 "Alias" getObjecta "(Byval ncount as long, lpobject as any) As longprivate declare function setbkcolor lib" gdi32 "(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 LongPrivate Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long) As LongPrivate 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 LongPrivate 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 DWROP AS Long AS Long
Public Function Tranblt (DESTHDC AS Long, X As Long, Y As Long, W AS Long, Optional 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 parameter can be HDC can also be a HANDLE of the BMP object,' IsBMP parameter is true when srchdcorbmp represents the Handle of the BMP object, represents HDC 'for the fake Return to transparent color when the value is successful, returns -1 DIM THDC (3) AS MemHDC DIM J 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 'If it is incoming BMP handle, you need to create a temporary 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 'If the source map size is not provided, the entire source map size is required. ETOBJ SBMP, LEN (BM), BM SW = BM.BMWIDTH - SRCX SH = BM.BMHEIGHT - SRCY ELSE SW = SRCW SH = SRCH END IF IF IF TC = -1 Then Goto Fail IF TC = -1 THEN CC = Getpixel (SHDC, SRCX, SRCY) 'Picking the first pixels of the upper left as a source map background color, used in transparent else cc = tc end if if => SW or H <> shin thdc (2) = newmyHDC ( DESTHDC, W, H) STRETCHBLT THDC (2) .HDC, 0, 0, W, H, SHDC, SRCX, SRCY, SW, SH, VBSRCCopy 'First zoom, the following steps are the same.
NewDC = THDC (2) .hdc else newdc = shdc newx = srcx newy = SRCY END IF BITBLT DESTHDC, X, Y, W, H, NewDC, NEWX, NewY, VBSRCINVERT 'Pictures the source map prior abuse (xor) Target map, if the source map background is black, this step can save the method of making Mask diagrams i = CreateBitmap (W, h, 1, 1, byval 0 &) Established monochrome bit map THDC (0) = newmyHDC DESTHDC, 0, 0, i) 'Establish a new DC for monochrome maps and is selected to build a color map and DC, which is built into THDC (1) = newmyHDC (DESTHDC, W, H)'. (NewDC, CC) 'Change the source map background color to transparent color Bitblt THDC (0) .hdc, 0, 0, w, h, newdc, newx, newy, vbsrcopy "first plot the source map into monochrome DC, by This creates only the positive and negative MASK diagrams, the background color (transparent color) is black, the other white setbkcolor newdc, the OC 'recovery source map background color, not necessary, but this is a good habit. Bitblt THDC (1) .HDC, 0, 0, W, H, THDC (0) .HDC, 0, 0, VBSRCPY 'MMS DC must copy the color DC to perform the back of the AND operation' Mask map is completed, and Added color DC Bitblt Desthdc, X, Y, W, H, THDC (1) .HDC, 0, 0, VBSRCAND 'standard transparent drawing: Select the Mask map with and operate into, Bitblt Desthdc, X, Y, W, h, newdc, newx, newy, vbsrcinvert ', retest the source map to the anti-color (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 FUNCTIONFAIL: IF THDC (3) .hdc <> 0 THEN DELMYHDC THDC (3) TRANBLT = -1END 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 WithEnd FunctionPrivate 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 Withend FunctionPrivate Sub Command1_Click () TRANBLT PICTURE1.HDC, 0, 0, Image1.Width, Image1. Truend subsequences ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Private sub flow_load () me.scalemode = 3end Sub
The public function in this article NewmyHDC, DelmyHDC and related structures and API declarations can be found in this article http://blog.9cbs.net/Homezj/archive/2005/04/14/348001.aspx
