Load DIBS + BMPs

[Frank Brübach]

hi all.

I have used first time "Load DIBS", there are three different pictures (BMP's). the program determines the DIB width and heigth from header information structure, that's ok.  

When displaying my three DIBs in full size or in the partial views, the screen set coordinates
are identical regardless of which bitmap is being displayed my coordinates are not identical
( I have intended it this way!). the example works, but after closing the application I have got an " gpf ".
It may belongs perhaps to this inconvenience to original bitmap size, I have changed, I am not sure.

bitmap size of three pictures:

1) "herz2.bmp": 347x259
(red glass+heart)

2) "wohnzimmerM.bmp":307x277
(translation: livingroom)

3) "womanart.bmp": 180x240


code as example:

Code Select Expand



#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "objbase.inc"

FUNCTION DibLoadImage (BYVAL strFileName AS STRING) AS DWORD

  LOCAL bSuccess AS LONG
  LOCAL dwFileSize AS DWORD
  LOCAL dwHighSize AS DWORD
  LOCAL dwBytesRead AS DWORD
  LOCAL hFile AS DWORD
  LOCAL pbmfh AS BITMAPFILEHEADER PTR

  hFile = CreateFile(BYCOPY strFileName, %GENERIC_READ, %FILE_SHARE_READ, _
          BYVAL %NULL, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN, %NULL)
  IF hFile = %INVALID_HANDLE_VALUE THEN EXIT FUNCTION

  dwFileSize = GetFileSize(hFile, dwHighSize)
  IF dwHighSize THEN
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Read the contents of the file. Notice that pmfh has been cast as
  ' BITMAPFILEHEADER PTR to be able to read the header.
  pbmfh = CoTaskMemAlloc(dwFileSize)
  bSuccess = ReadFile (hFile, BYVAL pbmfh, dwFileSize, dwBytesRead, BYVAL %NULL)
  ' Check for "BM" (&H4D42, i.e. &H42 = "B", &H4D = "M", they are in reverse order)
  IF ISFALSE bSuccess OR dwBytesRead <> dwFileSize OR @pbmfh.bfType <> &H4D42 THEN
     CoTaskMemFree pbmfh
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Close the file handle and return a pointer to the data read
  CloseHandle hFile
  FUNCTION = pbmfh

END FUNCTION


' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                 BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

  LOCAL szAppName AS ASCIIZ * 256
  LOCAL msg       AS tagMsg
  LOCAL hWnd      AS DWORD
  LOCAL wc        AS WNDCLASS
  LOCAL szCaption AS ASCIIZ * 256
  LOCAL picture AS LONG

  szAppName        = "Living Room with Heart"
  wc.style         = %CS_HREDRAW OR %CS_VREDRAW
  wc.lpfnWndProc   = CODEPTR(WndProc)
  wc.cbClsExtra    = 0
  wc.cbWndExtra    = 0
  wc.hInstance     = hInstance
  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(szAppName)

  IF ISFALSE RegisterClass(wc) THEN
     FUNCTION = %TRUE
     EXIT FUNCTION
  END IF

  szCaption = "Living Room with Heart"
  hWnd = CreateWindow (szAppName, _             ' window class name
                       szCaption, _             ' window caption
                       %WS_OVERLAPPEDWINDOW, _  ' window style
                       %CW_USEDEFAULT, _        ' initial x position
                       %CW_USEDEFAULT, _        ' initial y position
                       %CW_USEDEFAULT, _        ' initial x size
                       %CW_USEDEFAULT, _        ' initial y size
                       %NULL, _                 ' parent window handle
                       %NULL, _                 ' window menu handle
                       hInstance, _             ' program instance handle
                       %NULL)                   ' creation parameters

  ShowWindow hWnd, iCmdShow
  UpdateWindow hWnd

  MSGBOX "screen capture: show three pictures loading by dib load images/dbits", %MB_ICONINFORMATION, " petzold is my friend"

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

  FUNCTION = Msg.wParam

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

' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

  STATIC cxClient AS LONG
  STATIC cyClient AS LONG

  DIM    pbmfh(2) AS STATIC BITMAPFILEHEADER PTR
  DIM    pbmi(2) AS STATIC BITMAPINFO PTR
  DIM    pbits(2) AS STATIC BYTE PTR
  DIM    cxDib(2) AS STATIC LONG
  DIM    cyDib(2) AS STATIC LONG

  LOCAL  hdc AS DWORD
  LOCAL  ps  AS PAINTSTRUCT
  LOCAL  bSuccess AS LONG

  SELECT CASE message

     CASE %WM_CREATE
        ' Load the images
        pbmfh(0) = DibLoadImage("WohnzimmerM.bmp")
        pbmfh(1) = DibLoadImage("Herz2.bmp")
        pbmfh(2) = DibLoadImage("Womanart.bmp")
        IF pbmfh(0) = %NULL OR pbmfh(1) = %NULL OR pbmfh(2) = %NULL THEN
           MessageBox hWnd, "Cannot load DIB file", "WohnzimmerM", %MB_OK OR %MB_ICONERROR OR %MB_TASKMODAL
           EXIT FUNCTION
        END IF
        ' Get pointers to the info structure & the bits
        pbmi(0) = pbmfh(0) + SIZEOF(@pbmfh(0))  ' same as SIZEOF(BITMAPFILEHEADER)
        pbmi(1) = pbmfh(1) + SIZEOF(@pbmfh(1))
        pbmi(2) = pbmfh(2) + SIZEOF(@pbmfh(2))
        pbits(0) = pbmfh(0) + @pbmfh(0).bfOffBits
        pbits(1) = pbmfh(1) + @pbmfh(1).bfOffBits
        pbits(2) = pbmfh(2) + @pbmfh(2).bfOffBits
        ' Get the DIB width and height (assume BITMAPINFOHEADER)
        ' Note that cyDib is the absolute value of the header value!!!
        cxDib(0) = @pbmi(0).bmiHeader.biWidth
        cxDib(1) = @pbmi(1).bmiHeader.biWidth
        cxDib(2) = @pbmi(2).bmiHeader.biWidth
        cyDib(0) = ABS(@pbmi(0).bmiHeader.biHeight)
        cyDib(1) = ABS(@pbmi(1).bmiHeader.biHeight)
        cyDib(2) = ABS(@pbmi(2).bmiHeader.biHeight)
        FUNCTION = 0
        EXIT FUNCTION

     CASE %WM_SIZE
        ' Store the width and height of the client area
        cxClient = LOWRD(lParam)
        cyClient = HIWRD(lParam)
        FUNCTION = 0
        EXIT FUNCTION

     CASE %WM_PAINT
        ' Draw the bitmaps
        hdc = BeginPaint(hwnd, ps)
        bSuccess = SetDIBitsToDevice(hdc, 10, cyCLient / 4, cxDib(0), cyDib(0), 0, 0, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 240, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 340, cyCLient / 14, cxDib(1), cyDib(1), 0, 0, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 580, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 210, cyCLient / 2, cxDib(2), cyDib(2), 20, 60, 20, _ ' new picture!
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 480, cyCLient / 64, 140, 486, 80, 60, 0, _
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)

        EndPaint hWnd, ps
        FUNCTION = 0
        EXIT FUNCTION

    CASE %WM_DESTROY
        ' Free the allocated memory
        IF pbmfh(0) THEN CoTaskMemFree pbmfh(0)
        IF pbmfh(1) THEN CoTaskMemFree pbmfh(1)
        IF pbmfh(2) THEN CoTaskMemFree pbmfh(2)
        PostQuitMessage 0
        FUNCTION = 0
        EXIT FUNCTION

  END SELECT

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

END FUNCTION
'


this kind of powerbasic examples I like it was some difficult stuff to understand. uff. all work in progress.
any feedback is welcome.

edit: 19:46, fixed the script above for correct running after closing window

best regards, frank
info: see attached zip file

[Patrice Terrier]

Code Select Expand


'// Loads a bitmap from file.
FUNCTION LoadBitmapFromFile(BYVAL sBmpFile AS STRING) AS LONG ' OR DWORD
   FUNCTION = LoadImage(BYVAL 0&, (sBmpFile$), %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
END FUNCTION


[José Roca]

 
@Patrice,

You have forgot the return type. Must be:

Code Select Expand


'// Loads a bitmap from file.
FUNCTION LoadBitmapFromFile(BYVAL sBmpFile AS STRING) AS DWORD
    FUNCTION = LoadImage(BYVAL 0&, (sBmpFile$), %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
END FUNCTION


@Frank,

You are dimensioning the arrays twice. Remove the wrong duplicates:

Code Select Expand


'   DIM    pbmfh(1) AS STATIC BITMAPFILEHEADER PTR
   DIM    pbmfh(2) AS STATIC BITMAPFILEHEADER PTR
'   DIM    pbmi(1) AS STATIC BITMAPINFO PTR
   DIM    pbmi(2) AS STATIC BITMAPINFO PTR
'   DIM    pbits(1) AS STATIC BYTE PTR
   DIM    pbits(2) AS STATIC BYTE PTR
'   DIM    cxDib(1) AS STATIC LONG
'   DIM    cyDib(1) AS STATIC LONG
   DIM    cxDib(2) AS STATIC LONG
   DIM    cyDib(2) AS STATIC LONG


[Frank Brübach]

patrice and jose, thank you for help! example works very fine now !

1)

'// Loads a bitmap from file.
FUNCTION LoadBitmapFromFile(BYVAL sBmpFile AS STRING) AS LONG ' OR DWORD
   FUNCTION = LoadImage(BYVAL 0&, (sBmpFile$), %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
END FUNCTION

good to know patrice, I will test it for next time!

2) one more little question to path handling for a picture (here: "myCappuchino.jpg"):

Code Select Expand

#COMPILE EXE
#INCLUDE "win32api.inc"
#INCLUDE "commctrl.inc"

FUNCTION PBMAIN AS LONG
 LOCAL hDlg AS DWORD
 LOCAL lvbi AS LVBKIMAGE
 LOCAL szFile AS ASCIIZ*%MAX_PATH
 LOCAL lvi AS LVITEM

 InitCommonControls

 DIALOG NEW 0,"My JPG_PicTest",,,340,260,%WS_OVERLAPPEDWINDOW  OR %WS_CLIPCHILDREN  TO hDlg
 CONTROL ADD "syslistview32",hDlg,500,"",10,10,320,240, %WS_CHILD OR %WS_VISIBLE

 CONTROL SEND hDlg, 1000, %LVM_INSERTITEM, 0, VARPTR(lvi)
 CONTROL SEND hDlg, 1000, %LVM_INSERTITEM, 0, VARPTR(lvi)
 CONTROL SEND hDlg, 1000, %LVM_SETITEMPOSITION, 1, &H02000300

 szFile = "c:\myPicTest\pics\myCappucchino.jpg" '- how to set the picture without path name ?
 lvbi.ulFlags = %LVBKIF_STYLE_NORMAL OR %LVBKIF_SOURCE_URL

 lvbi.pszImage = VARPTR(szFile)
 lvbi.cchImageMax = LEN(szFile)
 CONTROL SEND hDlg, 500,  %LVM_SETBKIMAGE, 0, VARPTR(lvbi)

 DIALOG SHOW MODAL hDlg

END FUNCTION

how I can set the "szFile" in my example to a path the program can find the picture at the same level, without any folder or serious path description ? I want to avoid all path settings.

frank

[Patrice Terrier]

You should ALWAYS use a qualified path.
However, if the image is in the same folder than the EXE, then use this:
szFile = EXE.Path$ + "myImage.jpg"

[Frank Brübach]

good morning, hi patrice, jose, all

However, if the image is in the same folder than the EXE, then use this:
szFile = EXE.Path$ + "myImage.jpg"

1) thank you, patrice! that works fine. I have tried this way too.


2) my new project to build buttons and callbacks with my "livingroom" example:

my "living room" window with three buttons and two callbacks I have managed for

a) flash window (6x) - "WindowPulse" button (ok)
b) close window - "close" button (ok)

for the future:
c) colorize something - "Paint" button (still coming)
   ( not yet build in, more to come at a later moment )


my code example:

Code Select Expand

'-- frank 14.10.2009 sdk-window example with poba

#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "objbase.inc"

FUNCTION DibLoadImage (BYVAL strFileName AS STRING) AS DWORD

  LOCAL bSuccess AS LONG
  LOCAL dwFileSize AS DWORD
  LOCAL dwHighSize AS DWORD
  LOCAL dwBytesRead AS DWORD
  LOCAL hFile AS DWORD
  LOCAL pbmfh AS BITMAPFILEHEADER PTR

  hFile = CreateFile(BYCOPY strFileName, %GENERIC_READ, %FILE_SHARE_READ, _
          BYVAL %NULL, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN, %NULL)
  IF hFile = %INVALID_HANDLE_VALUE THEN EXIT FUNCTION

  dwFileSize = GetFileSize(hFile, dwHighSize)
  IF dwHighSize THEN
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Read the contents of the file. Notice that pmfh has been cast as
  ' BITMAPFILEHEADER PTR to be able to read the header.
  pbmfh = CoTaskMemAlloc(dwFileSize)
  bSuccess = ReadFile (hFile, BYVAL pbmfh, dwFileSize, dwBytesRead, BYVAL %NULL)
  ' Check for "BM" (&H4D42, i.e. &H42 = "B", &H4D = "M", they are in reverse order)
  IF ISFALSE bSuccess OR dwBytesRead <> dwFileSize OR @pbmfh.bfType <> &H4D42 THEN
     CoTaskMemFree pbmfh
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Close the file handle and return a pointer to the data read
  CloseHandle hFile
  FUNCTION = pbmfh

END FUNCTION


' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                 BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

  LOCAL szAppName AS ASCIIZ * 256
  LOCAL msg       AS tagMsg
  LOCAL hWnd      AS DWORD
  LOCAL wc        AS WNDCLASS
  LOCAL szCaption AS ASCIIZ * 256
  LOCAL picture AS LONG

  LOCAL hwndMain AS DWORD
  LOCAL hCtl AS DWORD
  LOCAL hFont AS DWORD
  LOCAL szClassName AS ASCIIZ * 80
  LOCAL rc AS RECT
  LOCAL nLeft AS LONG
  LOCAL nTop AS LONG
  LOCAL nWidth AS LONG
  LOCAL nHeight AS LONG

  hFont = GetStockObject(%ANSI_VAR_FONT)

  szAppName        = "Living Room with Heart"
  wc.style         = %CS_HREDRAW OR %CS_VREDRAW
  wc.lpfnWndProc   = CODEPTR(WndProc)
  wc.cbClsExtra    = 0
  wc.cbWndExtra    = 0
  wc.hInstance     = hInstance
  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(szAppName)

  IF ISFALSE RegisterClass(wc) THEN
     FUNCTION = %TRUE
     EXIT FUNCTION
  END IF

  szCaption = "Living Room with Heart"
  ' Retrieve the size of the working area
  SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

  ' Calculate the position and size of the window
  nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
  nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
  nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
  nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

  hWnd = CreateWindow (szAppName, _             ' window class name
                       szCaption, _             ' window caption
                       %WS_OVERLAPPEDWINDOW, _  ' window style
                       %CW_USEDEFAULT, _        ' initial x position
                       %CW_USEDEFAULT, _        ' initial y position
                       %CW_USEDEFAULT, _        ' initial x size
                       %CW_USEDEFAULT, _        ' initial y size
                       %NULL, _                 ' parent window handle
                       %NULL, _                 ' window menu handle
                       hInstance, _             ' program instance handle
                       %NULL)                   ' creation parameters

  hCtl = CreateWindow( "BUTTON", "&WindowPulse", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         10, 10, 100, 100, hwnd, %IDOK, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  hCtl = CreateWindow( "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         120, 120, 80, 80, hwnd, %IDCANCEL, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  hCtl = CreateWindow( "BUTTON", "&Colorize", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         160, 20, 60, 60, hwnd, %IDCANCEL, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  ShowWindow hWnd, iCmdShow
  UpdateWindow hWnd

  MSGBOX "screen capture: show three pictures loading by dib load images/dbits", %MB_ICONINFORMATION, " petzold is my friend"

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

  FUNCTION = Msg.wParam

END FUNCTION

' ========================================================================================
' Main dialog callback.
' ========================================================================================

FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
  LOCAL rc AS RECT
  LOCAL fwi AS FLASHWINFO

  STATIC cxClient AS LONG
  STATIC cyClient AS LONG

  DIM    pbmfh(2) AS STATIC BITMAPFILEHEADER PTR
  DIM    pbmi(2) AS STATIC BITMAPINFO PTR
  DIM    pbits(2) AS STATIC BYTE PTR
  DIM    cxDib(2) AS STATIC LONG
  DIM    cyDib(2) AS STATIC LONG

  LOCAL  hdc AS DWORD
  LOCAL  ps  AS PAINTSTRUCT
  LOCAL  bSuccess AS LONG

  SELECT CASE message

     CASE %WM_CREATE
        ' Load the images
        pbmfh(0) = DibLoadImage("WohnzimmerM.bmp")
        pbmfh(1) = DibLoadImage("Herz2.bmp")
        pbmfh(2) = DibLoadImage("Womanart.bmp")
        IF pbmfh(0) = %NULL OR pbmfh(1) = %NULL OR pbmfh(2) = %NULL THEN
           MessageBox hWnd, "Cannot load DIB file", "WohnzimmerM", %MB_OK OR %MB_ICONERROR OR %MB_TASKMODAL
           EXIT FUNCTION
        END IF
        ' Get pointers to the info structure & the bits
        pbmi(0) = pbmfh(0) + SIZEOF(@pbmfh(0))  ' same as SIZEOF(BITMAPFILEHEADER)
        pbmi(1) = pbmfh(1) + SIZEOF(@pbmfh(1))
        pbmi(2) = pbmfh(2) + SIZEOF(@pbmfh(2))
        pbits(0) = pbmfh(0) + @pbmfh(0).bfOffBits
        pbits(1) = pbmfh(1) + @pbmfh(1).bfOffBits
        pbits(2) = pbmfh(2) + @pbmfh(2).bfOffBits
        ' Get the DIB width and height (assume BITMAPINFOHEADER)
        ' Note that cyDib is the absolute value of the header value!!!
        cxDib(0) = @pbmi(0).bmiHeader.biWidth
        cxDib(1) = @pbmi(1).bmiHeader.biWidth
        cxDib(2) = @pbmi(2).bmiHeader.biWidth
        cyDib(0) = ABS(@pbmi(0).bmiHeader.biHeight)
        cyDib(1) = ABS(@pbmi(1).bmiHeader.biHeight)
        cyDib(2) = ABS(@pbmi(2).bmiHeader.biHeight)
        FUNCTION = 0
        EXIT FUNCTION

     CASE %WM_SIZE
        ' Store the width and height of the client area
        cxClient = LOWRD(lParam)
        cyClient = HIWRD(lParam)
        FUNCTION = 0
        EXIT FUNCTION

        ' Resize the two sample buttons of the dialog
        IF lParam <> %SIZE_MINIMIZED THEN 'wParam
           GetClientRect hwnd, rc
           MoveWindow GetDlgItem(hwnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
           MoveWindow GetDlgItem(hwnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
        END IF

       CASE %WM_COMMAND
        SELECT CASE LO(WORD, wParam)

           CASE %IDOK
              IF HI(WORD, wParam) = %BN_CLICKED THEN
                 fwi.cbSize = SIZEOF(FLASHWINFO)
                 fwi.hwnd = hwnd
                 fwi.dwFlags = %FLASHW_ALL
                 fwi.uCount = 6'3
                 FlashWindowEx(fwi)
                 SLEEP(500)
                 ' Play the system exclamation sound.
                 MessageBeep(%MB_ICONEXCLAMATION)
              END IF

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

        END SELECT

     CASE %WM_PAINT
        ' Draw the bitmaps
        hdc = BeginPaint(hwnd, ps)
        bSuccess = SetDIBitsToDevice(hdc, 10, cyCLient / 4, cxDib(0), cyDib(0), 0, 0, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 240, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 340, cyCLient / 14, cxDib(1), cyDib(1), 0, 0, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 580, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 210, cyCLient / 2, cxDib(2), cyDib(2), 20, 60, 20, _ ' new picture!
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 480, cyCLient / 64, 140, 486, 80, 60, 0, _
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)

        EndPaint hWnd, ps
        FUNCTION = 0
        EXIT FUNCTION

    CASE %WM_DESTROY
        ' Free the allocated memory
        IF pbmfh(0) THEN CoTaskMemFree pbmfh(0)
        IF pbmfh(1) THEN CoTaskMemFree pbmfh(1)
        IF pbmfh(2) THEN CoTaskMemFree pbmfh(2)
        PostQuitMessage 0
        FUNCTION = 0
        EXIT FUNCTION

  END SELECT

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


END FUNCTION

I am very glad! picture and zip file below from project with three buttons. two buttons are working well.

updated the code.

best regards, frank

[Frank Brübach]

hello and good evening.

my next step: I have managed to include a popup scroll bar in my living room example ! very nice thing you can change now the background colours of this window (see picture below).

new code example with scrollbar:

Code Select Expand



#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "objbase.inc"
#RESOURCE "colors2.pbr"

%IDPAINT = 100

SUB PaintRect( BYVAL hdc AS DWORD, rc AS Rect, BYVAL colour AS DWORD) EXPORT
  LOCAL oldcr AS DWORD
  oldcr = SetBkColor( hdc, colour )
  ExtTextOut hdc, 0, 0, %ETO_OPAQUE, rc, "", 0, 0
  SetBkColor hdc, oldcr
END SUB

FUNCTION DibLoadImage (BYVAL strFileName AS STRING) AS DWORD

  LOCAL bSuccess AS LONG
  LOCAL dwFileSize AS DWORD
  LOCAL dwHighSize AS DWORD
  LOCAL dwBytesRead AS DWORD
  LOCAL hFile AS DWORD
  LOCAL pbmfh AS BITMAPFILEHEADER PTR

  hFile = CreateFile(BYCOPY strFileName, %GENERIC_READ, %FILE_SHARE_READ, _
          BYVAL %NULL, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN, %NULL)
  IF hFile = %INVALID_HANDLE_VALUE THEN EXIT FUNCTION

  dwFileSize = GetFileSize(hFile, dwHighSize)
  IF dwHighSize THEN
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Read the contents of the file. Notice that pmfh has been cast as
  ' BITMAPFILEHEADER PTR to be able to read the header.
  pbmfh = CoTaskMemAlloc(dwFileSize)
  bSuccess = ReadFile (hFile, BYVAL pbmfh, dwFileSize, dwBytesRead, BYVAL %NULL)
  ' Check for "BM" (&H4D42, i.e. &H42 = "B", &H4D = "M", they are in reverse order)
  IF ISFALSE bSuccess OR dwBytesRead <> dwFileSize OR @pbmfh.bfType <> &H4D42 THEN
     CoTaskMemFree pbmfh
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Close the file handle and return a pointer to the data read
  CloseHandle hFile
  FUNCTION = pbmfh

END FUNCTION


' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                 BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

  LOCAL szAppName AS ASCIIZ * 256
  LOCAL msg       AS tagMsg
  LOCAL hWnd      AS DWORD
  LOCAL wc        AS WNDCLASS
  LOCAL szCaption AS ASCIIZ * 256
  LOCAL picture AS LONG
  LOCAL hDlgModeless AS DWORD
  LOCAL hwndMain AS DWORD
  LOCAL hCtl AS DWORD
  LOCAL hFont AS DWORD
  LOCAL szClassName AS ASCIIZ * 80
  LOCAL rc AS RECT
  LOCAL nLeft AS LONG
  LOCAL nTop AS LONG
  LOCAL nWidth AS LONG
  LOCAL nHeight AS LONG

  hFont = GetStockObject(%ANSI_VAR_FONT)

  szAppName        = "Living Room with Heart"
  wc.style         = %CS_HREDRAW OR %CS_VREDRAW
  wc.lpfnWndProc   = CODEPTR(WndProc)
  wc.cbClsExtra    = 0
  wc.cbWndExtra    = 0
  wc.hInstance     = hInstance
  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(szAppName)

  IF ISFALSE RegisterClass(wc) THEN
     FUNCTION = %TRUE
     EXIT FUNCTION
  END IF

  szCaption = "Living Room with Heart"
  ' Retrieve the size of the working area
  SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

  ' Calculate the position and size of the window
  nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
  nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
  nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
  nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

  hWnd = CreateWindow (szAppName, _             ' window class name
                       szCaption, _             ' window caption
                       %WS_OVERLAPPEDWINDOW, _  ' window style
                       %CW_USEDEFAULT, _        ' initial x position
                       %CW_USEDEFAULT, _        ' initial y position
                       %CW_USEDEFAULT, _        ' initial x size
                       %CW_USEDEFAULT, _        ' initial y size
                       %NULL, _                 ' parent window handle
                       %NULL, _                 ' window menu handle
                       hInstance, _             ' program instance handle
                       %NULL)                   ' creation parameters

  hCtl = CreateWindow( "BUTTON", "&WindowPulse", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         10, 10, 100, 100, hwnd, %IDOK, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  hCtl = CreateWindow( "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         120, 120, 80, 80, hwnd, %IDCANCEL, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  hCtl = CreateWindow( "BUTTON", "&Paint", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         160, 20, 60, 60, hwnd, %IDPAINT, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  ShowWindow hWnd, iCmdShow
  UpdateWindow hWnd

  hDlgModeless = CreateDialog(hInstance, "ColorScrDlg", hwnd, CODEPTR(ColorScrDlg))
 
  'MSGBOX "screen capture: show three pictures loading by dib load images/dbits", %MB_ICONINFORMATION, " petzold is my friend"

  IF hDlgModeless = 0 OR ISFALSE IsDialogMessage(hDlgModeless, msg) THEN
        TranslateMessage msg
        DispatchMessage msg
     END IF
     
  WHILE GetMessage(msg, %NULL, 0, 0)
     TranslateMessage msg
     DispatchMessage msg
  WEND

  FUNCTION = Msg.wParam

END FUNCTION

' ========================================================================================
' Main dialog callback.
' ========================================================================================

FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
  LOCAL rc AS RECT
  LOCAL fwi AS FLASHWINFO

  STATIC cxClient AS LONG
  STATIC cyClient AS LONG

  DIM    pbmfh(2) AS STATIC BITMAPFILEHEADER PTR
  DIM    pbmi(2) AS STATIC BITMAPINFO PTR
  DIM    pbits(2) AS STATIC BYTE PTR
  DIM    cxDib(2) AS STATIC LONG
  DIM    cyDib(2) AS STATIC LONG

  LOCAL  hdc AS DWORD
  LOCAL  ps  AS PAINTSTRUCT
  LOCAL  bSuccess AS LONG

  SELECT CASE message

     CASE %WM_CREATE
        ' Load the images
        pbmfh(0) = DibLoadImage("WohnzimmerM.bmp")
        pbmfh(1) = DibLoadImage("Herz2.bmp")
        pbmfh(2) = DibLoadImage("Womanart.bmp")
        IF pbmfh(0) = %NULL OR pbmfh(1) = %NULL OR pbmfh(2) = %NULL THEN
           MessageBox hWnd, "Cannot load DIB file", "WohnzimmerM", %MB_OK OR %MB_ICONERROR OR %MB_TASKMODAL
           EXIT FUNCTION
        END IF
        ' Get pointers to the info structure & the bits
        pbmi(0) = pbmfh(0) + SIZEOF(@pbmfh(0))  ' same as SIZEOF(BITMAPFILEHEADER)
        pbmi(1) = pbmfh(1) + SIZEOF(@pbmfh(1))
        pbmi(2) = pbmfh(2) + SIZEOF(@pbmfh(2))
        pbits(0) = pbmfh(0) + @pbmfh(0).bfOffBits
        pbits(1) = pbmfh(1) + @pbmfh(1).bfOffBits
        pbits(2) = pbmfh(2) + @pbmfh(2).bfOffBits
        ' Get the DIB width and height (assume BITMAPINFOHEADER)
        ' Note that cyDib is the absolute value of the header value!!!
        cxDib(0) = @pbmi(0).bmiHeader.biWidth
        cxDib(1) = @pbmi(1).bmiHeader.biWidth
        cxDib(2) = @pbmi(2).bmiHeader.biWidth
        cyDib(0) = ABS(@pbmi(0).bmiHeader.biHeight)
        cyDib(1) = ABS(@pbmi(1).bmiHeader.biHeight)
        cyDib(2) = ABS(@pbmi(2).bmiHeader.biHeight)
        FUNCTION = 0
        EXIT FUNCTION

     CASE %WM_SIZE
        ' Store the width and height of the client area
        cxClient = LOWRD(lParam)
        cyClient = HIWRD(lParam)
        FUNCTION = 0
        EXIT FUNCTION

        ' Resize the two sample buttons of the dialog
        IF lParam <> %SIZE_MINIMIZED THEN
           GetClientRect hwnd, rc
           MoveWindow GetDlgItem(hwnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
           MoveWindow GetDlgItem(hwnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
        END IF

       CASE %WM_COMMAND
        SELECT CASE LO(WORD, wParam)

           CASE %IDOK
              IF HI(WORD, wParam) = %BN_CLICKED THEN
                 fwi.cbSize = SIZEOF(FLASHWINFO)
                 fwi.hwnd = hwnd
                 fwi.dwFlags = %FLASHW_ALL
                 fwi.uCount = 6'3
                 FlashWindowEx(fwi)
                 SLEEP(500)
                 ' Play the system exclamation sound.
                 MessageBeep(%MB_ICONEXCLAMATION)
              END IF


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

           CASE %IDPAINT
              IF HI(WORD, wParam) = %BN_CLICKED THEN
                 SendMessage hwnd, %IDPAINT, 0, 0
                 PaintRect hDC, rc, %RED
                 SetRect rc, 5, 5, 150, 200
                 PaintRect hDC, rc, RGB( 100, 200, 0 )
                 MSGBOX "test: ok with painting?"
                 EXIT FUNCTION
              END IF

        END SELECT

     CASE %WM_PAINT
        ' Draw the bitmaps
        hdc = BeginPaint(hwnd, ps)
        bSuccess = SetDIBitsToDevice(hdc, 10, cyCLient / 4, cxDib(0), cyDib(0), 0, 0, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 240, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 340, cyCLient / 14, cxDib(1), cyDib(1), 0, 0, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 580, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 210, cyCLient / 2, cxDib(2), cyDib(2), 20, 60, 20, _ ' new picture!
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 480, cyCLient / 64, 140, 486, 80, 60, 0, _
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)

        EndPaint hWnd, ps
        FUNCTION = 0
        EXIT FUNCTION

    CASE %IDPAINT, %WM_PAINT

       hDC = BeginPaint(hwnd, ps)
       GetClientRect hwnd, rc

       PaintRect hDC, rc, %RED

       SetRect rc, 5, 5, 50, 100
       PaintRect hDC, rc, RGB( 100, 200, 0 )

       EndPaint hWnd, ps
       FUNCTION = %TRUE
       EXIT FUNCTION


    CASE %WM_DESTROY
        ' Free the allocated memory
        IF pbmfh(0) THEN CoTaskMemFree pbmfh(0)
        IF pbmfh(1) THEN CoTaskMemFree pbmfh(1)
        IF pbmfh(2) THEN CoTaskMemFree pbmfh(2)
        DeleteObject SetClassLong(hWnd, %GCL_HBRBACKGROUND, GetStockObject(%WHITE_BRUSH))
        PostQuitMessage 0
        FUNCTION = 0
        EXIT FUNCTION

  END SELECT

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


END FUNCTION

'--------------------------------------------------------


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

  DIM iColor(0 TO 2) AS STATIC LONG
  LOCAL hwndParent AS DWORD
  LOCAL hCtrl AS DWORD
  LOCAL iCtrlID AS LONG
  LOCAL iIndex AS LONG

  SELECT CASE message

     CASE %WM_INITDIALOG
        FOR iCtrlID = 10 TO 12
           hCtrl = GetDlgItem(hDlg, iCtrlID)
           SetScrollRange hCtrl, %SB_CTL, 0, 255, %FALSE
           SetScrollPos   hCtrl, %SB_CTL, 0, %FALSE
        NEXT
        FUNCTION = %TRUE

     CASE %WM_VSCROLL
        hCtrl = lParam
        iCtrlID = GetWindowLong(hCtrl, %GWL_ID)
        iIndex = iCtrlID - 10
        hwndParent = GetParent(hDlg)

        SELECT CASE LOWRD(wParam)

           CASE %SB_PAGEDOWN
              iColor(iIndex) = iColor(iIndex) + 15
              iColor(iIndex) = MIN&(255, iColor(iIndex) + 1)
           CASE %SB_LINEDOWN
              iColor(iIndex) = MIN&(255, iColor(iIndex) + 1)
           CASE %SB_PAGEUP
              iColor(iIndex) = iColor(iIndex) - 15
              iColor(iIndex) = MAX&(0, iColor(iIndex) - 1)
           CASE %SB_LINEUP
              iColor(iIndex) = MAX&(0, iColor(iIndex) - 1)
           CASE %SB_TOP
              iColor(iIndex) = 0
           CASE %SB_BOTTOM
              iColor(iIndex) = 255
           CASE %SB_THUMBPOSITION, %SB_THUMBTRACK
              iColor(iIndex) = HIWRD(wParam)
           CASE ELSE
              FUNCTION = %FALSE

        END SELECT

        SetScrollPos  hCtrl, %SB_CTL,     iColor(iIndex), %TRUE
        SetDlgItemInt hDlg,  iCtrlID + 3, iColor(iIndex), %FALSE
        DeleteObject SetClassLong(hwndParent, %GCL_HBRBACKGROUND, CreateSolidBrush(RGB(iColor(0), iColor(1), iColor(2))))
        InvalidateRect hwndParent, BYVAL %NULL, %TRUE
        FUNCTION = %TRUE

     CASE ELSE
        FUNCTION = %FALSE

  END SELECT

END FUNCTION


info: new zip-file as attachement

best regards, Frank

[Frank Brübach]

my first project is ready !  

I am proud of it, because the result satisfied myself ! I have learned so much things

project info:

my living room project to build buttons and callbacks with my "livingroom" example included:

a) flash window (6x) - "WindowPulse" button (ok)

b) close window - "close" button (ok)

c) colourize something - "Paint" button (ok)
  ( - new graphic window starts after pushing "paint" button with a coloured box within
    - red rectangle leaves, when you close this little painting graphic window)

wow! that's made fun to create! test it, if you like this example.

Code Select Expand

'-- frank 14.10.2009 sdk-window example with buttons + scroll popup, powerbasic version

#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "objbase.inc"
#RESOURCE "colors2.pbr"

%IDPAINT = 100
%IDC_GRAPHIC1 = 101

SUB PaintRect( BYVAL hdc AS DWORD, rc AS Rect, BYVAL colour AS DWORD) EXPORT
  LOCAL oldcr AS DWORD
  oldcr = SetBkColor( hdc, colour )
  ExtTextOut hdc, 0, 0, %ETO_OPAQUE, rc, "", 0, 0
  SetBkColor hdc, oldcr
END SUB

FUNCTION DibLoadImage (BYVAL strFileName AS STRING) AS DWORD

  LOCAL bSuccess AS LONG
  LOCAL dwFileSize AS DWORD
  LOCAL dwHighSize AS DWORD
  LOCAL dwBytesRead AS DWORD
  LOCAL hFile AS DWORD
  LOCAL pbmfh AS BITMAPFILEHEADER PTR

  hFile = CreateFile(BYCOPY strFileName, %GENERIC_READ, %FILE_SHARE_READ, _
          BYVAL %NULL, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN, %NULL)
  IF hFile = %INVALID_HANDLE_VALUE THEN EXIT FUNCTION

  dwFileSize = GetFileSize(hFile, dwHighSize)
  IF dwHighSize THEN
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Read the contents of the file. Notice that pmfh has been cast as
  ' BITMAPFILEHEADER PTR to be able to read the header.
  pbmfh = CoTaskMemAlloc(dwFileSize)
  bSuccess = ReadFile (hFile, BYVAL pbmfh, dwFileSize, dwBytesRead, BYVAL %NULL)
  ' Check for "BM" (&H4D42, i.e. &H42 = "B", &H4D = "M", they are in reverse order)
  IF ISFALSE bSuccess OR dwBytesRead <> dwFileSize OR @pbmfh.bfType <> &H4D42 THEN
     CoTaskMemFree pbmfh
     CloseHandle hFile
     EXIT FUNCTION
  END IF

  ' Close the file handle and return a pointer to the data read
  CloseHandle hFile
  FUNCTION = pbmfh

END FUNCTION


' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                 BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

  LOCAL szAppName AS ASCIIZ * 256
  LOCAL msg       AS tagMsg
  LOCAL hWnd      AS DWORD
  LOCAL wc        AS WNDCLASS
  LOCAL szCaption AS ASCIIZ * 256
  LOCAL picture AS LONG
  LOCAL hDlgModeless AS DWORD
  LOCAL hwndMain AS DWORD
  LOCAL hCtl AS DWORD
  LOCAL hFont AS DWORD
  LOCAL szClassName AS ASCIIZ * 80
  LOCAL rc AS RECT
  LOCAL nLeft AS LONG
  LOCAL nTop AS LONG
  LOCAL nWidth AS LONG
  LOCAL nHeight AS LONG

  hFont = GetStockObject(%ANSI_VAR_FONT)

  szAppName        = "Living Room with Heart"
  wc.style         = %CS_HREDRAW OR %CS_VREDRAW
  wc.lpfnWndProc   = CODEPTR(WndProc)
  wc.cbClsExtra    = 0
  wc.cbWndExtra    = 0
  wc.hInstance     = hInstance
  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(szAppName)

  IF ISFALSE RegisterClass(wc) THEN
     FUNCTION = %TRUE
     EXIT FUNCTION
  END IF

  szCaption = "Living Room with Heart"
  ' Retrieve the size of the working area
  SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

  ' Calculate the position and size of the window
  nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
  nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
  nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
  nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

  hWnd = CreateWindow (szAppName, _             ' window class name
                       szCaption, _             ' window caption
                       %WS_OVERLAPPEDWINDOW, _  ' window style
                       %CW_USEDEFAULT, _        ' initial x position
                       %CW_USEDEFAULT, _        ' initial y position
                       %CW_USEDEFAULT, _        ' initial x size
                       %CW_USEDEFAULT, _        ' initial y size
                       %NULL, _                 ' parent window handle
                       %NULL, _                 ' window menu handle
                       hInstance, _             ' program instance handle
                       %NULL)                   ' creation parameters

  hCtl = CreateWindow( "BUTTON", "&WindowPulse", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         10, 10, 100, 100, hwnd, %IDOK, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  hCtl = CreateWindow( "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         120, 120, 80, 80, hwnd, %IDCANCEL, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  hCtl = CreateWindow( "BUTTON", "&Paint", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
         160, 20, 60, 60, hwnd, %IDPAINT, hInstance, BYVAL %NULL)
  IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

  ShowWindow hWnd, iCmdShow
  UpdateWindow hWnd

  hDlgModeless = CreateDialog(hInstance, "ColorScrDlg", hwnd, CODEPTR(ColorScrDlg))

  'MSGBOX "screen capture: show three pictures loading by dib load images/dbits", %MB_ICONINFORMATION, " petzold is my friend"

  IF hDlgModeless = 0 OR ISFALSE IsDialogMessage(hDlgModeless, msg) THEN
        TranslateMessage msg
        DispatchMessage msg
     END IF

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

  FUNCTION = Msg.wParam

END FUNCTION

' ========================================================================================
' Main dialog callback.
' ========================================================================================

FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
  LOCAL rc AS RECT
  LOCAL fwi AS FLASHWINFO

  STATIC cxClient AS LONG
  STATIC cyClient AS LONG

  DIM    pbmfh(2) AS STATIC BITMAPFILEHEADER PTR
  DIM    pbmi(2) AS STATIC BITMAPINFO PTR
  DIM    pbits(2) AS STATIC BYTE PTR
  DIM    cxDib(2) AS STATIC LONG
  DIM    cyDib(2) AS STATIC LONG

  LOCAL  hdc AS DWORD
  LOCAL  ps  AS PAINTSTRUCT
  LOCAL  bSuccess AS LONG

  SELECT CASE message

     CASE %WM_CREATE
        ' Load the images
        pbmfh(0) = DibLoadImage("WohnzimmerM.bmp")
        pbmfh(1) = DibLoadImage("Herz2.bmp")
        pbmfh(2) = DibLoadImage("Womanart.bmp")
        IF pbmfh(0) = %NULL OR pbmfh(1) = %NULL OR pbmfh(2) = %NULL THEN
           MessageBox hWnd, "Cannot load DIB file", "WohnzimmerM", %MB_OK OR %MB_ICONERROR OR %MB_TASKMODAL
           EXIT FUNCTION
        END IF
        ' Get pointers to the info structure & the bits
        pbmi(0) = pbmfh(0) + SIZEOF(@pbmfh(0))  ' same as SIZEOF(BITMAPFILEHEADER)
        pbmi(1) = pbmfh(1) + SIZEOF(@pbmfh(1))
        pbmi(2) = pbmfh(2) + SIZEOF(@pbmfh(2))
        pbits(0) = pbmfh(0) + @pbmfh(0).bfOffBits
        pbits(1) = pbmfh(1) + @pbmfh(1).bfOffBits
        pbits(2) = pbmfh(2) + @pbmfh(2).bfOffBits
        ' Get the DIB width and height (assume BITMAPINFOHEADER)
        ' Note that cyDib is the absolute value of the header value!!!
        cxDib(0) = @pbmi(0).bmiHeader.biWidth
        cxDib(1) = @pbmi(1).bmiHeader.biWidth
        cxDib(2) = @pbmi(2).bmiHeader.biWidth
        cyDib(0) = ABS(@pbmi(0).bmiHeader.biHeight)
        cyDib(1) = ABS(@pbmi(1).bmiHeader.biHeight)
        cyDib(2) = ABS(@pbmi(2).bmiHeader.biHeight)
        FUNCTION = 0
        EXIT FUNCTION

     CASE %WM_SIZE
        ' Store the width and height of the client area
        cxClient = LOWRD(lParam)
        cyClient = HIWRD(lParam)
        FUNCTION = 0
        EXIT FUNCTION

        ' Resize the two sample buttons of the dialog
        IF lParam <> %SIZE_MINIMIZED THEN
           GetClientRect hwnd, rc
           MoveWindow GetDlgItem(hwnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
           MoveWindow GetDlgItem(hwnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
        END IF

       CASE %WM_COMMAND
        SELECT CASE LO(WORD, wParam)

           CASE %IDOK
              IF HI(WORD, wParam) = %BN_CLICKED THEN
                 fwi.cbSize = SIZEOF(FLASHWINFO)
                 fwi.hwnd = hwnd
                 fwi.dwFlags = %FLASHW_ALL
                 fwi.uCount = 6'3
                 FlashWindowEx(fwi)
                 SLEEP(500)
                 ' Play the system exclamation sound.
                 MessageBeep(%MB_ICONEXCLAMATION)
              END IF


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

           CASE %IDPAINT
              IF HI(WORD, wParam) = %BN_CLICKED THEN
                 SendMessage hwnd, %IDPAINT, 0, 0
                 PaintRect hDC, rc, %RED
                 SetRect rc, 5, 5, 150, 200
                 PaintRect hDC, rc, RGB( 100, 200, 0 )
                 MSGBOX "test: ok with painting?"
                 EXIT FUNCTION
              END IF

        END SELECT

     CASE %WM_PAINT
        ' Draw the bitmaps
        hdc = BeginPaint(hwnd, ps)
        bSuccess = SetDIBitsToDevice(hdc, 10, cyCLient / 4, cxDib(0), cyDib(0), 0, 0, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 240, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 340, cyCLient / 14, cxDib(1), cyDib(1), 0, 0, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 580, cyCLient / 24, 90, 186, 80, 60, 0, _
                   cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 210, cyCLient / 2, cxDib(2), cyDib(2), 20, 60, 20, _ ' new picture!
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)
        bSuccess = SetDIBitsToDevice(hdc, 480, cyCLient / 64, 140, 486, 80, 60, 0, _
                   cyDib(2), BYVAL pbits(2), BYVAL pbmi(2), %DIB_RGB_COLORS)

        EndPaint hWnd, ps
        FUNCTION = 0
        EXIT FUNCTION

    CASE %IDPAINT, %WM_PAINT
           DIM y AS LONG
           DIM hdlg AS DWORD
           DIM hWin AS DWORD

           GRAPHIC WINDOW "Paint_BoxWin", 480, 480, 230, 230 TO hWin
           GRAPHIC ATTACH hWin, 0
           GRAPHIC BOX (40, 40) - (130, 130), 0, %BLUE
           FOR y& = 0 TO 255
            GRAPHIC LINE (0, y&) - (255, y&), RGB(RND(0,255), 0, y&)
           NEXT
           GRAPHIC WIDTH 1
           GRAPHIC STYLE 4
           GRAPHIC BOX (40, 40) - (130, 130), 0, %BLUE
           GRAPHIC REDRAW
           SLEEP 5000  ' show it for 5 seconds, then end

           hDC = BeginPaint(hwnd, ps)
           GetClientRect hwnd, rc
           PaintRect hDC, rc, %RED
           SetRect rc, 5, 5, 50, 100
           PaintRect hDC, rc, RGB( 100, 200, 0 )
           EndPaint hWnd, ps
         FUNCTION = %TRUE
         EXIT FUNCTION


    CASE %WM_DESTROY
        ' Free the allocated memory
        IF pbmfh(0) THEN CoTaskMemFree pbmfh(0)
        IF pbmfh(1) THEN CoTaskMemFree pbmfh(1)
        IF pbmfh(2) THEN CoTaskMemFree pbmfh(2)
        DeleteObject SetClassLong(hWnd, %GCL_HBRBACKGROUND, GetStockObject(%WHITE_BRUSH))
        PostQuitMessage 0
        FUNCTION = 0
        EXIT FUNCTION

  END SELECT

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


END FUNCTION

'--------------------------------------------------------


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

  DIM iColor(0 TO 2) AS STATIC LONG
  LOCAL hwndParent AS DWORD
  LOCAL hCtrl AS DWORD
  LOCAL iCtrlID AS LONG
  LOCAL iIndex AS LONG

  SELECT CASE message

     CASE %WM_INITDIALOG
        FOR iCtrlID = 10 TO 12
           hCtrl = GetDlgItem(hDlg, iCtrlID)
           SetScrollRange hCtrl, %SB_CTL, 0, 255, %FALSE
           SetScrollPos   hCtrl, %SB_CTL, 0, %FALSE
        NEXT
        FUNCTION = %TRUE

     CASE %WM_VSCROLL
        hCtrl = lParam
        iCtrlID = GetWindowLong(hCtrl, %GWL_ID)
        iIndex = iCtrlID - 10
        hwndParent = GetParent(hDlg)

        SELECT CASE LOWRD(wParam)

           CASE %SB_PAGEDOWN
              iColor(iIndex) = iColor(iIndex) + 15
              iColor(iIndex) = MIN&(255, iColor(iIndex) + 1)
           CASE %SB_LINEDOWN
              iColor(iIndex) = MIN&(255, iColor(iIndex) + 1)
           CASE %SB_PAGEUP
              iColor(iIndex) = iColor(iIndex) - 15
              iColor(iIndex) = MAX&(0, iColor(iIndex) - 1)
           CASE %SB_LINEUP
              iColor(iIndex) = MAX&(0, iColor(iIndex) - 1)
           CASE %SB_TOP
              iColor(iIndex) = 0
           CASE %SB_BOTTOM
              iColor(iIndex) = 255
           CASE %SB_THUMBPOSITION, %SB_THUMBTRACK
              iColor(iIndex) = HIWRD(wParam)
           CASE ELSE
              FUNCTION = %FALSE

        END SELECT

        SetScrollPos  hCtrl, %SB_CTL,     iColor(iIndex), %TRUE
        SetDlgItemInt hDlg,  iCtrlID + 3, iColor(iIndex), %FALSE
        DeleteObject SetClassLong(hwndParent, %GCL_HBRBACKGROUND, CreateSolidBrush(RGB(iColor(0), iColor(1), iColor(2))))
        InvalidateRect hwndParent, BYVAL %NULL, %TRUE
        FUNCTION = %TRUE

     CASE ELSE
        FUNCTION = %FALSE

  END SELECT

END FUNCTION

feedback is welcome and constructive critics !

zip file with exe included.


where can I get infos about:

STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_CHILD

best regards, frank