home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1251.psc / module1.bas < prev   
Encoding:
BASIC Source File  |  1999-10-10  |  3.4 KB  |  83 lines
  1. Attribute VB_Name = "Module1"
  2. '***************************'
  3.  
  4. 'General Api Declarations
  5. Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  6. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  7. Public Declare Function ReleaseCapture Lib "user32" () As Long
  8. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  9. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  10. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  11. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  12. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  13. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  14. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  15. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  16.  
  17. '***************************'
  18.  
  19. Private Type BITMAP
  20.     bmType As Long
  21.     bmWidth As Long
  22.     bmHeight As Long
  23.     bmWidthBytes As Long
  24.     bmPlanes As Integer
  25.     bmBitsPixel As Integer
  26.     bmBits As Long
  27. End Type
  28.  
  29. '***************************'
  30.  
  31. Public Const WM_NCLBUTTONDOWN = &HA1
  32. Public Const HTCAPTION = 2
  33.  
  34. '***************************'
  35.  
  36. Public Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long)
  37. 'Variable Declaration
  38.     Dim hRgn As Long, tRgn As Long
  39.     Dim X As Integer, Y As Integer, X0 As Integer
  40.     Dim hDC As Long, BM As BITMAP
  41. 'Create a new memory DC, where we will scan the picture
  42.     hDC = CreateCompatibleDC(0)
  43.     If hDC Then
  44. 'Let the new DC select the Picture
  45.         SelectObject hDC, cPicture
  46. 'Get the Picture dimensions and create a new rectangular
  47. 'region
  48.         GetObject cPicture, Len(BM), BM
  49.         hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
  50. 'Start scanning the picture from top to bottom
  51.         For Y = 0 To BM.bmHeight
  52.             For X = 0 To BM.bmWidth
  53. 'Scan a line of non transparent pixels
  54.                 While X <= BM.bmWidth And GetPixel(hDC, X, Y) <> cTransparent
  55.                     X = X + 1
  56.                 Wend
  57. 'Mark the start of a line of transparent pixels
  58.                 X0 = X
  59. 'Scan a line of transparent pixels
  60.                 While X <= BM.bmWidth And GetPixel(hDC, X, Y) = cTransparent
  61.                     X = X + 1
  62.                 Wend
  63. 'Create a new Region that corresponds to the row of
  64. 'Transparent pixels and then remove it from the main
  65. 'Region
  66.                 If X0 < X Then
  67.                     tRgn = CreateRectRgn(X0, Y, X, Y + 1)
  68.                     CombineRgn hRgn, hRgn, tRgn, 4
  69. 'Free the memory used by the new temporary Region
  70.                     DeleteObject tRgn
  71.                 End If
  72.             Next X
  73.         Next Y
  74. 'Return the memory address to the shaped region
  75.         GetBitmapRegion = hRgn
  76. 'Free memory by deleting the Picture
  77.         DeleteObject SelectObject(hDC, cPicture)
  78.     End If
  79. 'Free memory by deleting the created DC
  80.     DeleteDC hDC
  81. End Function
  82.  
  83.