GDI: CreateDIBSection Function

[José Roca]

 
The following program demonstrates the use of the CreateDIBSection function and fast bitmap manipulation via DIBs.

Code Select Expand


' ########################################################################################
' Small demo of fast bitmap manipulation via DIBs
' Public Domain by Borje Hagten, May 2002
' http://www.powerbasic.com/support/pbforums/showthread.php?t=23384
' Adapted from DDT to SDK by José Roca, April 2009
' Maybe not the best way to do it, but good enough for my needs.
' Using 32-bit DIB makes routines easier to code and understand, IMO.
' Special credits to Semen Matusovski for many nice "How to" samples
'
' Included routines
' ImgColorBlend:   Creates a chess-like pattern by replacing every other
'                  color1 pixel with color2.
' ImgColorReplace: Replaces color1 with color2. FloodFill is nice, but misses
'                  enclosed areas inside letters, etc. This one fixes that.
' ImgFlip...       Flips the image in various directions. StretchBlt can also
'                  do this, but is actually slower...
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"
#INCLUDE "EditCtrl.inc"

%IDC_TEXT = 200

GLOBAL hViewer AS DWORD
GLOBAL hMemDC AS DWORD
GLOBAL hBitmap AS DWORD

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

   LOCAL hWndMain          AS DWORD
   LOCAL wcex              AS WNDCLASSEX
   LOCAL szClassName       AS ASCIIZ * 80
   LOCAL szViewerClassName AS ASCIIZ * 80
   LOCAL rc                AS RECT
   LOCAL szCaption         AS ASCIIZ * 255
   LOCAL nLeft             AS LONG
   LOCAL nTop              AS LONG
   LOCAL nWidth            AS LONG
   LOCAL nHeight           AS LONG

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Register the window class
   szViewerClassName  = "BitMapViewer"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = 0
   wcex.lpfnWndProc   = CODEPTR(ViewerProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = 0
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szViewerClassName)
   wcex.hIcon         = 0
   wcex.hIconSm       = 0
   RegisterClassEx wcex

   ' Window caption
   szCaption = "DIB Manipulation Demo"

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and size of the window
   nWidth  = 600
   nHeight = 458
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_SYSMENU, _                    ' window styles
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x size
                             nHeight, _                        ' initial y size
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Main Window callback
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hDC     AS DWORD
   LOCAL bm      AS BITMAP
   LOCAL bmi     AS BITMAPINFO
   LOCAL rc      AS RECT
   LOCAL strText AS STRING
   LOCAL hCtl    AS DWORD
   LOCAL hFont   AS DWORD

   SELECT CASE wMsg

      CASE %WM_CREATE

         ' // Create the controls
         hFont = GetStockObject(%ANSI_VAR_FONT)
         hViewer = CreateWindowEx(%WS_EX_CLIENTEDGE, "BitMapViewer", "", _
                     %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
                     0, 0, 426, 426, hwnd, 10, GetModuleHandle(""), BYVAL %NULL)
         hCtl = CreateWindowEx(0, "Static", "Text:", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    438, 241, 150, 16, hwnd,  -1, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE, "Edit", "PowerBASIC", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_CENTER OR %ES_AUTOHSCROLL, _
                    437, 257, 148, 19, hwnd, %IDC_TEXT, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "Blend color", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    437, 289, 75, 23, hwnd, 20, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "Replace color", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    512, 289, 75, 23, hwnd, 21, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "Flip updown", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    437, 315, 75, 23, hwnd, 22, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "Flip sideways", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    512, 315, 75, 23, hwnd, 23, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "Flip 180", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    437, 341, 75, 23, hwnd, 24, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "Original", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    512, 341, 75, 23, hwnd, 25, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
         hCtl = CreateWindowEx(0, "Button", "E&xit", _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
                    437, 397, 150, 22, hwnd, %IDCANCEL, GetModuleHandle(""), BYVAL %NULL)
         IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

         GetClientRect hViewer, rc
         hDC = GetDc(hViewer)
         bmi.bmiHeader.biSize        = SIZEOF(bmi.bmiHeader)
         bmi.bmiHeader.biWidth       = rc.nRight
         bmi.bmiHeader.biHeight      = -rc.nBottom   ' Top-down DIB - origin in upper left corner
         bmi.bmiHeader.biPlanes      = 1
         bmi.bmiHeader.biBitCount    = 32
         bmi.bmiHeader.biCompression = %BI_RGB
         hMemDC = CreateCompatibleDC(hDC)
         hBitmap = CreateDIBSection(hMemDC, bmi, %DIB_RGB_COLORS, 0, 0, 0)
         GlobalLock hBitmap
         SelectObject hMemDC, hBitmap
         SetBkMode hMemDC, %TRANSPARENT
         ReleaseDc hViewer, hDC
         strText = Edit_GetText(GetDlgItem(hwnd, %IDC_TEXT))
         ImgDrawText strText
         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 20 : ImgColorBlend &HFFFF00&, &HC0C0C0&
            CASE 21 : ImgColorReplace &H008080&, &HFF0000&
            CASE 22 : ImgFlipBottomTop
            CASE 23 : ImgFlipLeftRight
            CASE 24 : ImgFlip180
            CASE 25 : strText = Edit_GetText(GetDlgItem(hwnd, %IDC_TEXT))
                      ImgDrawText strText

            CASE %IDC_TEXT
               IF HI(WORD, wParam) = %EN_CHANGE THEN
                  strText = Edit_GetText(GetDlgItem(hwnd, %IDC_TEXT))
                  ImgDrawText strText
               END IF

         END SELECT

      CASE %WM_SYSCOMMAND
         ' Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hWnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_DESTROY
         IF hMemDC THEN DeleteDC hMemDC
         IF hBitmap THEN DeleteObject hBitmap
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Viewer window callback
' ========================================================================================
FUNCTION ViewerProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                     BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL rc AS RECT
   LOCAL ps AS PAINTSTRUCT

   SELECT CASE wMsg

      CASE %WM_ERASEBKGND
         FUNCTION = 1
         EXIT FUNCTION

      CASE %WM_PAINT
         GetClientRect hWnd, rc
         BeginPaint hWnd, ps
         BitBlt ps.hDC, 0, 0, rc.nRight, rc.nBottom, hMemDC, 0, 0, %SRCCOPY
         EndPaint hWnd, ps
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Draw text, here slightly rotated, using Times New Roman italic font
' ========================================================================================
SUB ImgDrawText (BYVAL strText AS STRING)

   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL hFont AS DWORD
   LOCAL hBrush AS DWORD
   LOCAL hBrushOld AS DWORD
   LOCAL Bm AS BITMAP
   LOCAL rc AS RECT
   LOCAL szl AS SIZEL
   LOCAL lf AS LOGFONT

   IF hMemDC = %NULL THEN EXIT SUB

   GetClientRect hViewer, rc

   lf.lfHeight         = 70
   lf.lfWeight         = %FW_BOLD
   lf.lfEscapement     = 170   ' 17 degree angle to match italic font
   lf.lfOrientation    = 170
   lf.lfItalic         = 1
   lf.lfCharSet        = %ANSI_CHARSET
   lf.lfOutPrecision   = %OUT_TT_PRECIS
   lf.lfClipPrecision  = %CLIP_DEFAULT_PRECIS
   lf.lfQuality        = %DEFAULT_QUALITY
   lf.lfPitchAndFamily = %FF_DONTCARE
   lf.lfFaceName       = "Times New Roman"

   hFont     = CreateFontIndirect(lf)
   hFont     = SelectObject(hMemDC, hFont)
   hBrush    = CreateSolidBrush(RGB(0, 128, 128))
   hBrushOld = SelectObject(hMemDC, hBrush)
   FillRect  hMemDC, rc, hBrush

   GetTextExtentPoint32 hMemDC, BYVAL STRPTR(strText), LEN(strText), szl
   x  = (rc.nRight  - szl.cx) / 2
   y  = (rc.nBottom - szl.cy) / 2 + TAN(17 * 4 * ATN(1) / 180) * szl.cx / 2 - 2
   ' y is not 100% correct, but good enough for this demo

   SetTextColor hMemDC, RGB(0,0,0)      ' Shadow
   TextOut hMemDC, x + 2, y + 2, BYVAL STRPTR(strText), LEN(strText)
   TextOut hMemDC, x + 3, y + 3, BYVAL STRPTR(strText), LEN(strText)

   SetTextColor hMemDC, RGB(128,128,0)  ' For smoother look
   TextOut hMemDC, x + 1, y + 1, BYVAL STRPTR(strText), LEN(strText)

   SetTextColor hMemDC, RGB(255,255,0)  ' Yellow text
   TextOut hMemDC, x, y, BYVAL STRPTR(strText), LEN(strText)

   DeleteObject SelectObject(hMemDC, hBrushOld)
   DeleteObject SelectObject(hMemDC, hFont)

   RedrawWindow hViewer, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW

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

' ========================================================================================
' Look for and replace every other pixel's color1 with color2 (chess pattern)
' ========================================================================================
SUB ImgColorBlend(BYVAL clr AS DWORD, BYVAL clr2 AS DWORD)

   LOCAL j AS LONG
   LOCAL dwp AS DWORD PTR
   LOCAL rowLen AS LONG
   LOCAL Bm AS BITMAP

   GetObject hBitmap, SIZEOF(bm), bm
   rowLen = bm.bmWidth * 4

   FOR j = 0 TO bm.bmHeight - 1                   ' Vertical loop
      dwp = bm.bmBits + j * rowLen                ' Start of row
      IF j MOD 2 THEN dwp = dwp + 4               ' One pixel in on every second row
      FOR dwp = dwp TO dwp + rowLen - 4 STEP 8    ' Check every other pixel in row
         IF @dwp = clr THEN @dwp = clr2
      NEXT
   NEXT

   RedrawWindow hViewer, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW

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

' ========================================================================================
' Replace all occurrences of color1 with color2
' ========================================================================================
SUB ImgColorReplace(BYVAL clr AS DWORD, BYVAL clr2 AS DWORD)

   LOCAL dwp AS DWORD PTR
   LOCAL Bm AS BITMAP

   GetObject hBitmap, SIZEOF(bm), bm

   FOR dwp = bm.bmBits TO bm.bmBits + (bm.bmWidth * bm.bmHeight * 4) STEP 4
      IF @dwp = clr THEN @dwp = clr2
   NEXT

   RedrawWindow hViewer, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW

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

' ========================================================================================
' Flip picture top to bottom
' ========================================================================================
SUB ImgFlipBottomTop

   LOCAL i AS LONG
   LOCAL j AS LONG
   LOCAL v1 AS DWORD
   LOCAL v2 AS DWORD
   LOCAL tdwp AS DWORD PTR
   LOCAL dwp AS DWORD PTR
   LOCAL dwp2 AS DWORD PTR
   LOCAL Bm AS BITMAP

   GetObject hBitmap, SIZEOF(bm), bm
   dwp  = bm.bmBits
   dwp2 = dwp + 4 * ((bm.bmWidth * bm.bmHeight) - bm.bmWidth)
   v1   = bm.bmHeight \ 2
   v2   = (bm.bmWidth * 8)

   FOR j = 1 TO v1             ' Vertical loop, top to bottom
      FOR i = 1 TO bm.bmWidth  ' Horizontal loop, row by row
         tdwp  = @dwp
         @dwp  = @dwp2
         @dwp2 = tdwp
         ! add dwp, 4
         ! add dwp2, 4
      NEXT
      dwp2 = dwp2 - v2
   NEXT

   RedrawWindow hViewer, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW

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

' ========================================================================================
' Flip picture left to right
' ========================================================================================
SUB ImgFlipLeftRight

   LOCAL i AS LONG
   LOCAL j AS LONG
   LOCAL v1 AS DWORD
   LOCAL v2 AS DWORD
   LOCAL v3 AS DWORD
   LOCAL dwp AS DWORD PTR
   LOCAL dwp2 AS DWORD PTR
   LOCAL tdwp AS DWORD PTR
   LOCAL Bm AS BITMAP

   GetObject hBitmap, SIZEOF(bm), bm
   dwp = bm.bmBits
   v1  = bm.bmWidth * 4
   v2  = bm.bmWidth \ 2
   v3  = bm.bmWidth * 2

   FOR j = 1 TO bm.bmHeight  ' Vertical loop, top to bottom
      dwp2  = dwp + v1
      FOR i = 1 TO v2        ' Horizontal loop, row by row
         tdwp  = @dwp        ' Swap color at pos1 with pos2's
         @dwp  = @dwp2
         @dwp2 = tdwp
         ! add dwp, 4
         ! sub dwp2, 4
      NEXT
      dwp = dwp + v3
   NEXT

   RedrawWindow hViewer, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW

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

' ========================================================================================
' Flip picture 180 degrees (half turn)
' ========================================================================================
SUB ImgFlip180

   LOCAL j AS LONG
   LOCAL dwp AS DWORD PTR
   LOCAL dwp2 AS DWORD PTR
   LOCAL tdwp AS DWORD PTR
   LOCAL Bm AS BITMAP

   GetObject hBitmap, SIZEOF(bm), bm
   dwp  = bm.bmBits
   dwp2 = bm.bmBits + (bm.bmHeight * bm.bmWidth * 4)

   FOR j = 1 TO (bm.bmHeight * bm.bmWidth) \ 2
      tdwp  = @dwp   ' Swap color at pos1 with pos2's
      @dwp  = @dwp2  ' (this is faster than PB's SWAP..)
      @dwp2 = tdwp
      ! add dwp, 4   ' Increase start pos
      ! sub dwp2, 4  ' Decrease end pos
   NEXT

   RedrawWindow hViewer, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_UPDATENOW

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