Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Transparent bitmap updated

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    Transparent bitmap updated

    This is an old example from the archive that I posted in 1999 http://www.powerbasic.com/support/fo...-7-000171.html

    Here is and updated version to work with PB/WIN 8+

    Code:
    '***************************************************************************
'
'   PROGRAM: transblt.bas
'   This piece of code is an adaptation of the MSN transblt.c example.
'
'   Tanslated to PowerBASIC on 02-14-1999 by:
'   Patrice TERRIER
'   [email protected]
'   [url="http://www.zapsolution.com"]www.zapsolution.com[/url] 
'
'   PURPOSE: transblt template for Windows applications
'
'***************************************************************************

#COMPILE EXE

#INCLUDE "WIN32API.INC"

%IDM_MASK1 = 100
%IDM_MASK2 = 101
%IDM_MASK3 = 102
%IDM_BLACK = 200
%IDM_RED   = 201
%IDM_DRED  = 202
%IDM_GREEN = 203
%IDM_CYAN  = 204

GLOBAL hInst&, bTransMaskBuilt%
GLOBAL hbmHouse&, hbmFade&, hbmDefault&, hbmBinoculars&
GLOBAL hbmTransMask&, hdcMem&, hdcMem2&
GLOBAL wMaskType&, wTransColor&, rgbWhite&, rgbBlack&, rgbTransparent&
GLOBAL HouseColor&()

FUNCTION MyMenu& ()

    hMenu& = CreateMenu

        sMenu& = CreatePopUpMenu
        CALL AppendMenu(hMenu&, %MF_POPUP, sMenu&, "&Samples")
        CALL AppendMenu(sMenu&, %MF_STRING, %IDM_MASK1, "&True Mask")
        CALL AppendMenu(sMenu&, %MF_STRING, %IDM_MASK2, "&Color Trans/True")
        CALL AppendMenu(sMenu&, %MF_STRING, %IDM_MASK3, "&Color Trans/Black-Source")

        sMenu& = CreatePopUpMenu
        CALL AppendMenu(hMenu&, %MF_POPUP, sMenu&, "&Colors")
            CALL AppendMenu(sMenu&, %MF_STRING, %IDM_BLACK, "&Black")
            CALL AppendMenu(sMenu&, %MF_STRING, %IDM_RED, "&Red")
            CALL AppendMenu(sMenu&, %MF_STRING, %IDM_DRED, "&Dark Red")
            CALL AppendMenu(sMenu&, %MF_STRING, %IDM_GREEN, "&Green")
            CALL AppendMenu(sMenu&, %MF_STRING, %IDM_CYAN, "&Cyan")
    FUNCTION = hMenu&
END FUNCTION

FUNCTION WndProc&(BYVAL hWnd&, BYVAL Msg&, BYVAL wParam&, BYVAL lParam&)

    DIM poly(2) AS POINTAPI

    SELECT CASE Msg&
        case %WM_CREATE

            hdcScreen& = GetDC(%NULL)

            hbmHouse& = CreateCompatibleBitmap(hdcScreen&, 50, 50)
            hbmFade& = CreateCompatibleBitmap(hdcScreen&, 100, 100)
            hbmBinoculars& = CreateBitmap(50, 50, 1, 1, BYVAL %NULL)
            hbmTransMask& = CreateBitmap(50, 50, 1, 1, BYVAL %NULL)
            hdcMem& = CreateCompatibleDC(hdcScreen&)
            hdcMem2& = CreateCompatibleDC(hdcScreen&)

            CALL ReleaseDC(%NULL, hdcScreen&)

          ' Draw the house bitmap.  This will be the basic source bitmap.

            CALL SelectObject(hdcMem&, GetStockObject(%NULL_PEN))
            hbmDefault& = SelectObject(hdcMem&, hbmHouse&)

          ' sky.
            hbr& = CreateSolidBrush(RGB(0, 255, 255))
            hbr& = SelectObject(hdcMem&, hbr&)
            CALL PatBlt(hdcMem&, 0, 0, 50, 30, %PATCOPY)
            hbr& = SelectObject(hdcMem&, hbr&)
            CALL DeleteObject(hbr&)

          ' horizon.
            CALL PatBlt(hdcMem&, 0, 30, 50, 31, %BLACKNESS)

          ' lawn
            hbr& = CreateSolidBrush(RGB(0, 255, 0))
            hbr& = SelectObject(hdcMem, hbr&)
            CALL PatBlt(hdcMem, 0, 31, 50, 20, %PATCOPY)
            hbr& = SelectObject(hdcMem, hbr&)
            CALL DeleteObject(hbr&)

          ' house body
            hbr& = CreateSolidBrush(RGB(255, 0, 0))
            hbr& = SelectObject(hdcMem, hbr&)
            CALL PatBlt(hdcMem, 5, 20, 40, 20, %PATCOPY)
            hbr& = SelectObject(hdcMem&, hbr&)
            CALL DeleteObject(hbr&)

          ' house roof
            hbr& = CreateSolidBrush(RGB(128, 0, 0))
            hbr& = SelectObject(hdcMem&, hbr&)
            poly(0).x = 2
            poly(0).y = 20
            poly(1).x = 47
            poly(1).y = 20
            poly(2).x = 25
            poly(2).y = 5
            CALL Polygon(hdcMem&, poly(0), 3)
            hbr& = SelectObject(hdcMem&, hbr&)
            CALL DeleteObject(hbr&)

          ' windows
            hbr& = SelectObject(hdcMem&, GetStockObject(%BLACK_BRUSH))
            CALL PatBlt(hdcMem&, 10, 22, 12, 13, %BLACKNESS)
            CALL PatBlt(hdcMem&, 28, 22, 12, 13, %BLACKNESS)


          ' build the fade background bitmap.
            CALL SelectObject(hdcMem&, hbmFade&)
            FOR I% = 56 TO 256 STEP 2
                IF I% > 255 THEN EXIT FOR
                hbr& = CreateSolidBrush(RGB(I%, 0, I%))
                hbr& = SelectObject(hdcMem&, hbr&)
                CALL PatBlt(hdcMem&, 0, (I% - 56)/2, 100, 3, %PATCOPY)
                hbr& = SelectObject(hdcMem&, hbr&)
                CALL DeleteObject(hbr&)
            NEXT

          ' build the binoculars true mask.
            CALL SelectObject(hdcMem&, hbmBinoculars&)
            CALL PatBlt(hdcMem&, 0, 0, 50, 50, %WHITENESS)
            CALL SelectObject(hdcMem&, GetStockObject(%BLACK_BRUSH))
            CALL Ellipse(hdcMem&, 7, 7, 24, 43)
            CALL Ellipse(hdcMem&, 26, 7, 43, 43)

            CALL SelectObject(hdcMem&, hbmDefault&)
            FUNCTION = 0: EXIT FUNCTION

        case %WM_INITMENU
            CALL CheckMenuItem(wParam&, wMaskType&, %MF_CHECKED)
            CALL CheckMenuItem(wParam&, wTransColor&, %MF_CHECKED)
            FUNCTION = 0: EXIT FUNCTION

        case %WM_COMMAND ' message: command from application menu
            SELECT CASE wParam&
            case %IDM_MASK1, %IDM_MASK2, %IDM_MASK3
                 IF wParam& <> wMaskType& THEN
                    CALL CheckMenuItem(GetMenu(hWnd&), wMaskType&, %MF_UNCHECKED)
                    wMaskType& = wParam&
                    CALL CheckMenuItem(GetMenu(hWnd&), wMaskType&, %MF_CHECKED)
                    CALL InvalidateRect(hWnd&, BYVAL %NULL, %TRUE)
                 END IF
                 FUNCTION = 0: EXIT FUNCTION
            case %IDM_BLACK, %IDM_RED, %IDM_DRED, %IDM_GREEN, %IDM_CYAN
                 IF wParam& <> wTransColor& THEN
                    CALL CheckMenuItem(GetMenu(hWnd&), wTransColor&, %MF_UNCHECKED)
                    wTransColor& = wParam&
                    CALL CheckMenuItem(GetMenu(hWnd&), wTransColor&, %MF_UNCHECKED)

                    rgbTransparent& = HouseColor&(wTransColor& - %IDM_BLACK)

                    bTransMaskBuilt% = %FALSE
                    CALL InvalidateRect(hWnd&, BYVAL %NULL, %TRUE)
                 END IF
                 FUNCTION = 0: EXIT FUNCTION
            END SELECT
        case %WM_PAINT
            CALL PaintIt(hWnd&)
            FUNCTION = 0: EXIT FUNCTION

        case %WM_DESTROY
            CALL DeleteObject(hbmHouse&)
            CALL DeleteObject(hbmFade&)
            CALL DeleteObject(hbmBinoculars&)
            CALL DeleteObject(hbmTransMask&)
            CALL DeleteDC(hdcMem&)
            CALL DeleteDC(hdcMem2&)

            CALL PostQuitMessage(0)
            FUNCTION = 0: EXIT FUNCTION
        END SELECT

    FUNCTION = DefWindowProc(hWnd&, Msg&, wParam&, lParam&)
END FUNCTION

FUNCTION WinMain& (BYVAL hInstance&, BYVAL hPrevInstance&, BYVAL lpCmdLine AS ASCIIZ PTR, _
                   BYVAL nCmdShow&)

    LOCAL Msg AS tagMsg
    LOCAL wc AS WndClassEx

    LOCAL szClassName AS ASCIIZ * 80
    LOCAL szMenuName AS ASCIIZ * 80

    hInst& = hInstance&
    bTransMaskBuilt% = %FALSE
    wMaskType& = %IDM_MASK1                   ' mask being demoed.
    wTransColor& = %IDM_BLACK                 ' transparent color
    rgbWhite& = RGB(255,255,255)
    rgbBlack& = RGB(0,0,0)

    DIM HouseColor&(4)
    HouseColor&(0) = RGB(0,0,0)
    HouseColor&(1) = RGB(255,0,0)
    HouseColor&(2) = RGB(128,0,0)
    HouseColor&(3) = RGB(0,255,0)
    HouseColor&(4) = RGB(0,255,255)
    rgbTransparent& = HouseColor&(wTransColor& - %IDM_BLACK)

    szClassName = "transbltWClass"

    wc.cbSize        = SIZEOF(wc)
    wc.style         = %CS_HREDRAW OR %CS_VREDRAW ' %NULL                    ' Class style(s).
    wc.lpfnWndProc   = CODEPTR(WndProc)
    wc.cbClsExtra    = 0                    ' No per-class extra data.
    wc.cbWndExtra    = 0                    ' No per-window extra data.
    wc.hInstance     = hInst&               ' Application that owns the class.
    wc.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
    wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
    wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
    wc.lpszMenuName  = %NULL
    wc.lpszClassName = VARPTR (szClassName) ' Name used in call to CreateWindow.
    wc.hIconSm       = LoadIcon(hInst&, BYVAL %IDI_APPLICATION)
    CALL RegisterClassEx(wc)

    hMenu& = MyMenu'LoadMenu(hInst&, "MAINMENU")

    hWnd& = CreateWindow(szClassName, _      ' See RegisterClass() call.
           "transblt Sample Application", _  ' Text for window title bar.
            %WS_OVERLAPPEDWINDOW, _          ' Window style.
            %CW_USEDEFAULT, _                ' Default horizontal position.
            %CW_USEDEFAULT, _                ' Default vertical position.
            410, _                ' Default width.
            320, _                ' Default height.
            %NULL, _                         ' Overlapped windows have no parent.
            hMenu&, _                        ' Use the window class menu.
            hInst&, _                        ' This instance owns this window.
            BYVAL %NULL)                     ' Pointer not needed.

    IF hWnd& THEN
       CALL ShowWindow(hWnd&, nCmdShow&)
       CALL UpdateWindow(hWnd&)

       WHILE GetMessage(Msg, %NULL, 0, 0)
           TranslateMessage Msg
           DispatchMessage Msg
       WEND

       FUNCTION = msg.wParam
    ELSE
       FUNCTION = %FALSE
    END IF
END FUNCTION

SUB PaintIt(hWnd&)

    LOCAl ps AS PAINTSTRUCT

    x% = 320: y% = 20

    hdcScreen& = BeginPaint(hWnd&, ps)

    CALL SelectObject(hdcMem&, hbmFade&)
    CALL BitBlt(hdcScreen&, 300, 0, 100, 100, hdcMem&, 0, 0, %SRCCOPY)

    CALL SetBkColor(hdcScreen&, rgbWhite&)
    CALL SetTextColor(hdcScreen&, rgbBlack&)

    SELECT CASE wMaskType&
    case %IDM_MASK1
         CALL SelectObject(hdcMem&, hbmHouse&)
         CALL SelectObject(hdcMem2&, hbmBinoculars&)

         CALL ShowStatus(hdcScreen&, hdcMem&, hdcMem2&)

         CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem&, 0, 0, %SRCINVERT)
         CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem2&, 0, 0, %SRCAND)
         CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem&, 0, 0, %SRCINVERT)

    case %IDM_MASK2
    case %IDM_MASK3
         CALL SelectObject(hdcMem&, hbmHouse&)
         CALL SelectObject(hdcMem2&, hbmTransMask&)

       ' if the device supports transparency, let it do the work.
         IF (GetDeviceCaps(hdcScreen&, %CAPS1) AND %C1_TRANSPARENT) THEN
            oldMode& = SetBkMode(hdcScreen&, %NEWTRANSPARENT)
            rgbOld& = SetBkColor(hdcScreen&, rgbTransparent&)
            CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem&, 0, 0, %SRCCOPY)
            CALL SetBkColor(hdcScreen&, rgbOld&)
            CALL SetBkMode(hdcScreen&, oldMode&)
         END IF

       ' build mask based on transparent color.
         IF NOT bTransMaskBuilt% THEN
            bTransMaskBuilt% = %TRUE
            CALL SetBkColor(hdcMem&, rgbTransparent&)
            CALL BitBlt(hdcMem2&, 0, 0, 50, 50, hdcMem&, 0, 0, %SRCCOPY)
         END IF

         CALL ShowStatus(hdcScreen&, hdcMem&, hdcMem2&)

       ' using a true mask.
         IF wMaskType& = %IDM_MASK2 THEN
            CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem&, 0, 0, %SRCINVERT)
            CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem2&, 0, 0, %SRCAND)
            CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem&, 0, 0, %SRCINVERT)

         ELSE ' using the black-source method.

          ' if transparent color is black, the house bitmap is
          ' ready for use.  Otherwise, put black in the right
          ' place for masking.
            IF wTransColor& <> %IDM_BLACK THEN
               CALL SetBkColor(hdcMem&, rgbBlack&)
               CALL SetTextColor(hdcMem&, rgbWhite&)
               CALL BitBlt(hdcMem&, 0, 0, 50, 50, hdcMem2&, 0, 0, %SRCAND)

             ' show the modified bitmap
               CALL BitBlt(hdcScreen&, 120, 150, 50, 50, hdcMem&, 0, 0, %SRCCOPY)
               CALL TextOut(hdcScreen&, 100, 220, "(Modified Source)", 17)
            END IF

            CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem2&, 0, 0, %SRCAND)
            CALL BitBlt(hdcScreen&, x%, y%, 50, 50, hdcMem&, 0, 0, %SRCPAINT)

          ' undo work on house bitmap.
            IF wTransColor& <> %IDM_BLACK THEN
               CALL SetBkColor(hdcMem&, rgbTransparent&)
               CALL SetTextColor(hdcMem&, rgbBlack&)
               CALL BitBlt(hdcMem&, 0, 0, 50, 50, hdcMem2&, 0, 0, %SRCPAINT)
            END IF
         END IF
    END SELECT

    CALL SelectObject(hdcMem&, hbmDefault&)
    CALL SelectObject(hdcMem2&, hbmDefault&)
    CALL EndPaint(hWnd&, ps)

END SUB

SUB ShowStatus(hdcDst&, hdcSrc&, hdcMask&)

    hbm& = SelectObject(hdcSrc&, hbmFade&)
    CALL BitBlt(hdcDst&, 0, 0, 100, 100, hdcSrc&, 0, 0, %SRCCOPY)
    CALL SelectObject(hdcSrc&, hbm&)
    CALL TextOut(hdcDst&, 0, 110, "Destination", 11)

    CALL BitBlt(hdcDst&, 120, 20, 50, 50, hdcSrc&, 0, 0, %SRCCOPY)
    CALL TextOut(hdcDst&, 100, 110, "+ Source", 8)

    IF hdcMask& THEN
       CALL BitBlt(hdcDst&, 220, 20, 50, 50, hdcMask&, 0, 0, %SRCCOPY)
       CALL TextOut(hdcDst&, 200, 110, "+ Mask", 6)
    END IF
    CALL TextOut(hdcDst&, 300, 110, "= Transparency", 14)

END SUB
    ------------------
    Patrice Terrier
    mailto[email protected][email protected]</A>
    www.zapsolution.com
    Addons: WinLIFT (Skin Engine), GDImage (Graphic control), Artwork (logo creation), GDI+ Helper (GDIPLUS)
    Patrice Terrier
    www.zapsolution.com
    www.objreader.com
    Addons: GDImage.DLL 32/64-bit (Graphic library), WinLIFT.DLL 32/64-bit (Skin Engine).
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree