Hallo,
I would like to use a DDT-example from the PowerBasic-forum in my SDK code. Unfortunately I get with my SDK-translation not the same result. I use PBWin 9.05 an Windows XP SP3.
1. the listbox has no height. I can help me futher with the added style %LBS_NOINTEGRALHEIGHT. But why is that with DDT not necessary?
2. is olny one bitmap displayed with the SDK-style.
(I use PBWin 9.05 an Windows XP SP3.)
Please help me further.
DDT:
' Ownerdrawn bmp-listbox sample -> DDT-Style
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
#COMPILE EXE
#INCLUDE "WIN32API.INC"
DECLARE CALLBACK FUNCTION DlgProc
%IDC_LISTBOX_30 = 30
%BMPMARGIN = 2
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main entrance - Create dialog and controls
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION PBMAIN
LOCAL hDlg AS LONG, ic AS LONG, hBmp AS LONG, lRes AS LONG, txt AS STRING
DIALOG NEW 0, "BmpList sample",,, 160, 120, %WS_CAPTION OR %WS_SYSMENU TO hDlg
CONTROL ADD LISTBOX, hDlg, 30,, 5, 5, 40, 36, %WS_CHILD OR _
%WS_VISIBLE OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _
%LBS_NOTIFY OR %WS_TABSTOP OR %WS_VSCROLL, %WS_EX_CLIENTEDGE
CONTROL SEND hDlg, 30, %LB_SETITEMHEIGHT, 0, 36
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "&Close", 105, 98, 50, 14
'add some small system bitmaps, just to show how it works.
FOR ic = 32660 TO 32661
hBmp = LoadImage(BYVAL %NULL, BYVAL ic, %IMAGE_BITMAP, 0, 0, %LR_SHARED)
IF hBmp THEN
txt = ""
CONTROL SEND hDlg, %IDC_LISTBOX_30, %LB_ADDSTRING, 0, STRPTR(txt), TO lRes
CONTROL SEND hDlg, %IDC_LISTBOX_30, %LB_SETITEMDATA, lRes, hBmp
END IF
NEXT
DIALOG SHOW MODAL hDlg, CALL DlgProc
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main dialog callback
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION DlgProc
SELECT CASE CBMSG
CASE %WM_INITDIALOG
LOCAL itd AS LONG, rc AS RECT, lpdis AS DRAWITEMSTRUCT PTR, zTxt AS ASCIIZ * 300
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDCANCEL
IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
END SELECT
CASE %WM_DRAWITEM
IF CBWPARAM = %IDC_LISTBOX_30 THEn
lpdis = CBLPARAM
IF @lpdis.itemID = &HFFFFFFFF THEN
EXIT FUNCTION
end if
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'CLEAR BACKGROUND
IF (@lpdis.itemState AND %ODS_SELECTED) = 0 THEN 'if not selected
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_WINDOW)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'text color
ELSE
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_HIGHLIGHT)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)) 'text color
END IF
'DRAW BITMAP
itd = SendMessage(GetDlgItem(CBHNDL, %IDC_LISTBOX_30), %LB_GETITEMDATA, @lpdis.itemID, 0)
IF itd THEN
CALL DrawState(@lpdis.hDC, 0&, 0&, itd, 0&, _
%BMPMARGIN, @lpdis.rcItem.ntop + %BMPMARGIN, 0, 0, &H4)
'Note: if you want to draw icons instead - change last value to &H3
END IF
FUNCTION = %TRUE : EXIT FUNCTION
END SELECT
END IF
END SELECT
END FUNCTION
SDK:
' Ownerdrawn bmp-listbox sample -> SDK-Style
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Declares
'----------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
%IDC_LISTBOX_30 = 30
%IDC_BUTTON_2 = 2
%BMPMARGIN = 2
'----------------------------------------------------------------------
DECLARE FUNCTION WndProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Program entrance
'----------------------------------------------------------------------
FUNCTION WINMAIN(BYVAL hInst AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL wc AS WndClassEx, hFont AS DWORD
LOCAL hParent AS DWORD, hCtl AS DWORD, rc AS RECT
LOCAL dwStyle AS DWORD, dwStyleEx AS DWORD
LOCAL sCaption AS STRING, szClassName AS ASCIIZ*255
local ic AS LONG
local hBmp AS LONG
local txt AS STRING
szClassName = "MainClassName"
sCaption = "BmpList sample"
dwStyle = %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CAPTION OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR _
%DS_CENTER
dwStyleEx = %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT
CALL SetRect(rc, 517, 398, 246, 227)
wc.cbSize = SIZEOF(wc)
wc.style = %CS_DBLCLKS OR %CS_HREDRAW OR %CS_VREDRAW
wc.lpfnWndProc = CODEPTR(WndMainProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInst
wc.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = GetSysColorBrush(%COLOR_BTNFACE)
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(szClassName)
wc.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) 'sample, if resource icon: LoadIcon(hInst, "APPICON")
wc.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) 'remember to set small icon too..
IF ISFALSE(RegisterClassEx(wc)) THEN
FUNCTION = %TRUE :EXIT FUNCTION
END IF
hParent = CreateWindowEx(dwStyleEx,szClassName,BYVAL STRPTR(sCaption),dwStyle, _
rc.nLeft,rc.nTop,rc.nRight,rc.nBottom, _
%HWND_DESKTOP,%NULL,GetModuleHandle(""), BYVAL %NULL)
'------------------------------------------------------------------------------
szClassName = "ListBox"
sCaption = ""
dwStyle = %WS_CHILD OR _
%WS_VISIBLE OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _
%LBS_NOTIFY OR %WS_TABSTOP OR %WS_VSCROLL 'OR %LBS_NOINTEGRALHEIGHT
dwStyleEx = %WS_EX_CLIENTEDGE ' OR %WS_EX_CONTROLPARENT
CALL SetRect(rc, 8, 8, 40, 36)
hCtl = CreateWindowEx(dwStyleEx,szClassName,BYVAL STRPTR(sCaption),dwStyle, _
rc.nLeft,rc.nTop,rc.nRight,rc.nBottom, _
hParent,%IDC_LISTBOX_30,GetModuleHandle(""), BYVAL %NULL)
SendMessage hCtl, %LB_SETITEMHEIGHT, 0, 36
FOR ic = 32660 TO 32661
hBmp = LoadImage(BYVAL %NULL, BYVAL ic, %IMAGE_BITMAP, 0, 0, %LR_SHARED)
IF hBmp THEN
txt = ""
SendMessage hCtl, %LB_ADDSTRING, 0, STRPTR(txt)
SendMessage hCtl, %LB_SETITEMDATA, 0, hBmp
END IF
NEXT
'------------------------------------------------------------------------------
szClassName = "Button"
sCaption = "&Close"
dwStyle = %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP
dwStyleEx = 0
CALL SetRect(rc, 158, 159, 75, 23)
hCtl = CreateWindowEx(dwStyleEx,szClassName,BYVAL STRPTR(sCaption),dwStyle, _
rc.nLeft,rc.nTop,rc.nRight,rc.nBottom, _
hParent,%IDC_BUTTON_2,GetModuleHandle(""), BYVAL %NULL)
'------------------------------------------------------------------------------
ShowWindow hParent, nCmdShow
UpdateWindow hParent
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main Window procedure
'----------------------------------------------------------------------
FUNCTION WndMainProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
SELECT CASE wMsg
CASE %WM_INITDIALOG
LOCAL itd AS LONG, rc AS RECT, lpdis AS DRAWITEMSTRUCT PTR, zTxt AS ASCIIZ * 300
CASE %WM_COMMAND
'Messages from controls and menu items are handled here.
'-------------------------------------------------------
SELECT CASE LOWRD(wParam)
CASE %IDCANCEL
IF HIWRD(wParam) = %BN_CLICKED OR HIWRD(wParam) = 1 THEN
SendMessage hWnd, %WM_DESTROY, wParam, lParam
FUNCTION = 0 : EXIT FUNCTION
END IF
CASE %IDC_BUTTON_2
END SELECT
CASE %WM_DRAWITEM
IF wParam = %IDC_LISTBOX_30 THEN
lpdis = lParam
IF @lpdis.itemID = &HFFFFFFFF THEN
EXIT FUNCTION
end if
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'CLEAR BACKGROUND
IF (@lpdis.itemState AND %ODS_SELECTED) = 0 THEN 'if not selected
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_WINDOW)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'text color
ELSE
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_HIGHLIGHT)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)) 'text color
END IF
'DRAW BITMAP
itd = SendMessage(GetDlgItem(hWnd, %IDC_LISTBOX_30), %LB_GETITEMDATA, @lpdis.itemID, 0)
IF itd THEN
CALL DrawState(@lpdis.hDC, 0&, 0&, itd, 0&, _
%BMPMARGIN, @lpdis.rcItem.ntop + %BMPMARGIN, 0, 0, &H4)
'Note: if you want to draw icons instead - change last value to &H3
END IF
FUNCTION = %TRUE : EXIT FUNCTION
END SELECT
END IF
CASE %WM_DESTROY
' is sent when program ends - a good place to delete any created objects and
' store settings in file for next run, etc. Must send PostQuitMessage to end
' properly in SDK-style dialogs. The PostQuitMessage function posts a WM_QUIT
' message to the program's (thread's) message queue, and then WM_QUIT causes
' the GetMessage function to return zero in WINMAIN's message loop.
'----------------------------------------------------------------------------
PostQuitMessage 0
FUNCTION = 0 : EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
Okay, Point 2. is clear now. I have found the error.
It must be:
LOCAL lb_item_number AS long
FOR ic = 32660 TO 32661
hBmp = LoadImage(BYVAL %NULL, BYVAL ic, %IMAGE_BITMAP, 0, 0, %LR_SHARED)
IF hBmp THEN
txt = ""
SendMessage hCtl, %LB_ADDSTRING, 0, STRPTR(txt)
SendMessage hCtl, %LB_SETITEMDATA, lb_item_number, hBmp
INCR lb_item_number
END IF
NEXT
But I do not unterstand the thing with the height of the Listbox.
What makes b. Zale with DDT differently. Is this a question of the Style?
PBWinSpy gives me no answer.
hi norbert, perhaps you can try this one to see the different:
below "listbox"
CALL SetRect(rc, 18, 18, 140, 136)
code example:
' Ownerdrawn bmp-listbox sample -> SDK-Style
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Declares
'----------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
%IDC_LISTBOX_30 = 30
%IDC_BUTTON_2 = 2
%BMPMARGIN = 2
'----------------------------------------------------------------------
DECLARE FUNCTION WndProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Program entrance
'----------------------------------------------------------------------
FUNCTION WINMAIN(BYVAL hInst AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL wc AS WndClassEx, hFont AS DWORD
LOCAL hParent AS DWORD, hCtl AS DWORD, rc AS RECT
LOCAL dwStyle AS DWORD, dwStyleEx AS DWORD
LOCAL sCaption AS STRING, szClassName AS ASCIIZ*255
LOCAL ic AS LONG
LOCAL hBmp AS LONG
LOCAL TXT AS STRING
szClassName = "MainClassName"
sCaption = "BmpList sample"
dwStyle = %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CAPTION OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR _
%DS_CENTER
dwStyleEx = %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT
CALL SetRect(rc, 517, 398, 246, 227)
wc.cbSize = SIZEOF(wc)
wc.style = %CS_DBLCLKS OR %CS_HREDRAW OR %CS_VREDRAW
wc.lpfnWndProc = CODEPTR(WndMainProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInst
wc.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = GetSysColorBrush(%COLOR_BTNFACE)
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(szClassName)
wc.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) 'sample, if resource icon: LoadIcon(hInst, "APPICON")
wc.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) 'remember to set small icon too..
IF ISFALSE(RegisterClassEx(wc)) THEN
FUNCTION = %TRUE :EXIT FUNCTION
END IF
hParent = CreateWindowEx(dwStyleEx,szClassName,BYVAL STRPTR(sCaption),dwStyle, _
rc.nLeft,rc.nTop,rc.nRight,rc.nBottom, _
%HWND_DESKTOP,%NULL,GetModuleHandle(""), BYVAL %NULL)
'------------------------------------------------------------------------------
szClassName = "ListBox"
sCaption = ""
dwStyle = %WS_CHILD OR _
%WS_VISIBLE OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _
%LBS_NOTIFY OR %WS_TABSTOP OR %WS_VSCROLL 'OR %LBS_NOINTEGRALHEIGHT
dwStyleEx = %WS_EX_CLIENTEDGE ' OR %WS_EX_CONTROLPARENT
'CALL SetRect(rc, 8, 8, 40, 36)
CALL SetRect(rc, 18, 18, 140, 136)
hCtl = CreateWindowEx(dwStyleEx,szClassName,BYVAL STRPTR(sCaption),dwStyle, _
rc.nLeft,rc.nTop,rc.nRight,rc.nBottom, _
hParent,%IDC_LISTBOX_30,GetModuleHandle(""), BYVAL %NULL)
SendMessage hCtl, %LB_SETITEMHEIGHT, 0, 36
FOR ic = 32660 TO 32661
hBmp = LoadImage(BYVAL %NULL, BYVAL ic, %IMAGE_BITMAP, 0, 0, %LR_SHARED)
IF hBmp THEN
TXT = ""
SendMessage hCtl, %LB_ADDSTRING, 0, STRPTR(TXT)
SendMessage hCtl, %LB_SETITEMDATA, 0, hBmp
END IF
NEXT
'------------------------------------------------------------------------------
szClassName = "Button"
sCaption = "&Close"
dwStyle = %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP
dwStyleEx = 0
CALL SetRect(rc, 158, 159, 75, 23)
hCtl = CreateWindowEx(dwStyleEx,szClassName,BYVAL STRPTR(sCaption),dwStyle, _
rc.nLeft,rc.nTop,rc.nRight,rc.nBottom, _
hParent,%IDC_BUTTON_2,GetModuleHandle(""), BYVAL %NULL)
'------------------------------------------------------------------------------
ShowWindow hParent, nCmdShow
UpdateWindow hParent
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main Window procedure
'----------------------------------------------------------------------
FUNCTION WndMainProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
SELECT CASE wMsg
CASE %WM_INITDIALOG
LOCAL itd AS LONG, rc AS RECT, lpdis AS DRAWITEMSTRUCT PTR, zTxt AS ASCIIZ * 300
CASE %WM_COMMAND
'Messages from controls and menu items are handled here.
'-------------------------------------------------------
SELECT CASE LOWRD(wParam)
CASE %IDCANCEL
IF HIWRD(wParam) = %BN_CLICKED OR HIWRD(wParam) = 1 THEN
SendMessage hWnd, %WM_DESTROY, wParam, lParam
FUNCTION = 0 : EXIT FUNCTION
END IF
CASE %IDC_BUTTON_2
END SELECT
CASE %WM_DRAWITEM
IF wParam = %IDC_LISTBOX_30 THEN
lpdis = lParam
IF @lpdis.itemID = &HFFFFFFFF THEN
EXIT FUNCTION
END IF
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'CLEAR BACKGROUND
IF (@lpdis.itemState AND %ODS_SELECTED) = 0 THEN 'if not selected
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_WINDOW)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'text color
ELSE
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_HIGHLIGHT)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)) 'text color
END IF
'DRAW BITMAP
itd = SendMessage(GetDlgItem(hWnd, %IDC_LISTBOX_30), %LB_GETITEMDATA, @lpdis.itemID, 0)
IF itd THEN
CALL DrawState(@lpdis.hDC, 0&, 0&, itd, 0&, _
%BMPMARGIN, @lpdis.rcItem.ntop + %BMPMARGIN, 0, 0, &H4)
'Note: if you want to draw icons instead - change last value to &H3
END IF
FUNCTION = %TRUE : EXIT FUNCTION
END SELECT
END IF
CASE %WM_DESTROY
' is sent when program ends - a good place to delete any created objects and
' store settings in file for next run, etc. Must send PostQuitMessage to end
' properly in SDK-style dialogs. The PostQuitMessage function posts a WM_QUIT
' message to the program's (thread's) message queue, and then WM_QUIT causes
' the GetMessage function to return zero in WINMAIN's message loop.
'----------------------------------------------------------------------------
PostQuitMessage 0
FUNCTION = 0 : EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
I've not checked whole code but see at first shurt eye catcher this could be one tipp for you.
2) if you are using controls you can do something like
hCtl = CreateWindowEx(0, "BUTTON", "&Popup", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
0, 0, 0, 0, hWndMain, %IDOK, hInstance, BYVAL %NULL)
IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
and then size the control in window procedere (call back/ddt) with
CASE %WM_SIZE
' Resize the two sample buttons of the dialog
IF wParam <> %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
MoveWindow GetDlgItem(hWnd, %IDOK), 585, 435, 75, 23, %TRUE
MoveWindow GetDlgItem(hWnd, %IDCANCEL), 495, 435, 75, 23, %TRUE
END IF
see fixed example in zip file. compiled with pbwin 10.
best regards, frank
Hello Frank
thank you for your answer. But the question for me is not how can I make the listbox items visible. I wonder why is the difference between DDT and SDK. DDT is still just a wrapper for the WIN API. So I thought: Missing in my SDK sample an add style for the listbox.
Regards
Quote from: Norbert Spoerl on November 09, 2011, 12:39:30 PM
Hello Frank
thank you for your answer. But the question for me is not how can I make the listbox items visible. I wonder why is the difference between DDT and SDK. DDT is still just a wrapper for the WIN API. So I thought: Missing in my SDK sample an add style for the listbox.
Regards
In your DDT code you're using dialog units and with SDK windows you have to use pixels.
DDT is not a wrapper for SDK Windows, but a wrapper on top of the Dialog Windows Engine. Dialogs and SDK windows are very different.
Therefore, don't use dialog styles with SDK windows, as you're doing in
dwStyle = %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CAPTION OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR _
%DS_CENTER
The "DS_xxx" are dialog styles.
Use instead something like
dwStyle = %WS_OVERLAPPEDWINDOW OR %WS_CLIPCHILDREN
hello norbert, if you like you can study this simple sdk windows example with two buttons. I have had same exploring and experience about difference between ddt dialog and sdk window frame. either you're working with ddt modus or sdk modus. I prefer sdk modus, although there's a lot of more to code and it's not easiest way at beginning to grasp all new things, but the exe files are smaller and faster (I've tested some weeks ago this behaviour). Perhaps you can later have a closer look to josé's "cWindow" class too.
here simple sdk window frame four you:
' ========================================================================================
' HELLOWIN.BAS
' This program is a translation/adaptation of the HELLOWIN.C program © Charles Petzold, 1998,
' described and analysed in Chapter 3 of the book Programming Windows, 5th Edition.
' Creating a window first requires registering a window class, and that requires a window
' procedure to process messages to the window. This involves a bit of overhead that
' appears in almost every Windows program. The HELLOWIN program is a simple program
' showing mostly that overhead.
' ========================================================================================
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL szAppName AS ASCIIZ * 256
LOCAL wcex AS WNDCLASSEX
LOCAL hCtl AS DWORD
LOCAL hFont AS DWORD
szAppName = "HelloWin"
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.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szAppName)
IF ISFALSE RegisterClassEx(wcex) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style
szAppName, _ ' window class name
"The Hello Program", _ ' 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
BYVAL %NULL) ' creation parameters
hCtl = CreateWindowEx(0, "BUTTON", "&message", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
0, 0, 0, 0, hWnd, %IDOK, hInstance, BYVAL %NULL)
IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
0, 0, 0, 0, hWnd, %IDCANCEL, hInstance, BYVAL %NULL)
IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
ShowWindow hwnd, iCmdShow
UpdateWindow hwnd
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hdc AS DWORD
LOCAL ps AS PAINTSTRUCT
LOCAL rc AS RECT
SELECT CASE uMsg
CASE %WM_CREATE
PlaySound "hellowin.wav", %NULL, %SND_FILENAME OR %SND_ASYNC
EXIT FUNCTION
CASE %WM_KEYDOWN
SELECT CASE LO(WORD, wParam)
CASE %VK_ESCAPE
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END SELECT
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDOK
IF HI(WORD, wParam) = %BN_CLICKED THEN
'do something here
MSGBOX "do some functions here!"
END IF
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
EXIT FUNCTION
CASE %WM_SIZE
' Resize the two sample buttons of the dialog
IF wParam <> %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
MoveWindow GetDlgItem(hWnd, %IDOK), 585, 435, 75, 23, %TRUE
MoveWindow GetDlgItem(hWnd, %IDCANCEL), 495, 435, 75, 23, %TRUE
END IF
CASE %WM_PAINT
hdc = BeginPaint(hwnd, ps)
GetClientRect hwnd, rc
SetBkMode hDC, %TRANSPARENT
SetTextColor hDC, %RED
DrawText hdc, "Hello, Norbert's Windows!", -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
EndPaint(hwnd, ps)
FUNCTION = 1
EXIT FUNCTION
CASE %WM_ERASEBKGND
hDC = wParam
DrawGradient hDC ' Pass the DC of the region to repaint
FUNCTION = 1
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
'==============================================================================
SUB DrawGradient (BYVAL hDC AS DWORD)
'------------------------------------------------------------------------------
' Custom draw procedure for gradiend fill
'--------------------------------------------------------------------------
LOCAL rectFill AS RECT
LOCAL rectClient AS RECT
LOCAL fStep AS SINGLE
LOCAL hBrush AS DWORD
LOCAL lOnBand AS LONG
GetClientRect WindowFromDC(hDC), rectClient
fStep = rectClient.nbottom / 200
FOR lOnBand = 0 TO 199
SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
hBrush = CreateSolidBrush(RGB(0, 0, 255 - lOnBand))
Fillrect hDC, rectFill, hBrush
DeleteObject hBrush
NEXT
END SUB
best regards, frank
The code below is the version of your code generated by Phoenix 3.0 for the PowerBASIC 10+ compiler.
'###############################################################################
' Phoenix Visual Designer
' Generated source code
'###############################################################################
' Acknowledgements
' José Roca:
' For his ground breaking work which interfaces low-level COM and
' PowerBASIC-COM automation.
'
' Jeffrey Richter:
' For his original implementation of a layout algorithm which positions
' controls in a window based on a set of rules.
#DIM ALL
#REGISTER NONE
#COMPILE EXE
#OPTION VERSION4
'%NTDDI_VERSION = &H05010000
'%WINVER = &H0501
'%WIN32_WINNT = &H0501
'%WIN32_IE = &H0600
%UNICODE = 1
#INCLUDE "WIN32API.INC"
'=========================== [ Control Identifiers ] ===========================
' Form1
%IDD_FORM1 = 100
%IDC_FORM1_LIST1 = 101
%BMPMARGIN = 2
'====================== [ Global Variable Declarations ] =======================
GLOBAL ghInstance AS DWORD ' handle of the application instance
'-------------------------------------------------------------------------------
'
' PROCEDURE: WinMain
' PURPOSE: Program entry point, calls initialization function, processes
' message loop.
'
'-------------------------------------------------------------------------------
FUNCTION WinMain _
( _
BYVAL hInstance AS DWORD, _ ' handle of current instance
BYVAL hPrevInstance AS DWORD, _ ' handle of previous instance(not used in Win32)
BYVAL pszCmdLine AS WSTRINGZ PTR, _ ' address of command line
BYVAL nCmdShow AS LONG _ ' show state of window
) AS LONG
LOCAL szClassName AS WSTRINGZ * %MAX_PATH ' class name
LOCAL twcx AS WNDCLASSEX ' class information
LOCAL tmsg AS tagMsg ' message information
LOCAL hWnd AS DWORD ' handle of main window
' Save the handle of the application instance
ghInstance = hInstance
' Register the Form1 window
szClassName = "MainClassName"
twcx.cbSize = SIZEOF(twcx) ' size of WNDCLASSEX structure
twcx.style = %CS_DBLCLKS OR %CS_HREDRAW OR %CS_VREDRAW ' class styles
twcx.lpfnWndProc = CODEPTR(WndMainProc) ' address of window procedure used by class
twcx.cbClsExtra = 0 ' extra class bytes
twcx.cbWndExtra = 0 ' extra window bytes
twcx.hInstance = ghInstance ' instance of the process that is registering the window
twcx.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION) ' handle of class icon
twcx.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) ' handle of class cursor
twcx.hbrBackground = %COLOR_BTNFACE + 1 ' brush used to fill background of window's client area
twcx.lpszMenuName = %NULL ' resource identifier of the class menu
twcx.lpszClassName = VARPTR(szClassName) ' class name
twcx.hIconSm = %NULL ' handle of small icon shown in caption/system Taskbar
IF ISFALSE RegisterClassEx(twcx) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
' Create the Form1 window
hWnd = CreateWindowEx(%WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT, _ ' extended styles
"MainClassName", _ ' class name
"BmpList sample", _ ' caption
%WS_POPUP OR %WS_VISIBLE OR %WS_CAPTION OR %WS_SYSMENU OR _ ' window styles
%WS_CLIPCHILDREN, _
517, 398, _ ' left, top
244, 225, _ ' width, height
%NULL, %NULL, _ ' handle of owner, menu handle
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
' If window could not be created, return "failure"
IF ISFALSE hWnd THEN
FUNCTION = %FALSE
EXIT FUNCTION
END IF
' Make the window visible; update its client area
ShowWindow hWnd, nCmdShow
UpdateWindow hWnd
' Main message loop of program.
' Acquire and dispatch messages until a WM_QUIT message is received.
WHILE GetMessage(tmsg, BYVAL %NULL, 0, 0) > 0
IF ISFALSE IsDialogMessage(hWnd, tmsg) THEN
TranslateMessage tmsg
DispatchMessage tmsg
END IF
WEND
FUNCTION = tmsg.wParam
END FUNCTION
'-------------------------------------------------------------------------------
'
' PROCEDURE: WndMainProc
' PURPOSE: Processes messages for the Form1 window.
'
'-------------------------------------------------------------------------------
FUNCTION WndMainProc _
( _
BYVAL hWnd AS DWORD, _ ' window handle
BYVAL uMsg AS DWORD, _ ' type of message
BYVAL wParam AS DWORD, _ ' first message parameter
BYVAL lParam AS LONG _ ' second message parameter
) EXPORT AS LONG
LOCAL hWndChild AS DWORD ' handle of child window
LOCAL hFont AS DWORD ' handle of font used by form
LOCAL ic AS LONG
LOCAL hBmp AS LONG
LOCAL txt AS WSTRING
LOCAL i AS LONG
LOCAL itd AS LONG, rc AS RECT, lpdis AS DRAWITEMSTRUCT PTR
SELECT CASE uMsg
CASE %WM_COMMAND
SELECT CASE LOWRD(wParam)
CASE %IDC_FORM1_LIST1
SELECT CASE HIWRD(wParam)
CASE %LBN_DBLCLK
CASE %LBN_SELCHANGE
END SELECT
CASE %IDCANCEL
IF HIWRD(wParam) = %BN_CLICKED THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
END IF
END SELECT
CASE %WM_MEASUREITEM
CASE %WM_DRAWITEM
IF wParam = %IDC_FORM1_LIST1 THEN
lpdis = lParam
IF @lpdis.itemID = &HFFFFFFFF THEN
EXIT FUNCTION
END IF
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'CLEAR BACKGROUND
IF (@lpdis.itemState AND %ODS_SELECTED) = 0 THEN 'if not selected
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_WINDOW)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'text color
ELSE
FillRect(@lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_HIGHLIGHT)) 'clear background
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)) 'text background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)) 'text color
END IF
'DRAW BITMAP
itd = SendMessage(@lpdis.hwndItem, %LB_GETITEMDATA, @lpdis.itemID, 0)
IF itd THEN
CALL DrawState(@lpdis.hDC, 0&, 0&, itd, 0&, _
%BMPMARGIN, @lpdis.rcItem.ntop + %BMPMARGIN, 0, 0, &H4)
'Note: if you want to draw icons instead - change last value to &H3
END IF
FUNCTION = %TRUE : EXIT FUNCTION
END SELECT
END IF
CASE %WM_SETFOCUS
' Set the keyboard focus to the first control that is
' visible, not disabled, and has the WS_TABSTOP style
SetFocus GetNextDlgTabItem(hWnd, %NULL, %FALSE)
CASE %WM_CLOSE
CASE %WM_QUERYENDSESSION
CASE %WM_DESTROY
PostQuitMessage 0
FUNCTION = %FALSE
EXIT FUNCTION
CASE %WM_CREATE
' Create font used by container
hFont = GetStockObject(%DEFAULT_GUI_FONT)
' Create the List1 listbox
hWndChild = CreateWindowEx(%WS_EX_CLIENTEDGE, _ ' extended styles
"Listbox", _ ' class name
"", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR _ ' window styles
%WS_TABSTOP OR _
%LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _ ' class styles
%LBS_NOTIFY, _
8, 8, _ ' left, top
60, 42, _ ' width, height
hWnd, %IDC_FORM1_LIST1, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
' Set the height of list items
SendMessage hWndChild, %LB_SETITEMHEIGHT, 0, 36
' Adjust the height of the control so that the integral height
' is based on the new font rather than the default SYSTEM_FONT
SetWindowPos hWndChild, %NULL, 8, 8, 60, 42, %SWP_NOZORDER
FOR ic = 32660 TO 32661
hBmp = LoadImage(BYVAL %NULL, BYVAL ic, %IMAGE_BITMAP, 0, 0, %LR_SHARED)
IF hBmp THEN
txt = ""
i = SendMessage(hWndChild, %LB_ADDSTRING, 0, STRPTR(txt))
SendMessage hWndChild, %LB_SETITEMDATA, i, hBmp
END IF
NEXT
' Create the Cancel text button
hWndChild = CreateWindowEx(%NULL, _ ' extended styles
"Button", _ ' class name
"&Close", _ ' caption
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ ' window styles
%BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _ ' class styles
158, 159, _ ' left, top
75, 23, _ ' width, height
hWnd, %IDCANCEL, _ ' handle of parent, control ID
ghInstance, BYVAL %NULL) ' handle of instance, creation parameters
SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
FUNCTION = %FALSE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
The following explains why the listbox collapses to 4 pixels.
By the way, the same is true for the DDT listbox.
A listbox that does not have the LBS_NOINTEGRALHEIGHT style sets its initial height based on the stock
SYSTEM_FONT. The average character height of this font is 16 pixels, therefore, the minimum height of
the listbox(client edge with no border) would be 20 pixels according to the Phoenix Visual Form designer.
The minimum height of a listbox without the LBS_NOINTEGRALHEIGHT style can be represented by the following formulae:
CyCtrl = cyBorder + (cyItem * ((cySet - cyBorder * 2) \ cyItem)) + cyBorder
cyMinCtrl = cyBorder + cyItem + cyBorder
cyMinCtrl = Minimum integral height of control
cyCtrl = Final height of control in pixels
cySet = Height passed to CreateWindowEx in pixels
cyItem = Height of item/font in pixels
cyBorder = Height of border in pixels
In your case(after control is created before call to LB_SETITEMHEIGHT)
cySet = 36
cyBorder = 4
cyItem(font height) = 16
Therefore, the height of the control after it is created = 36 pixels.
(I guess 36 is a bad example)
Then you set the item height to 36 pixels, but that requires the control to have a minimum integral height of 40 pixels.
The control always rounds down when setting its integral height which causes big headaches in a Visual Form Designer.
In you case, the current height of the control is 36 pixels not the 40 needed for an integral height. The control
shrinks to the next integral height leaving only the borders and a client height of zero pixels.
This is why the Phoenix Form Designer generates this code after the font and item height is set for the control.
' Adjust the height of the control so that the integral height
' is based on the new font rather than the default SYSTEM_FONT
SetWindowPos hWndChild, %NULL, 8, 8, 60, 42, %SWP_NOZORDER
By the way, Phoenix 2.0 generated this code in the wrong order.
Many thanks, this helps me really.
Frank, Thanks for your code example.
Jose,
"In your code you're using DDT dialog units and with windows SDK you have to use pixels."
-> That is the point to which I not came.
The use of the code snippet with %DS_XXX came from the use of PB WinSpy++++ v1.17.
I compiled the DDT-example and got then a framework with PB WinSpy for the translation
to SDK. In my real source code, I had not used %DS_XXX.
Dominic, you have this really explained well. This is very instructive for me.
Greetings