'This methode Can use a backgroud picture, to form the from
'as the picture's figure.
'Just assigned a color from all colors of the picture as the "transparence" color,just as 'gif dose.
VB Code:
'Declaration Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long Public Const RGN_OR = 2 Public 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 Dim bmbyte() As Byte Public Sub SetAutoRgn(hfrom As Form, Optional TransColor As Byte = vbNull) Dim x As Long, y As Long Dim rgn1 As Long, rgn2 As Long Dim spos As Long, epos As Long Dim bm As BITMAP Dim hbm As Long Dim wid As Long, hgt As Long 'get the size of the backgroud picture hbm = hform.Picture GetObject hbm, Len(bm), bm wid = bm.bmWidth hgt = bm.bmHeight hform.Height = hgt * Screen.TwipsPerPixelY hform.Width = wid * Screen.TwipsPerPixelX ReDim bmbyte(1 To wid, 1 To hgt) 'get arrays of picture's pelses GetBitmapBits hbm, wid * hgt, bmbyte(1, 1) If TransColor = vbNull Then TransColor = bmbyte(1, 1) rgn1 = CreateRectRgn(0, 0, 0, 0) For y = 1 To hgt x = 0 Do x = x + 1 While (bmbyte(x, y) = TransColor) And (x < wid) x = x + 1 Wend spos = x While (bmbyte(x, y) <> TransColor) And (x < wid) x = x + 1 Wend epos = x - 1 If spos <= epos Then rgn2 = CreateRectRgn(spos - 1, y - 1, epos, y) CombineRgn rgn1, rgn1, rgn2, RGN_OR DeleteObject rgn2 End If Loop Until x >= wid Next y SetWindowRgn hform.hWnd, rgn1, True DeleteObject rgn1 End Sub
' The code's author is the host of WWW.ARCHTIDE.COM, but this
'function cause error in my
'Program.Can anybody know what's wrong with it?THS




Reply With Quote