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:
#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
'// 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
@Patrice,
You have forgot the return type. Must be:
'// 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:
' 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
patrice and jose, thank you for help! example works very fine now ! :)
1)
Quote'// 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"):
#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 FUNCTIONhow 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
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"
good morning, hi patrice, jose, all :)
QuoteHowever, 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:
'-- 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 FUNCTIONI am very glad! picture and zip file below from project with three buttons. two buttons are working well.
updated the code.
best regards, frank
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:
#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
my first project is ready ! :D
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.
'-- 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 FUNCTIONfeedback is welcome and constructive critics !
zip file with exe included.
where can I get infos about:
QuoteSTYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_CHILD
best regards, frank