Results 1 to 7 of 7

Thread: A good code Just not work[solved]

Threaded View

  1. #1

    Thread Starter
    Lively Member WindowsNuclear's Avatar
    Join Date
    Oct 2002
    Posts
    106

    Unhappy A good code Just not work[solved]

    '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:
    1. 'Declaration
    2. Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    3. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    4. Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    5. Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    6. Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    7. Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
    8.  
    9. Public Const RGN_OR = 2
    10. Public Type BITMAP
    11. bmType As Long
    12. bmWidth As Long
    13. bmHeight As Long
    14. bmWidthBytes As Long
    15. bmPlanes As Integer
    16. bmBitsPixel As Integer
    17. bmBits As Long
    18. End Type
    19.  
    20. Dim bmbyte() As Byte
    21.  
    22. Public Sub SetAutoRgn(hfrom As Form, Optional TransColor As Byte = vbNull)
    23. Dim x As Long, y As Long
    24. Dim rgn1 As Long, rgn2 As Long
    25. Dim spos As Long, epos As Long
    26. Dim bm As BITMAP
    27. Dim hbm As Long
    28. Dim wid As Long, hgt As Long
    29.  
    30. 'get the size of the backgroud picture
    31. hbm = hform.Picture
    32. GetObject hbm, Len(bm), bm
    33. wid = bm.bmWidth
    34. hgt = bm.bmHeight
    35.  
    36. hform.Height = hgt * Screen.TwipsPerPixelY
    37. hform.Width = wid * Screen.TwipsPerPixelX
    38.  
    39. ReDim bmbyte(1 To wid, 1 To hgt)
    40. 'get arrays of picture's pelses
    41. GetBitmapBits hbm, wid * hgt, bmbyte(1, 1)
    42. If TransColor = vbNull Then TransColor = bmbyte(1, 1)
    43. rgn1 = CreateRectRgn(0, 0, 0, 0)
    44.  
    45. For y = 1 To hgt
    46. x = 0
    47. Do
    48. x = x + 1
    49.  
    50. While (bmbyte(x, y) = TransColor) And (x < wid)
    51. x = x + 1
    52. Wend
    53. spos = x
    54.  
    55.  
    56. While (bmbyte(x, y) <> TransColor) And (x < wid)
    57. x = x + 1
    58. Wend
    59. epos = x - 1
    60.  
    61. If spos <= epos Then
    62. rgn2 = CreateRectRgn(spos - 1, y - 1, epos, y)
    63. CombineRgn rgn1, rgn1, rgn2, RGN_OR
    64. DeleteObject rgn2
    65. End If
    66. Loop Until x >= wid
    67. Next y
    68.  
    69.  
    70. SetWindowRgn hform.hWnd, rgn1, True
    71. DeleteObject rgn1
    72.  
    73. 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
    Last edited by WindowsNuclear; Oct 29th, 2002 at 04:54 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width