webForumDet fria alternativet

Transparent?

3 svar · 306 visningar · startad av joxxe

joxxeMedlem sedan okt. 200357 inlägg
#1

Kan man på något sätt få bilderna i en picturebox transparenta?
för har man en image är de ju bara lägga in en gif bild så blir det transparent om man sparat bilden så.
Men nu är det så att jag måste använda mig av autoredraw som endast fungerar för picturebox, för annars "blinkar" bilderna så hemskt mycket.

Hur ska jag göra? :q

PsyDoniaMedlem sedan maj 2003924 inlägg
#2

Ja det går.
Man kan göra på olika sätt.
Antingen så går det att forma.
eller att en viss färg blir transparent.
Hur exakt och kod kan jag inte direkt i huvudet.

joxxeMedlem sedan okt. 200357 inlägg
#3

Okej! tips på hur ja tex får en färg att bli genomskillnig? typ nån guide eller så...vorre kanonbra.

PsyDoniaMedlem sedan maj 2003924 inlägg
#4

Vet inte om denna fungerar som du vill.
Det är en class module som jag hittade.
Hur som helst annars om denna inte funkar leta info om Bitblt

Option Explicit
'Device context functions

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
    'Gdi object functions

Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    'Bitmap functions

Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

Private Declare Function CreateBitmapIndirect Lib "gdi32" (ByVal lpbm 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 Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    'Window functions

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    'Color functions

Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
    'Text functions

Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
    'Rendering functions

Private 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 nSrcHeight As Long, ByVal dwRop As Long) As Long

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
    'The needed variables
    Private MainDC As Long
    Private hMainPrevBitmap As Long
    Public hMainBitmap As Long
    Private MainCreated As Boolean
    Private MaskDC As Long
    Private hMaskPrevBitmap As Long
    Public hMaskBitmap As Long
    Private MaskCreated As Boolean
    Public Width As Long
    Public Height As Long

Private Enum BitBltConstants
    SRCCOPY = &HCC0020'/* dest = source */
    SRCPAINT = &HEE0086'/* dest = source OR dest*/
    SRCAND = &H8800C6'/* dest = source AND dest*/
    SRCINVERT = &H660046'/* dest = source XOR dest*/
    SRCERASE = &H440328'/* dest = source AND (NOT dest ) */
    NOTSRCCOPY = &H330008'/* dest = (NOT source)*/
    NOTSRCERASE = &H1100A6'/* dest = (NOT src) AND (NOT dest) */
    MERGECOPY = &HC000CA'/* dest = (source AND pattern) */
    MERGEPAINT = &HBB0226'/* dest = (NOT source) OR dest */
    PATCOPY = &HF00021'/* dest = pattern */
    PATPAINT = &HFB0A09'/* dest = DPSnoo */
    PATINVERT = &H5A0049'/* dest = pattern XOR dest*/
    DSTINVERT = &H550009'/* dest = (NOT dest)*/
    BLACKNESS = &H42'/* dest = BLACK */
    WHITENESS = &HFF0062'/* dest = WHITE */
End Enum

Private Sub FreeMainBitmap()

    If MainCreated Then 'Only delete our bitmap if we created it first

        SelectObject MainDC, hMainPrevBitmap
            DeleteObject hMainBitmap
            MainCreated = False
        End If
    End Sub

Private Sub FreeMaskBitmap()

    If MaskCreated Then 'Only delete our bitmap if we created it first

        SelectObject MaskDC, hMaskPrevBitmap
            DeleteObject hMaskBitmap
            MaskCreated = False
        End If
    End Sub

Private Sub NewBitmap(Width As Long, Height As Long, BitsPerPixel As Long)
    FreeMainBitmap
    
    hMainBitmap = CreateBitmap(Width, Height, 1, BitsPerPixel, ByVal 0&)
    hMainPrevBitmap = SelectObject(MainDC, hMainBitmap)
    MainCreated = True
End Sub

Private Sub CreateMaskBitmap(Width As Long, Height As Long)
    FreeMaskBitmap
    
    hMaskBitmap = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
    hMaskPrevBitmap = SelectObject(MaskDC, hMaskBitmap)
    MaskCreated = True
End Sub

Public Sub LoadHdc(hSrcDC As Long, X As Long, Y As Long, nWidth As Long, nHeight As Long, TransparentColor As Long)
    'Set Width and height to nWidth and nHei
    '     ght
    Width = nWidth
    Height = nHeight
    
    'Create bitmaps
    CreateMaskBitmap Width, Height 'Create a mask bitmap
    NewCompatibleBitmap hSrcDC, Width, Height 'Create a main bitmap
    
    'Make our mask
    Dim OrigColor As Long
    
    OrigColor = SetBkColor(hSrcDC, TransparentColor)
    BitBlt MaskDC, 0, 0, Width, Height, hSrcDC, X, Y, SRCCOPY 'Create our mask
    SetBkColor hSrcDC, OrigColor 'Restore the original color

    If TransparentColor = vbBlack Then
        BitBlt MainDC, 0, 0, Width, Height, hSrcDC, X, Y, SRCCOPY
    Else
        SetBkColor MainDC, vbWhite
        SetTextColor MainDC, vbBlack
        
        'Make the transparent part black so we c
        '     an use it in bitblt
        BitBlt MainDC, 0, 0, Width, Height, hSrcDC, X, Y, BLACKNESS
        BitBlt MainDC, 0, 0, Width, Height, hSrcDC, X, Y, SRCINVERT
        BitBlt MainDC, 0, 0, Width, Height, MaskDC, X, Y, SRCAND
        BitBlt MainDC, 0, 0, Width, Height, hSrcDC, X, Y, SRCINVERT
    End If
End Sub

Public Sub LoadHdcFromPicture(Picture As StdPicture, TransparentColor As Long)
    Dim OurhDC As Long
    Dim hPrevBmp As Long
    
    OurhDC = CreateCompatibleDC(GetDC(0))
    

    With Picture
        hPrevBmp = SelectObject(OurhDC, .Handle)
        LoadHdc OurhDC, 0, 0, .Width, .Height, TransparentColor
    End With
    

    SelectObject OurhDC, hPrevBmp
        DeleteDC OurhDC
    End Sub

Private Sub NewCompatibleBitmap(CompatibleDC As Long, Width As Long, Height As Long)
    FreeMainBitmap
    hMainBitmap = CreateCompatibleBitmap(CompatibleDC, Width, Height)
    hMainPrevBitmap = SelectObject(MainDC, hMainBitmap)
    MainCreated = True
End Sub

Private Sub Class_Initialize()
    MainDC = CreateCompatibleDC(GetDC(0))
    MaskDC = CreateCompatibleDC(GetDC(0))
End Sub

Private Sub Class_Terminate()
    FreeMainBitmap
    FreeMaskBitmap
    
    DeleteDC MainDC
    DeleteDC MaskDC
End Sub

Sub StretchRender(hDestDC As Long, X As Long, Y As Long, nWidth As Long, nHeight As Long, _
    XSrc As Long, YSrc As Long, Optional ByVal SrcWidth As Long, Optional ByVal SrcHeight As Long, Optional Transparent As Boolean = True)
    
    If SrcWidth = 0 Then SrcWidth = Width
    If SrcHeight = 0 Then SrcHeight = Height
    

    If Transparent Then
        Dim SaveBkColor As Long
        Dim SaveTextColor As Long
        
        SaveTextColor = SetTextColor(hDestDC, vbBlack)
        SaveBkColor = SetBkColor(hDestDC, vbWhite) '//All the white in our bitmap has to be white
        
        StretchBlt hDestDC, X, Y, nWidth, nHeight, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCAND
        StretchBlt hDestDC, X, Y, nWidth, nHeight, MainDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT
        
        SetBkColor hDestDC, SaveBkColor
        SetTextColor hDestDC, SaveTextColor
    Else
        StretchBlt hDestDC, X, Y, nWidth, nHeight, MainDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCCOPY
    End If
End Sub

Sub Render(hDestDC As Long, X As Long, Y As Long, nWidth As Long, nHeight As Long, _
    XSrc As Long, YSrc As Long, Optional Transparent As Boolean = True)

    If Transparent Then
        Dim SaveBkColor As Long
        Dim SaveTextColor As Long
        
        SaveTextColor = SetTextColor(hDestDC, vbBlack)
        SaveBkColor = SetBkColor(hDestDC, vbWhite) '//All the white in our bitmap has to be white
        
        BitBlt hDestDC, X, Y, nWidth, nHeight, MaskDC, XSrc, YSrc, SRCAND
        BitBlt hDestDC, X, Y, nWidth, nHeight, MainDC, XSrc, YSrc, SRCPAINT
        
        SetBkColor hDestDC, SaveBkColor
        SetTextColor hDestDC, SaveTextColor
    Else
        BitBlt hDestDC, X, Y, nWidth, nHeight, MainDC, XSrc, YSrc, SRCCOPY
    End If
End Sub

Sub EraseDraw(hDestDC As Long, X As Long, Y As Long, nWidth As Long, nHeight As Long, BackGroundDC As Long, Optional PixelPerfectCollisionDetection As Boolean = False)

    If PixelPerfectCollisionDetection Then
        Dim SaveBkColor As Long
        Dim SaveTextColor As Long
        
        SaveTextColor = SetTextColor(hDestDC, vbBlack)
        SaveBkColor = SetBkColor(hDestDC, vbWhite) '//All the white in our bitmap has to be white
        
        BitBlt hDestDC, X, Y, nWidth, nHeight, BackGroundDC, X, Y, SRCINVERT
        BitBlt hDestDC, X, Y, nWidth, nHeight, MaskDC, 0, 0, SRCAND
        BitBlt hDestDC, X, Y, nWidth, nHeight, BackGroundDC, X, Y, SRCINVERT
        
        SetBkColor hDestDC, SaveBkColor
        SetTextColor hDestDC, SaveTextColor
    Else
        BitBlt hDestDC, X, Y, nWidth, nHeight, BackGroundDC, X, Y, vbSrcCopy
    End If
End Sub
140 ms totalt · 3 externa anrop · v20260731065814-full.30151723
0 ms — hämta forumlista (cache)
0 ms — hämta statistik (cache)
138 ms — hämta tråd, inlägg och bilagor (db)