• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Make a trasparent bitmap

Các thủ thuật về âm thanh, đồ họa, truyền thông đa phương tiện...
Hình đại diện của người dùng
Dang Minh Du
Thành viên ưu tú
Thành viên ưu tú
Bài viết: 531
Ngày tham gia: T.Tư 02/04/2008 2:08 pm
Đến từ: RGames Team
Has thanked: 3 time
Been thanked: 17 time
Liên hệ:

Make a trasparent bitmap

Gửi bàigửi bởi Dang Minh Du » T.Hai 23/03/2009 3:43 pm

Thủ thuật: Make a trasparent bitmap
Tác giả: Minh Du Sưu tầm
Mô tả: Make a trasparent bitmap



Mã: Chọn hết

  1. 'Add this code to a module:
  2.  
  3. Option Explicit
  4.  
  5. Public Type RECT
  6.   Left As Long
  7.   Top As Long
  8.   Right As Long
  9.   Bottom As Long
  10. End Type
  11.  
  12. Public Declare Function BitBlt Lib "gdi32" _
  13.   (ByVal hDCDest As Long, ByVal XDest As Long, _
  14.    ByVal YDest As Long, ByVal nWidth As Long, _
  15.    ByVal nHeight As Long, ByVal hDCSrc As Long, _
  16.    ByVal XSrc As Long, ByVal YSrc As Long, _
  17.    ByVal dwRop As Long) As Long
  18.  
  19. Public Declare Function CreateBitmap Lib "gdi32" _
  20.   (ByVal nWidth As Long, _
  21.    ByVal nHeight As Long, _
  22.    ByVal nPlanes As Long, _
  23.    ByVal nBitCount As Long, _
  24.    lpBits As Any) As Long
  25.  
  26. Public Declare Function SetBkColor Lib "gdi32" _
  27.    (ByVal hdc As Long, ByVal crColor As Long) As Long
  28.  
  29. Public Declare Function SelectObject Lib "gdi32" _
  30.    (ByVal hdc As Long, ByVal hObject As Long) As Long
  31.  
  32. Public Declare Function CreateCompatibleBitmap Lib "gdi32" _
  33.    (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  34.  
  35. Public Declare Function CreateCompatibleDC Lib "gdi32" _
  36.    (ByVal hdc As Long)As Long
  37.  
  38. Public Declare Function DeleteDC Lib "gdi32" _
  39.    (ByVal hdc As Long) As Long
  40.  
  41. Public Declare Function DeleteObject Lib "gdi32" _
  42.    (ByVal hObject As Long) As Long
  43.  
  44. Add this code to the form's General Declarations procedure:
  45.  
  46. Private Sub Command1_Click()
  47. Dim R As RECT
  48. With R
  49. .Left = 0
  50. .Top = 0
  51. .Right = Picture1.ScaleWidth
  52. .Bottom = Picture1.ScaleHeight
  53. End With
  54. TransparentBlt Form1.hdc, Form1.hdc, Picture1.hdc, R, 20, 20, vbWhite
  55. End Sub
  56.  
  57. Private Sub TransparentBlt(OutDstDC As Long, _
  58.                            DstDC As Long,_
  59.                            SrcDC As Long,_
  60.                            SrcRect As RECT, _
  61.                            DstX As Integer,_
  62.                            DstY As Integer,_
  63.                            TransColor As Long)
  64.  
  65. Dim nRet As Long, W As Integer, H As Integer
  66. Dim MonoMaskDC As Long, hMonoMask As Long
  67. Dim MonoInvDC As Long, hMonoInv As Long
  68. Dim ResultDstDC As Long, hResultDst As Long
  69. Dim ResultSrcDC As Long, hResultSrc As Long
  70. Dim hPrevMask As Long, hPrevInv As Long
  71. Dim hPrevSrc As Long, hPrevDst As Long
  72. W = SrcRect.Right - SrcRect.Left + 1
  73. H = SrcRect.Bottom - SrcRect.Top + 1
  74. MonoMaskDC = CreateCompatibleDC(DstDC)
  75. MonoInvDC = CreateCompatibleDC(DstDC)
  76. hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
  77. hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
  78. hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  79. hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  80. ResultDstDC = CreateCompatibleDC(DstDC)
  81. ResultSrcDC = CreateCompatibleDC(DstDC)
  82. hResultDst = CreateCompatibleBitmap(DstDC, W, H)
  83. hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
  84. hPrevDst = SelectObject(ResultDstDC, hResultDst)
  85. hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  86. Dim OldBC As Long
  87. OldBC = SetBkColor(SrcDC, TransColor)
  88. nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _
  89. SrcRect.Left, SrcRect.Top, vbSrcCopy)
  90. TransColor = SetBkColor(SrcDC, OldBC)
  91. nRet = BitBlt(MonoInvDC, 0, 0, W, H, _
  92. MonoMaskDC, 0, 0, vbNotSrcCopy)
  93. nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
  94. DstDC, DstX, DstY, vbSrcCopy)
  95. nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
  96. MonoMaskDC, 0, 0, vbSrcAnd)
  97. nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _
  98. SrcRect.Left, SrcRect.Top, vbSrcCopy)  
  99. nRet = BitBlt(ResultSrcDC, 0, 0, W, H, _
  100. MonoInvDC, 0, 0, vbSrcAnd)  
  101. nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
  102. ResultSrcDC, 0, 0, vbSrcInvert)
  103. nRet = BitBlt(OutDstDC, DstX, DstY, W, H, _
  104. ResultDstDC, 0, 0, vbSrcCopy)
  105. hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  106. DeleteObject hMonoMask
  107. hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  108. DeleteObject hMonoInv
  109. hResultDst = SelectObject(ResultDstDC, hPrevDst)
  110. DeleteObject hResultDst
  111. hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  112. DeleteObject hResultSrc
  113. DeleteDC MonoMaskDC
  114. DeleteDC MonoInvDC
  115. DeleteDC ResultDstDC
  116. DeleteDC ResultSrcDC
  117. End Sub
  118.  
  119.  


~°Dòng Sông Mùa Thu°~
Studying...!

Hình đại diện của người dùng
BasicVB
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 75
Ngày tham gia: T.Bảy 29/03/2008 2:07 pm
Liên hệ:

Re: Make a trasparent bitmap

Gửi bàigửi bởi BasicVB » T.Hai 23/03/2009 10:09 pm

Transparent 32 BMP :P

Mã: Chọn hết

  1. Option Explicit
  2.  
  3. '  RGB Colors structure
  4. Private Type RGBColor
  5.    r                    As Single
  6.    g                    As Single
  7.    B                    As Single
  8. End Type
  9.  
  10. Private 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. '  for gradient painting and bitmap tiling
  21. Private Type BITMAPINFOHEADER
  22.    biSize               As Long
  23.    biWidth              As Long
  24.    biHeight             As Long
  25.    biPlanes             As Integer
  26.    biBitCount           As Integer
  27.    biCompression        As Long
  28.    biSizeImage          As Long
  29.    biXPelsPerMeter      As Long
  30.    biYPelsPerMeter      As Long
  31.    biClrUsed            As Long
  32.    biClrImportant       As Long
  33. End Type
  34.  
  35.  
  36. Private Type ICONINFO
  37.    fIcon                As Long
  38.    xHotspot             As Long
  39.    yHotspot             As Long
  40.    hbmMask              As Long
  41.    hbmColor             As Long
  42. End Type
  43.  
  44. Private Type RGBTRIPLE
  45.    rgbBlue              As Byte
  46.    rgbGreen             As Byte
  47.    rgbRed               As Byte
  48. End Type
  49.  
  50. Private Type RGBQUAD
  51.    rgbBlue              As Byte
  52.    rgbGreen             As Byte
  53.    rgbRed               As Byte
  54.    rgbAlpha             As Byte
  55. End Type
  56.  
  57. Private Type BITMAPINFO
  58.    bmiHeader            As BITMAPINFOHEADER
  59.    bmiColors            As RGBTRIPLE
  60. End Type
  61.  
  62. ' --System Hand Pointer
  63. Private Const IDC_HAND  As Long = 32649
  64.  
  65. Private Const DI_NORMAL As Long = &H3
  66.  
  67. ' --Color Constant
  68. Private Const COLOR_BTNFACE As Long = 15
  69. Private Const COLOR_BTNHIGHLIGHT As Long = 20
  70. Private Const COLOR_BTNSHADOW As Long = 16
  71. Private Const COLOR_HIGHLIGHT As Long = 13
  72. Private Const COLOR_GRAYTEXT As Long = 17
  73. Private Const CLR_INVALID As Long = &HFFFF
  74. Private Const DIB_RGB_COLORS As Long = 0
  75.  
  76. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
  77. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  78. Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hDc As Long, ByVal x As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
  79. Private Declare Function StretchDIBits Lib "gdi32" (ByVal hDc As Long, ByVal x As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As Any, ByVal wUsage As Long, ByVal dwRop As Long) As Long
  80. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
  81. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  82. Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
  83. Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDc As Long) As Long
  84. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  85. Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
  86. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal Y As Long) As Long
  87. Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hDc As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  88. Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hDc As Long, ByVal x As Long, ByVal Y As Long) As Long
  89. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  90. Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, ByRef pccolorref As Long) As Long
  91. Private Declare Function FillRgn Lib "gdi32" (ByVal hDc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
  92. 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
  93. Private Declare Function GetNearestColor Lib "gdi32" (ByVal hDc As Long, ByVal crColor As Long) As Long
  94. Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
  95. Private Declare Function DrawIconEx Lib "user32" (ByVal hDc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
  96.  
  97. Public Enum enumPicEffect
  98.    [epeNone]
  99.    [epeLighter]
  100.    [epeDarker]
  101. End Enum
  102.  
  103. Private Function TranslateColor(ByVal clrColor As OLE_COLOR, Optional ByRef hPalette As Long = 0) As Long
  104.  
  105.    '****************************************************************************
  106.    '*  System color code to long rgb                                           *
  107.    '****************************************************************************
  108.  
  109.    If OleTranslateColor(clrColor, hPalette, TranslateColor) Then
  110.       TranslateColor = CLR_INVALID
  111.    End If
  112.  
  113. End Function
  114.  
  115. Public Sub TransBlt32(ByVal DstDC As Long, ByVal DstX As Long, ByVal DstY As Long, ByVal DstW As Long, ByVal DstH As Long, ByVal SrcPic As StdPicture, Optional ByVal BrushColor As Long = -1, Optional ByVal isGreyscale As Boolean = False)
  116.    On Error Resume Next
  117. '****************************************************************************
  118. '* Routine : Renders 32 bit Bitmap                                          *
  119. '* Author  : Dana Seaman                                                    *
  120. '****************************************************************************
  121.  
  122.    Dim B                As Long, h As Long, F As Long, i As Long, newW As Long
  123.    Dim TmpDC            As Long, TmpBmp As Long, TmpObj As Long
  124.    Dim Sr2DC            As Long, Sr2Bmp As Long, Sr2Obj As Long
  125.    Dim DataDest()       As RGBQUAD, DataSrc() As RGBQUAD
  126.    Dim Info             As BITMAPINFO, BrushRGB As RGBQUAD, gCol As Long
  127.    Dim hOldOb           As Long, PicEffect As enumPicEffect
  128.    Dim PicBlend         As Boolean
  129.    Dim SrcDC            As Long, tObj As Long, ttt As Long
  130.    Dim a2               As Long
  131.    Dim a1               As Long
  132.  
  133.    If DstW = 0 Or DstH = 0 Then Exit Sub
  134.    If SrcPic Is Nothing Then Exit Sub
  135.  
  136.    SrcDC = CreateCompatibleDC(DstDC)
  137.  
  138.    tObj = SelectObject(SrcDC, SrcPic)
  139.  
  140.    TmpDC = CreateCompatibleDC(SrcDC)
  141.    Sr2DC = CreateCompatibleDC(SrcDC)
  142.    TmpBmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
  143.    Sr2Bmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
  144.    TmpObj = SelectObject(TmpDC, TmpBmp)
  145.    Sr2Obj = SelectObject(Sr2DC, Sr2Bmp)
  146.  
  147.    With Info.bmiHeader
  148.       .biSize = Len(Info.bmiHeader)
  149.       .biWidth = DstW
  150.       .biHeight = DstH
  151.       .biPlanes = 1
  152.       .biBitCount = 32
  153.       .biSizeImage = 4 * ((DstW * .biBitCount + 31) \ 32) * DstH
  154.    End With
  155.    ReDim DataDest(Info.bmiHeader.biSizeImage - 1)
  156.    ReDim DataSrc(UBound(DataDest))
  157.  
  158.    BitBlt TmpDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, vbSrcCopy
  159.    BitBlt Sr2DC, 0, 0, DstW, DstH, SrcDC, 0, 0, vbSrcCopy
  160.    GetDIBits TmpDC, TmpBmp, 0, DstH, DataDest(0), Info, 0
  161.    GetDIBits Sr2DC, Sr2Bmp, 0, DstH, DataSrc(0), Info, 0
  162.  
  163.    If BrushColor <> -1 Then
  164.       BrushRGB.rgbBlue = (BrushColor \ &H10000) Mod &H100
  165.       BrushRGB.rgbGreen = (BrushColor \ &H100) Mod &H100
  166.       BrushRGB.rgbRed = BrushColor And &HFF
  167.    End If
  168.  
  169.    newW = DstW - 1
  170.  
  171.    For h = 0 To DstH - 1
  172.       F = h * DstW
  173.       For B = 0 To newW
  174.          i = F + B
  175.          With DataDest(i)
  176.             If BrushColor <> -1 Then
  177.                If DataSrc(i).rgbAlpha = 255 Then
  178.                   .rgbRed = BrushRGB.rgbRed
  179.                   .rgbGreen = BrushRGB.rgbGreen
  180.                   .rgbBlue = BrushRGB.rgbBlue
  181.                ElseIf DataSrc(i).rgbAlpha > 0 Then
  182.                   a1 = DataSrc(i).rgbAlpha
  183.                   a2 = 255 - a1
  184.                   .rgbRed = (a2 * .rgbRed + a1 * BrushRGB.rgbRed) \ 256
  185.                   .rgbGreen = (a2 * .rgbGreen + a1 * BrushRGB.rgbGreen) \ 256
  186.                   .rgbBlue = (a2 * .rgbBlue + a1 * BrushRGB.rgbBlue) \ 256
  187.                End If
  188.             Else
  189.                If isGreyscale Then
  190.                   gCol = CLng(DataSrc(i).rgbRed * 0.3) + DataSrc(i).rgbGreen * 0.59 + DataSrc(i).rgbBlue * 0.11
  191.                   If DataSrc(i).rgbAlpha = 255 Then
  192.                      .rgbRed = gCol: .rgbGreen = gCol: .rgbBlue = gCol
  193.                   ElseIf DataSrc(i).rgbAlpha > 0 Then
  194.                      a1 = DataSrc(i).rgbAlpha
  195.                      a2 = 255 - a1
  196.                      .rgbRed = (a2 * .rgbRed + a1 * gCol) \ 256
  197.                      .rgbGreen = (a2 * .rgbGreen + a1 * gCol) \ 256
  198.                      .rgbBlue = (a2 * .rgbBlue + a1 * gCol) \ 256
  199.                   End If
  200.                Else
  201.                   If DataSrc(i).rgbAlpha = 255 Then
  202.                         DataDest(i) = DataSrc(i)
  203.                   ElseIf DataSrc(i).rgbAlpha > 0 Then
  204.                      a1 = DataSrc(i).rgbAlpha
  205.                      a2 = 255 - a1
  206.                         .rgbRed = (a2 * .rgbRed + a1 * DataSrc(i).rgbRed) \ 256
  207.                         .rgbGreen = (a2 * .rgbGreen + a1 * DataSrc(i).rgbGreen) \ 256
  208.                         .rgbBlue = (a2 * .rgbBlue + a1 * DataSrc(i).rgbBlue) \ 256
  209.                   End If
  210.                End If
  211.             End If
  212.          End With
  213.       Next B
  214.    Next h
  215.  
  216.    ' /--Paint it!
  217.    SetDIBitsToDevice DstDC, DstX, DstY, DstW, DstH, 0, 0, 0, DstH, DataDest(0), Info, 0
  218.  
  219.    Erase DataDest, DataSrc
  220.    DeleteObject SelectObject(TmpDC, TmpObj)
  221.    DeleteObject SelectObject(Sr2DC, Sr2Obj)
  222.    If SrcPic.Type = vbPicTypeIcon Then DeleteObject SelectObject(SrcDC, tObj)
  223.    DeleteDC TmpDC
  224.    DeleteDC Sr2DC
  225.    DeleteObject tObj
  226.    DeleteDC SrcDC
  227.  
  228. End Sub
  229.  
  230. Private Function Is32BitBMP(obj As Object) As Boolean
  231.    Dim uBI              As BITMAP
  232.  
  233.    If obj.Type = vbPicTypeBitmap Then
  234.       Call GetObject(obj.Handle, Len(uBI), uBI)
  235.       Is32BitBMP = uBI.bmBitsPixel = 32
  236.    End If
  237.    
  238. End Function
  239.  
  240. Private Sub TransBlt(ByVal DstDC As Long, ByVal DstX As Long, ByVal DstY As Long, ByVal DstW As Long, ByVal DstH As Long, ByVal SrcPic As StdPicture, Optional ByVal TransColor As Long = -1, Optional ByVal BrushColor As Long = -1, Optional ByVal MonoMask As Boolean = False, Optional ByVal isGreyscale As Boolean = False)
  241.  
  242. '****************************************************************************
  243. '* Routine : To make transparent and grayscale images
  244. '* Author  : Gonkuchi
  245. '
  246. '* Modified by Dana Seaman
  247. '****************************************************************************
  248.  
  249.    Dim B                As Long, h As Long, F As Long, i As Long, newW As Long
  250.    Dim TmpDC            As Long, TmpBmp As Long, TmpObj As Long
  251.    Dim Sr2DC            As Long, Sr2Bmp As Long, Sr2Obj As Long
  252.    Dim DataDest()       As RGBTRIPLE, DataSrc() As RGBTRIPLE
  253.    Dim Info             As BITMAPINFO, BrushRGB As RGBTRIPLE, gCol As Long
  254.    Dim hOldOb           As Long, PicEffect As enumPicEffect
  255.    Dim SrcDC            As Long, tObj As Long, ttt As Long
  256.  
  257.    If DstW = 0 Or DstH = 0 Then Exit Sub
  258.    If SrcPic Is Nothing Then Exit Sub
  259.    
  260.    SrcDC = CreateCompatibleDC(DstDC)
  261.    
  262.    If SrcPic.Type = vbPicTypeBitmap Then 'check if it's an icon or a bitmap
  263.       tObj = SelectObject(SrcDC, SrcPic)
  264.    Else
  265.       Dim hBrush           As Long
  266.       tObj = SelectObject(SrcDC, CreateCompatibleBitmap(DstDC, DstW, DstH))
  267.       hBrush = CreateSolidBrush(TransColor)
  268.       DrawIconEx SrcDC, 0, 0, SrcPic.Handle, DstW, DstH, 0, hBrush, DI_NORMAL
  269.       DeleteObject hBrush
  270.    End If
  271.  
  272.    TmpDC = CreateCompatibleDC(SrcDC)
  273.    Sr2DC = CreateCompatibleDC(SrcDC)
  274.    TmpBmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
  275.    Sr2Bmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
  276.    TmpObj = SelectObject(TmpDC, TmpBmp)
  277.    Sr2Obj = SelectObject(Sr2DC, Sr2Bmp)
  278.    ReDim DataDest(DstW * DstH * 3 - 1)
  279.    ReDim DataSrc(UBound(DataDest))
  280.    With Info.bmiHeader
  281.       .biSize = Len(Info.bmiHeader)
  282.       .biWidth = DstW
  283.       .biHeight = DstH
  284.       .biPlanes = 1
  285.       .biBitCount = 24
  286.    End With
  287.  
  288.    BitBlt TmpDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, vbSrcCopy
  289.    BitBlt Sr2DC, 0, 0, DstW, DstH, SrcDC, 0, 0, vbSrcCopy
  290.    GetDIBits TmpDC, TmpBmp, 0, DstH, DataDest(0), Info, 0
  291.    GetDIBits Sr2DC, Sr2Bmp, 0, DstH, DataSrc(0), Info, 0
  292.  
  293.    If BrushColor > 0 Then
  294.       BrushRGB.rgbBlue = (BrushColor \ &H10000) Mod &H100
  295.       BrushRGB.rgbGreen = (BrushColor \ &H100) Mod &H100
  296.       BrushRGB.rgbRed = BrushColor And &HFF
  297.    End If
  298.  
  299.    newW = DstW - 1
  300.  
  301.    For h = 0 To DstH - 1
  302.       F = h * DstW
  303.       For B = 0 To newW
  304.          i = F + B
  305.          If GetNearestColor(DstDC, CLng(DataSrc(i).rgbRed) + 256& * DataSrc(i).rgbGreen + 65536 * DataSrc(i).rgbBlue) <> TransColor Then
  306.             With DataDest(i)
  307.                If BrushColor > -1 Then
  308.                   If MonoMask Then
  309.                      If (CLng(DataSrc(i).rgbRed) + DataSrc(i).rgbGreen + DataSrc(i).rgbBlue) <= 384 Then DataDest(i) = BrushRGB
  310.                   Else
  311.                      DataDest(i) = BrushRGB
  312.                   End If
  313.                Else
  314.                   If isGreyscale Then
  315.                      gCol = CLng(DataSrc(i).rgbRed * 0.3) + DataSrc(i).rgbGreen * 0.59 + DataSrc(i).rgbBlue * 0.11
  316.                      .rgbRed = gCol: .rgbGreen = gCol: .rgbBlue = gCol
  317.                   Else
  318.                         DataDest(i) = DataSrc(i)
  319.                   End If
  320.                End If
  321.             End With
  322.          End If
  323.       Next B
  324.    Next h
  325.  
  326.    ' /--Paint it!
  327.    SetDIBitsToDevice DstDC, DstX, DstY, DstW, DstH, 0, 0, 0, DstH, DataDest(0), Info, 0
  328.  
  329.    Erase DataDest, DataSrc
  330.    DeleteObject SelectObject(TmpDC, TmpObj)
  331.    DeleteObject SelectObject(Sr2DC, Sr2Obj)
  332.    If SrcPic.Type = vbPicTypeIcon Then DeleteObject SelectObject(SrcDC, tObj)
  333.    DeleteDC TmpDC
  334.    DeleteDC Sr2DC
  335.    DeleteObject tObj
  336.    DeleteDC SrcDC
  337.  
  338. End Sub
  339.  
  340.  


AutoRedraw=True : ScaleMode=vbPixels
Sử dụng : TransBlt32 Me.hDc, 0, 0, picTest.ScaleWidth, picTest.ScaleHeight, pic32.Picture

Koha JeseMen
Thành viên chính thức
Thành viên chính thức
Bài viết: 24
Ngày tham gia: T.Ba 27/07/2010 9:00 pm
Has thanked: 5 time

Re: Make a trasparent bitmap

Gửi bàigửi bởi Koha JeseMen » T.Tư 27/04/2011 5:42 pm

Chả hiểu và cũng chả dùng đc :( :D


Quay về “[VB] Âm thanh và Đồ họa”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách