GDI: TransBlt - Demonstrates Bitmaps with Transparency

[José Roca]

 
This is an adaptation of transblt.c (C) Copyright Microsoft Corp. 1993.
http://support.microsoft.com/kb/q97365/
TRANSBLT performs transparency and masking effects on bitmaps.

Code Select Expand


' ========================================================================================
' TRANSBLT.BAS - Demonstrates Bitmaps with Transparency
' This is an adaptation of transblt.c (C) Copyright Microsoft Corp. 1993.
' http://support.microsoft.com/kb/q97365/
' TRANSBLT performs transparency and masking effects on bitmaps.
' ========================================================================================

' CSED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#RESOURCE RES, "CW_GDI_TransBlt.res"

%IDM_ABOUT = 100

%IDM_MASK1 = 200
%IDM_MASK2 = 201
%IDM_MASK3 = 202

%IDM_BLACK = 300
%IDM_RED   = 301
%IDM_DRED  = 302
%IDM_GREEN = 303
%IDM_CYAN  = 304

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "TransBlt Sample Application", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Change the background color
   pWindow.Brush = %COLOR_WINDOW + 1
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Load the menu
   LOCAL hMenu AS DWORD
   hMenu = LoadMenu(hInstance, "transbltMenu")
   SetMenu pWindow.hwnd, hMenu

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC rgbWhite        AS DWORD
   STATIC rgbBlack        AS DWORD
   STATIC rgbTransparent  AS DWORD
   STATIC hbmHouse        AS DWORD
   STATIC hbmFade         AS DWORD
   STATIC hbmDefault      AS DWORD
   STATIC hbmBinoculars   AS DWORD
   STATIC hbmTransMask    AS DWORD
   STATIC hdcMem          AS DWORD
   STATIC hdcMem2         AS DWORD
   STATIC bTransMaskBuilt AS LONG
   STATIC dwMaskType      AS DWORD           ' mask being demoed
   STATIC dwTransColor    AS DWORD           ' transparent color
   DIM    HouseColor(4)   AS STATIC DWORD
   LOCAL  hdcScreen       AS DWORD
   LOCAL  hbr             AS DWORD
   LOCAL  i               AS LONG
   DIM    poly(2)         AS POINTAPI
   LOCAL  ps              AS PAINTSTRUCT
   LOCAL  x               AS DWORD
   LOCAL  y               AS DWORD
   LOCAL  oldMode         AS DWORD
   LOCAL  rgbOld          AS DWORD
   STATIC hInstance       AS DWORD
   LOCAL  lpc             AS CREATESTRUCT PTR

   SELECT CASE wMsg

      CASE %WM_CREATE

         lpc = lParam
         hInstance = @lpc.hInstance
         dwMaskType = %IDM_MASK1     ' mask being demoed
         dwTransColor = %IDM_BLACK    ' transparent color
         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)
         rgbWhite = RGB(255, 255, 255)
         rgbBlack = RGB(0, 0, 0)
         rgbTransparent = HouseColor(dwTransColor - %IDM_BLACK)

         ' Build the bitmaps
         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)
         ReleaseDC %NULL, hdcScreen

         ' Draw the house bitmap.  This will be the basic source bitmap.
         SelectObject(hdcMem, GetStockObject(%NULL_PEN))
         hbmDefault = SelectObject(hdcMem, hbmHouse)

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

         ' horizon.
         PatBlt hdcMem, 0, 30, 50, 31, %BLACKNESS

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

         ' house body
         hbr = CreateSolidBrush(RGB(255, 0, 0))
         hbr = SelectObject(hdcMem, hbr)
         PatBlt hdcMem, 5, 20, 40, 20, %PATCOPY
         hbr = SelectObject(hdcMem, hbr)
         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
         Polygon hdcMem, poly(0), 3
         hbr = SelectObject(hdcMem, hbr)
         DeleteObject hbr

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

         ' build the fade background bitmap.
         SelectObject hdcMem, hbmFade
         FOR i = 56 TO 255 STEP 2
            hbr = CreateSolidBrush(RGB(i, 0, i))
            hbr = SelectObject(hdcMem, hbr)
            PatBlt hdcMem, 0, (i - 56)/2, 100, 3, %PATCOPY
            hbr = SelectObject(hdcMem, hbr)
            DeleteObject hbr
         NEXT

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

         SelectObject hdcMem, hbmDefault

         EXIT FUNCTION

      CASE %WM_INITMENU
         CheckMenuItem wParam, dwMaskType, %MF_CHECKED
         CheckMenuItem wParam, dwTransColor, %MF_CHECKED
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)

            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

            CASE %IDM_ABOUT
               DialogBox hInstance, "AboutBox", hWnd, CODEPTR(AboutDlgProc)
               EXIT FUNCTION

            CASE %IDM_MASK1, %IDM_MASK2, %IDM_MASK3
               IF LO(WORD, wParam) <> dwMaskType THEN
                  CheckMenuItem GetMenu(hWnd), dwMaskType, %MF_UNCHECKED
                  dwMaskType = LO(WORD, wParam)
                  CheckMenuItem GetMenu(hWnd), dwMaskType, %MF_CHECKED
                  InvalidateRect hWnd, BYVAL %NULL, %TRUE
                  EXIT FUNCTION
               END IF

            CASE %IDM_BLACK, %IDM_RED, %IDM_DRED, %IDM_GREEN, %IDM_CYAN
               IF LO(WORD, wParam) <> dwTransColor THEN
                  CheckMenuItem GetMenu(hWnd), dwTransColor, %MF_UNCHECKED
                  dwTransColor = LO(WORD, wParam)
                  CheckMenuItem GetMenu(hWnd), dwTransColor, %MF_UNCHECKED
                  rgbTransparent = HouseColor(dwTransColor - %IDM_BLACK)
                  bTransMaskBuilt = %FALSE
                  InvalidateRect hWnd, BYVAL %NULL, %TRUE
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_PAINT
         hdcScreen = BeginPaint(hWnd, ps)
         ' fill in destination space
         SelectObject hdcMem, hbmFade
         BitBlt hdcScreen, 300, 0, 100, 100, hdcMem, 0, 0, %SRCCOPY
         SetBkColor hdcScreen, rgbWhite
         SetTextColor hdcScreen, rgbBlack
         x = 320 : y = 20
         SELECT CASE dwMaskType
            CASE %IDM_MASK1
               SelectObject hdcMem, hbmHouse
               SelectObject hdcMem2, hbmBinoculars
               ShowStatus hdcScreen, hdcMem, hdcMem2, hbmFade
               BitBlt hdcScreen, x, y, 50, 50, hdcMem, 0, 0, %SRCINVERT
               BitBlt hdcScreen, x, y, 50, 50, hdcMem2, 0, 0, %SRCAND
               BitBlt hdcScreen, x, y, 50, 50, hdcMem, 0, 0, %SRCINVERT
            CASE %IDM_MASK2, %IDM_MASK3
               SelectObject hdcMem, hbmHouse
               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)
                  BitBlt hdcScreen, x, y, 50, 50, hdcMem, 0, 0, %SRCCOPY
                  SetBkColor hdcScreen, rgbOld
                  SetBkMode hdcScreen, oldMode
               ELSE
                  ' build mask based on transparent color.
                  IF ISFALSE bTransMaskBuilt THEN
                     bTransMaskBuilt = %TRUE
                     SetBkColor hdcMem, rgbTransparent
                     BitBlt hdcMem2, 0, 0, 50, 50, hdcMem, 0, 0, %SRCCOPY
                  END IF
                  ShowStatus hdcScreen, hdcMem, hdcMem2, hbmFade
                  '/ using a true mask.
                  IF dwMaskType = %IDM_MASK2 THEN
                     BitBlt hdcScreen, x, y, 50, 50, hdcMem, 0, 0, %SRCINVERT
                     BitBlt hdcScreen, x, y, 50, 50, hdcMem2, 0, 0, %SRCAND
                     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 dwTransColor <> %IDM_BLACK THEN
                        SetBkColor hdcMem, rgbBlack
                        SetTextColor hdcMem, rgbWhite
                        BitBlt hdcMem, 0, 0, 50, 50, hdcMem2, 0, 0, %SRCAND
                        ' show the modified bitmap
                        BitBlt hdcScreen, 120, 150, 50, 50, hdcMem, 0, 0, %SRCCOPY
                        TextOut hdcScreen, 100, 220, "(Modified Source)", 17
                     END IF
                     BitBlt hdcScreen, x, y, 50, 50, hdcMem2, 0, 0, %SRCAND
                     BitBlt hdcScreen, x, y, 50, 50, hdcMem, 0, 0, %SRCPAINT
                     ' undo work on house bitmap.
                     IF dwTransColor <> %IDM_BLACK THEN
                        SetBkColor hdcMem, rgbTransparent
                        SetTextColor hdcMem, rgbBlack
                        BitBlt hdcMem, 0, 0, 50, 50, hdcMem2, 0, 0, %SRCPAINT
                     END IF
                  END IF
                  SelectObject hdcMem, hbmDefault
                  SelectObject hdcMem2, hbmDefault
                  EndPaint hWnd, ps
               END IF
         END SELECT
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteObject hbmHouse
         DeleteObject hbmFade
         DeleteObject hbmBinoculars
         DeleteObject hbmTransMask
         DeleteDC hdcMem
         DeleteDC hdcMem2
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
SUB ShowStatus (BYVAL hdcDst AS DWORD, BYVAL hdcSrc AS DWORD, BYVAL hdcMask AS DWORD, BYVAL hbmFade AS DWORD)

   LOCAL hbm AS DWORD

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

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

   IF hdcMask THEN
      BitBlt hdcDst, 220, 20, 50, 50, hdcMask, 0, 0, %SRCCOPY
      TextOut hdcDst, 200, 110, "+ Mask", 6
   END IF

   TextOut hdcDst, 300, 110, "= Transparency", 14

END SUB
' ========================================================================================

' ========================================================================================
FUNCTION AboutDlgProc (BYVAL hDlg AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE message

      CASE %WM_INITDIALOG
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDOK, %IDCANCEL
               EndDialog hDlg, 0
               FUNCTION = %TRUE
               EXIT FUNCTION
         END SELECT

   END SELECT

END FUNCTION
' ========================================================================================


CW_GDI_TRANSBLT.RC

Code Select Expand


#include "resource.h"

#define WS_CAPTION          0x00C00000L     /* WS_BORDER | WS_DLGFRAME  */
#define WS_SYSMENU          0x00080000L
#define WS_GROUP            0x00020000L
#define IDOK                1

#define IDM_ABOUT   100

#define IDM_MASK1   200
#define IDM_MASK2   201
#define IDM_MASK3   202

#define IDM_BLACK   300
#define IDM_RED     301
#define IDM_DRED    302
#define IDM_GREEN   303
#define IDM_CYAN    304

transbltMenu MENU
BEGIN
    POPUP        "&Samples"
    BEGIN
        MENUITEM "&True Mask",                IDM_MASK1
        MENUITEM "&Color Trans/True",         IDM_MASK2
        MENUITEM "&Color Trans/Black-Source", IDM_MASK3
    END
    POPUP        "&Colors"
    BEGIN
        MENUITEM "&Black",   IDM_BLACK
        MENUITEM "&Red",     IDM_RED
        MENUITEM "&Dark Red",IDM_DRED
        MENUITEM "&Green",   IDM_GREEN
        MENUITEM "&Cyan",    IDM_CYAN
    END
    POPUP        "&Help"
    BEGIN
        MENUITEM "&About transblt...", IDM_ABOUT
    END
END

AboutBox DIALOG 22, 17, 144, 75
STYLE DS_MODALFRAME | WS_CAPTION | WS_SYSMENU
CAPTION "About transblt"
BEGIN
    CTEXT "Microsoft Windows"     -1,       0,  5, 144,  8
    CTEXT "transblt Application"  -1,       0, 14, 144,  8
    CTEXT "Version 3.0"           -1,       0, 34, 144,  8
    DEFPUSHBUTTON "OK"          IDOK,      53, 59,  32, 14,      WS_GROUP
END