http://www.jose.it-berater.org/smfforum/index.php?topic=3610.0
hello.
thanks josé for this example. I have tested the multiline header listview and works here fine. cause I am working just with pWindow and cWindow class here my questions:
a) well, but where do you define exactly the pwindow size of this listview example? for my example there needed some size to right direction I suppose
b) how to change the background and text color of
QuoteListView_AddItem(hListView, 0, 0, "1")
ListView_SetItemText(hListView, 0, 1, "Doe, John") ?
' ########################################################################################
' Mutiline header ListView example
' The technique used is to process the HDM_LAYOUT message, fill the WINDOWPOS structure
' with the appropriate size and position of the header control, and change the top position
' of the rectangle that the header control will occupy.
' CASE %HDM_LAYOUT
' LOCAL phdl AS HDLAYOUT PTR
' phdl = lParam
' @phdl.@pwpos.hwnd = hwnd
' @phdl.@pwpos.flags = %SWP_FRAMECHANGED
' @phdl.@pwpos.x = @phdl.@prc.nLeft
' @phdl.@pwpos.y = 0
' @phdl.@pwpos.cx = @phdl.@prc.nRight - @phdl.@prc.nLeft
' @phdl.@pwpos.cy = 40 ' --> change me
' @phdl.@prc.nTop = 40 ' --> change me
' FUNCTION = -1
' EXIT FUNCTION
' ########################################################################################
#COMPILE EXE
#DIM ALL
%USEMACROS = 1 ' // Use macros
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "ListViewCtrl.inc" ' // ListView control wrapper functions
#INCLUDE ONCE "HeaderCtrl.inc" ' // Header control wrapper functions
#INCLUDE ONCE "WinUtils.inc" ' // Miscellaneous wrapper functions
%IDC_LISTVIEW = 101
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
LOCAL hwnd AS DWORD
hwnd = pWindow.CreateWindow(%NULL, "Multiline Header ListView", 0, 0, 640, 350, -1, -1, CODEPTR(WindowProc))
' // Add a subclassed ListView control
LOCAL hListView AS DWORD
LOCAL rc AS RECT
GetClientRect hwnd, rc
LOCAL dwStyle AS DWORD
dwStyle = %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT OR %LVS_SINGLESEL OR %LVS_SHOWSELALWAYS
hListView = pWindow.AddListView(hwnd, %IDC_LISTVIEW, "", 0, 0, 0, 0, dwStyle, -1, CODEPTR(ListView_SubclassProc))
' // Add some extended styles
LOCAL dwExStyle AS DWORD
dwExStyle = ListView_GetExtendedListViewStyle(hListView)
dwExStyle = dwExStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES
ListView_SetExtendedListViewStyle(hListView, dwExStyle)
' // Get the handle of the ListView header control and subclass it
LOCAL hLvHeader AS DWORD
hLvHeader = ListView_GetHeader(hListView)
IF hLvHeader THEN SetProp hLvHeader, "OLDWNDPROC", SetWindowLong(hLvHeader, %GWL_WNDPROC, CODEPTR(ListViewHeader_SubclassProc))
' // Add the header's column names
ListView_AddColumn(hListView, 0, "Customer" & $CRLF & "number", 80, 1)
ListView_AddColumn(hListView, 1, "Name" & $CRLF & "First, last", 160, 0)
ListView_AddColumn(hListView, 2, "Telephone" & $CRLF & "number", 160, 0)
ListView_AddColumn(hListView, 3, "Street" & $CRLF & "address", 80, 0)
ListView_AddColumn(hListView, 4, "Action" & $CRLF & "items", 80, 1)
ListView_AddColumn(hListView, 5, "Hobby" & $CRLF & "Kind-of", 80, 0)
' // Populate the ListView with some data
ListView_AddItem(hListView, 0, 0, "1")
ListView_SetItemText(hListView, 0, 1, "Doe, John")
ListView_SetItemText(hListView, 0, 2, "(000) 000-0000")
ListView_SetItemText(hListView, 0, 3, "No name")
ListView_SetItemText(hListView, 0, 4, "Unknown")
ListView_SetItemText(hListView, 0, 5, "Camaro")
ListView_AddItem(hListView, 1, 0, "2")
ListView_SetItemText(hListView, 1, 1, "Smith, Joe")
ListView_SetItemText(hListView, 1, 2, "(111) 111-1111")
ListView_SetItemText(hListView, 1, 3, "No name")
ListView_SetItemText(hListView, 1, 4, "Unknown")
ListView_SetItemText(hListView, 1, 5, "Wife")
ListView_AddItem(hListView, 2, 0, "3")
ListView_SetItemText(hListView, 2, 1, "James, Jessie")
ListView_SetItemText(hListView, 2, 2, "(232) 999-2345")
ListView_SetItemText(hListView, 2, 3, "Victory Place")
ListView_SetItemText(hListView, 2, 4, "Unknown")
ListView_SetItemText(hListView, 2, 5, "R400XP")
ListView_AddItem(hListView, 3, 0, "4")
ListView_SetItemText(hListView, 3, 1, "Paula Vibes")
ListView_SetItemText(hListView, 3, 2, "(542) 123-4556")
ListView_SetItemText(hListView, 3, 3, "Berliner Platz 100")
ListView_SetItemText(hListView, 3, 4, "Known")
ListView_SetItemText(hListView, 3, 5, "Alicia Keys")
ListView_AddItem(hListView, 4, 0, "5")
ListView_SetItemText(hListView, 4, 1, "Tanja Rüscher")
ListView_SetItemText(hListView, 4, 2, "(2542) 654-45-45656")
ListView_SetItemText(hListView, 4, 3, "Sommerallee 1001")
ListView_SetItemText(hListView, 4, 4, "Known")
ListView_SetItemText(hListView, 4, 5, "Horse with no name")
' ... add more data
' // Force the resizing of the ListView by sending a WM_SIZE message
SendMessage hwnd, %WM_SIZE, 0, 0
' // Default message pump (you can replace it with your own)
pWindow.DoEvents
END FUNCTION
' ########################################################################################
' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL rc AS RECT
SELECT CASE uMsg
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE %WM_SIZE
' // Resize the ListView control
IF wParam <> %SIZE_MINIMIZED THEN
GetClientRect hwnd, rc
MoveWindow GetDlgItem(hwnd, %IDC_LISTVIEW), 2, 2, rc.nRight - rc.nLeft + 160, rc.nBottom - rc.nTop + 160, %TRUE
END IF
CASE %WM_DESTROY
' // Close the main window
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Processes messages for the subclassed ListView header control.
' ========================================================================================
FUNCTION ListViewHeader_SubclassProc ( _
BYVAL hwnd AS DWORD, _ ' // Control window handle
BYVAL uMsg AS DWORD, _ ' // Type of message
BYVAL wParam AS DWORD, _ ' // First message parameter
BYVAL lParam AS LONG _ ' // Second message parameter
) AS LONG
' // REQUIRED: Get the address of the original window procedure
LOCAL pOldWndProc AS DWORD
pOldWndProc = GetProp(hwnd, "OLDWNDPROC")
SELECT CASE uMsg
CASE %WM_DESTROY
' // REQUIRED: Remove control subclassing
SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")
CASE %HDM_LAYOUT
' // Fill the WINDOWPOS structure with the appropriate size and position of the
' // header control and change the top position of the rectangle that the header
' // control will occupy.
LOCAL phdl AS HDLAYOUT PTR
phdl = lParam
@phdl.@pwpos.hwnd = hwnd
@phdl.@pwpos.flags = %SWP_FRAMECHANGED
@phdl.@pwpos.x = @phdl.@prc.nLeft
@phdl.@pwpos.y = 0
@phdl.@pwpos.cx = @phdl.@prc.nRight-80 - @phdl.@prc.nLeft-80
@phdl.@pwpos.cy = 60'40 ' --> change me
@phdl.@prc.nTop = 60'40 ' --> change me
FUNCTION = -1
EXIT FUNCTION
END SELECT
FUNCTION = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Processes messages for the subclassed ListView control.
' ========================================================================================
FUNCTION ListView_SubclassProc ( _
BYVAL hwnd AS DWORD, _ ' // Control window handle
BYVAL uMsg AS DWORD, _ ' // Type of message
BYVAL wParam AS DWORD, _ ' // First message parameter
BYVAL lParam AS LONG _ ' // Second message parameter
) AS LONG
' // REQUIRED: Get the address of the original window procedure
LOCAL pOldWndProc AS DWORD
pOldWndProc = GetProp(hwnd, "OLDWNDPROC")
SELECT CASE uMsg
CASE %WM_DESTROY
' // REQUIRED: Remove control subclassing
SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")
CASE %WM_NOTIFY
LOCAL pnmh AS NMHDR PTR
LOCAL pnmcd AS NMCUSTOMDRAW PTR
LOCAL szText AS ASCIIZ * 260
pnmh = lParam
SELECT CASE @pnmh.code
CASE %NM_CUSTOMDRAW
pnmcd = lParam
' // Check the drawing stage
SELECT CASE @pnmcd.dwDrawStage
' // Prior to painting
CASE %CDDS_PREPAINT
' // Tell Windows we want individual notification of each item being drawn
FUNCTION = %CDRF_NOTIFYITEMDRAW
EXIT FUNCTION
' // Notification of each item being drawn
CASE %CDDS_ITEMPREPAINT
LOCAL hLvHeader AS DWORD
LOCAL nIndex AS DWORD
LOCAL nState AS DWORD
nIndex = @pnmcd.dwItemSpec
nState = @pnmcd.uItemState
' // Get the header item text...
LOCAL hdi AS HDITEM
hdi.mask = %HDI_TEXT
hdi.psztext = VARPTR(szText)
hdi.cchtextmax = SIZEOF(szText)
hLvHeader = ListView_GetHeader(hwnd)
Header_GetItem(hLvHeader, nIndex, hdi)
' // Create a new font
LOCAL hFont AS DWORD
hFont = API_CreateFont("Trebuchet", 10, %FW_BOLD, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET)
' // Select the font into the current devide context
LOCAL hOldFont AS DWORD
hOldFont = SelectObject(@pnmcd.hdc, hFont)
' // Draw the button state...
IF (nState AND %CDIS_SELECTED) THEN
DrawFrameControl @pnmcd.hdc, @pnmcd.rc, %DFC_BUTTON, %DFCS_BUTTONPUSH OR %DFCS_PUSHED
ELSE
DrawFrameControl @pnmcd.hdc, @pnmcd.rc, %DFC_BUTTON, %DFCS_BUTTONPUSH
END IF
' // Paint the background
LOCAL hBrush AS DWORD
hBrush = CreateSolidBrush(RGB(200,168,255))'- (228,120,51))
InflateRect @pnmcd.rc, -2, -2
FillRect @pnmcd.hdc, @pnmcd.rc, hBrush
SetBkMode @pnmcd.hdc, %TRANSPARENT
' // Change your text color here...
SetTextColor @pnmcd.hdc, RGB(192,60,140) 'RGB(92,51,23)
' // Offset the text slightly if depressed...
IF (nState AND %CDIS_SELECTED) THEN InflateRect @pnmcd.rc, -2, -2
' // Draw multiline, using CRLF (i.e. szText = "Customer" & $CRLF & "number")
DrawText @pnmcd.hdc, szText, LEN(szText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER 'OR %DT_WORDBREAK
' // Draw multiline using word wrap (i.e. szText = "Customer number")
'DrawText @pnmcd.hdc, szText, LEN(szText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER OR %DT_WORDBREAK
' // Sraw single line with ellipsis... (i.e. szText = "Customer number")
'DrawText @pnmcd.hdc, szText, LEN(szText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER OR %DT_END_ELLIPSIS
' // Cleanup
IF hBrush THEN DeleteObject hBrush
IF hOldFont THEN SelectObject @pnmcd.hdc, hOldFont
IF hFont THEN DeleteObject hFont
' // Tell Windows the item has already been drawn
FUNCTION = %CDRF_SKIPDEFAULT
EXIT FUNCTION
END SELECT
END SELECT
END SELECT
FUNCTION = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
thanks, nice evening, frank
Quote
a) well, but where do you define exactly the pwindow size of this listview example? for my example there needed some size to right direction I suppose
Here:
hwnd = pWindow.CreateWindow(%NULL, "Multiline Header ListView", 0, 0, 640, 350, -1, -1, CODEPTR(WindowProc))
640 is the width and 350 the height.
Quote
b) how to change the background and text color of
This will change the colors of the entire ListView.
ListView_SetBkColor(hListView, %BLUE)
ListView_SetTextColor(hListView, %RED)
it's sometime stressy to work with my old notebook (little display) and tired eyes, so I need sometimes thicker glasses or throwing away all tomatoes in front of my head to see what I needed ;) I overseen the "pwindow.CreateWindow" line. It's some kind of "blue munday" for me today. thanks for your fast help josé.
all works fine here at all with coloured text and background.
servus, frank
Hello all
where can i get WinUtils.inc as in post #1 has that in the code ?
i need to be able to compile this program.
Thet is old code for PBWin 9. Anyway, from WinUtils.inc you only need the API_CreateFont function, that I have added.
' ########################################################################################
' Mutiline header ListView example
' The technique used is to process the HDM_LAYOUT message, fill the WINDOWPOS structure
' with the appropriate size and position of the header control, and change the top position
' of the rectangle that the header control will occupy.
' CASE %HDM_LAYOUT
' LOCAL phdl AS HDLAYOUT PTR
' phdl = lParam
' @phdl.@pwpos.hwnd = hwnd
' @phdl.@pwpos.flags = %SWP_FRAMECHANGED
' @phdl.@pwpos.x = @phdl.@prc.nLeft
' @phdl.@pwpos.y = 0
' @phdl.@pwpos.cx = @phdl.@prc.nRight - @phdl.@prc.nLeft
' @phdl.@pwpos.cy = 40 ' --> change me
' @phdl.@prc.nTop = 40 ' --> change me
' FUNCTION = -1
' EXIT FUNCTION
' ########################################################################################
#COMPILE EXE
#DIM ALL
%USEMACROS = 1 ' // Use macros
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "ListViewCtrl.inc" ' // ListView control wrapper functions
#INCLUDE ONCE "HeaderCtrl.inc" ' // Header control wrapper functions
'#INCLUDE ONCE "WinUtils.inc" ' // Miscellaneous wrapper functions
%IDC_LISTVIEW = 101
' ========================================================================================
' Creates a logical font.
' Examples of Use:
' hFont = API_CreateFont("MS Sans Serif", 8, %FW_NORMAL, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET)
' hFont = API_CreateFont("Courier New", 10, %FW_BOLD, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET)
' hFont = API_CreateFont("Marlett", 8, %FW_NORMAL, %FALSE, %FALSE, %FALSE, %SYMBOL_CHARSET)
' Note: Any font created with API_CreateFont must be destroyed with DeleteObject when no
' longer needed to prevent memory leaks.
' ========================================================================================
#IF %DEF(%USEMACROS)
MACRO FUNCTION API_CreateFont (sFaceName, lPointSize, lWeight, bItalic, bUnderline, bStrikeOut, bCharSet)
MACROTEMP tlf, hDC, szFaceName
LOCAL tlf AS LOGFONT
LOCAL hDC AS DWORD
LOCAL szFaceName AS ASCIIZ * 256
szFaceName = sFaceName
hDC = GetDC(%HWND_DESKTOP)
tlf.lfHeight = -MulDiv(lPointSize, GetDeviceCaps(hDC, %LOGPIXELSY), 72) ' logical font height
tlf.lfWidth = 0 ' average character width
tlf.lfEscapement = 0 ' escapement
tlf.lfOrientation = 0 ' orientation angles
tlf.lfWeight = lWeight ' font weight
tlf.lfItalic = bItalic ' italic(TRUE/FALSE)
tlf.lfUnderline = bUnderline ' underline(TRUE/FALSE)
tlf.lfStrikeOut = bStrikeOut ' strikeout(TRUE/FALSE)
tlf.lfCharSet = bCharset ' character set
tlf.lfOutPrecision = %OUT_TT_PRECIS ' output precision
tlf.lfClipPrecision = %CLIP_DEFAULT_PRECIS ' clipping precision
tlf.lfQuality = %DEFAULT_QUALITY ' output quality
tlf.lfPitchAndFamily = %FF_DONTCARE ' pitch and family
tlf.lfFaceName = szFaceName ' typeface name
ReleaseDC %HWND_DESKTOP, hDC
END MACRO = CreateFontIndirect(tlf)
#ELSE
FUNCTION API_CreateFont ( _
BYREF szFaceName AS ASCIIZ, _ ' __in Typeface name of font
BYVAL lPointSize AS LONG, _ ' __in Point size
BYVAL lWeight AS LONG, _ ' __in Font weight(bold etc.)
BYVAL bItalic AS BYTE, _ ' __in TRUE = italic
BYVAL bUnderline AS BYTE, _ ' __in TRUE = underline
BYVAL bStrikeOut AS BYTE, _ ' __in TRUE = strikeout
BYVAL bCharSet AS BYTE _ ' __in character set
) AS DWORD ' Handle of font or NULL on failure.
LOCAL tlf AS LOGFONT
LOCAL hDC AS DWORD
hDC = GetDC(%HWND_DESKTOP)
tlf.lfHeight = -MulDiv(lPointSize, GetDeviceCaps(hDC, %LOGPIXELSY), 72) ' logical font height
tlf.lfWidth = 0 ' average character width
tlf.lfEscapement = 0 ' escapement
tlf.lfOrientation = 0 ' orientation angles
tlf.lfWeight = lWeight ' font weight
tlf.lfItalic = bItalic ' italic(TRUE/FALSE)
tlf.lfUnderline = bUnderline ' underline(TRUE/FALSE)
tlf.lfStrikeOut = bStrikeOut ' strikeout(TRUE/FALSE)
tlf.lfCharSet = bCharset ' character set
tlf.lfOutPrecision = %OUT_TT_PRECIS ' output precision
tlf.lfClipPrecision = %CLIP_DEFAULT_PRECIS ' clipping precision
tlf.lfQuality = %DEFAULT_QUALITY ' output quality
tlf.lfPitchAndFamily = %FF_DONTCARE ' pitch and family
tlf.lfFaceName = szFaceName ' typeface name
ReleaseDC %HWND_DESKTOP, hDC
FUNCTION = CreateFontIndirect(tlf)
END FUNCTION
#ENDIF
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
LOCAL hwnd AS DWORD
hwnd = pWindow.CreateWindow(%NULL, "Multiline Header ListView", 0, 0, 640, 350, -1, -1, CODEPTR(WindowProc))
' // Add a subclassed ListView control
LOCAL hListView AS DWORD
LOCAL rc AS RECT
GetClientRect hwnd, rc
LOCAL dwStyle AS DWORD
dwStyle = %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT OR %LVS_SINGLESEL OR %LVS_SHOWSELALWAYS
hListView = pWindow.AddListView(hwnd, %IDC_LISTVIEW, "", 0, 0, 0, 0, dwStyle, -1, CODEPTR(ListView_SubclassProc))
' // Add some extended styles
LOCAL dwExStyle AS DWORD
dwExStyle = ListView_GetExtendedListViewStyle(hListView)
dwExStyle = dwExStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES
ListView_SetExtendedListViewStyle(hListView, dwExStyle)
' // Get the handle of the ListView header control and subclass it
LOCAL hLvHeader AS DWORD
hLvHeader = ListView_GetHeader(hListView)
IF hLvHeader THEN SetProp hLvHeader, "OLDWNDPROC", SetWindowLong(hLvHeader, %GWL_WNDPROC, CODEPTR(ListViewHeader_SubclassProc))
' // Add the header's column names
ListView_AddColumn(hListView, 0, "Customer" & $CRLF & "number", 80, 1)
ListView_AddColumn(hListView, 1, "Name" & $CRLF & "First, last", 160, 0)
ListView_AddColumn(hListView, 2, "Telephone" & $CRLF & "number", 160, 0)
ListView_AddColumn(hListView, 3, "Street" & $CRLF & "address", 80, 0)
ListView_AddColumn(hListView, 4, "Action" & $CRLF & "items", 80, 1)
ListView_AddColumn(hListView, 5, "Hobby" & $CRLF & "Kind-of", 80, 0)
' // Populate the ListView with some data
ListView_AddItem(hListView, 0, 0, "1")
ListView_SetItemText(hListView, 0, 1, "Doe, John")
ListView_SetItemText(hListView, 0, 2, "(000) 000-0000")
ListView_SetItemText(hListView, 0, 3, "No name")
ListView_SetItemText(hListView, 0, 4, "Unknown")
ListView_SetItemText(hListView, 0, 5, "Camaro")
ListView_AddItem(hListView, 1, 0, "2")
ListView_SetItemText(hListView, 1, 1, "Smith, Joe")
ListView_SetItemText(hListView, 1, 2, "(111) 111-1111")
ListView_SetItemText(hListView, 1, 3, "No name")
ListView_SetItemText(hListView, 1, 4, "Unknown")
ListView_SetItemText(hListView, 1, 5, "Wife")
ListView_AddItem(hListView, 2, 0, "3")
ListView_SetItemText(hListView, 2, 1, "James, Jessie")
ListView_SetItemText(hListView, 2, 2, "(232) 999-2345")
ListView_SetItemText(hListView, 2, 3, "Victory Place")
ListView_SetItemText(hListView, 2, 4, "Unknown")
ListView_SetItemText(hListView, 2, 5, "R400XP")
ListView_AddItem(hListView, 3, 0, "4")
ListView_SetItemText(hListView, 3, 1, "Paula Vibes")
ListView_SetItemText(hListView, 3, 2, "(542) 123-4556")
ListView_SetItemText(hListView, 3, 3, "Berliner Platz 100")
ListView_SetItemText(hListView, 3, 4, "Known")
ListView_SetItemText(hListView, 3, 5, "Alicia Keys")
ListView_AddItem(hListView, 4, 0, "5")
ListView_SetItemText(hListView, 4, 1, "Tanja Rüscher")
ListView_SetItemText(hListView, 4, 2, "(2542) 654-45-45656")
ListView_SetItemText(hListView, 4, 3, "Sommerallee 1001")
ListView_SetItemText(hListView, 4, 4, "Known")
ListView_SetItemText(hListView, 4, 5, "Horse with no name")
' ... add more data
' // Force the resizing of the ListView by sending a WM_SIZE message
SendMessage hwnd, %WM_SIZE, 0, 0
' // Default message pump (you can replace it with your own)
pWindow.DoEvents
END FUNCTION
' ########################################################################################
' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL rc AS RECT
SELECT CASE uMsg
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE %WM_SIZE
' // Resize the ListView control
IF wParam <> %SIZE_MINIMIZED THEN
GetClientRect hwnd, rc
MoveWindow GetDlgItem(hwnd, %IDC_LISTVIEW), 2, 2, rc.nRight - rc.nLeft + 160, rc.nBottom - rc.nTop + 160, %TRUE
END IF
CASE %WM_DESTROY
' // Close the main window
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Processes messages for the subclassed ListView header control.
' ========================================================================================
FUNCTION ListViewHeader_SubclassProc ( _
BYVAL hwnd AS DWORD, _ ' // Control window handle
BYVAL uMsg AS DWORD, _ ' // Type of message
BYVAL wParam AS DWORD, _ ' // First message parameter
BYVAL lParam AS LONG _ ' // Second message parameter
) AS LONG
' // REQUIRED: Get the address of the original window procedure
LOCAL pOldWndProc AS DWORD
pOldWndProc = GetProp(hwnd, "OLDWNDPROC")
SELECT CASE uMsg
CASE %WM_DESTROY
' // REQUIRED: Remove control subclassing
SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")
CASE %HDM_LAYOUT
' // Fill the WINDOWPOS structure with the appropriate size and position of the
' // header control and change the top position of the rectangle that the header
' // control will occupy.
LOCAL phdl AS HDLAYOUT PTR
phdl = lParam
@phdl.@pwpos.hwnd = hwnd
@phdl.@pwpos.flags = %SWP_FRAMECHANGED
@phdl.@pwpos.x = @phdl.@prc.nLeft
@phdl.@pwpos.y = 0
@phdl.@pwpos.cx = @phdl.@prc.nRight-80 - @phdl.@prc.nLeft-80
@phdl.@pwpos.cy = 60'40 ' --> change me
@phdl.@prc.nTop = 60'40 ' --> change me
FUNCTION = -1
EXIT FUNCTION
END SELECT
FUNCTION = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Processes messages for the subclassed ListView control.
' ========================================================================================
FUNCTION ListView_SubclassProc ( _
BYVAL hwnd AS DWORD, _ ' // Control window handle
BYVAL uMsg AS DWORD, _ ' // Type of message
BYVAL wParam AS DWORD, _ ' // First message parameter
BYVAL lParam AS LONG _ ' // Second message parameter
) AS LONG
' // REQUIRED: Get the address of the original window procedure
LOCAL pOldWndProc AS DWORD
pOldWndProc = GetProp(hwnd, "OLDWNDPROC")
SELECT CASE uMsg
CASE %WM_DESTROY
' // REQUIRED: Remove control subclassing
SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")
CASE %WM_NOTIFY
LOCAL pnmh AS NMHDR PTR
LOCAL pnmcd AS NMCUSTOMDRAW PTR
LOCAL szText AS ASCIIZ * 260
pnmh = lParam
SELECT CASE @pnmh.code
CASE %NM_CUSTOMDRAW
pnmcd = lParam
' // Check the drawing stage
SELECT CASE @pnmcd.dwDrawStage
' // Prior to painting
CASE %CDDS_PREPAINT
' // Tell Windows we want individual notification of each item being drawn
FUNCTION = %CDRF_NOTIFYITEMDRAW
EXIT FUNCTION
' // Notification of each item being drawn
CASE %CDDS_ITEMPREPAINT
LOCAL hLvHeader AS DWORD
LOCAL nIndex AS DWORD
LOCAL nState AS DWORD
nIndex = @pnmcd.dwItemSpec
nState = @pnmcd.uItemState
' // Get the header item text...
LOCAL hdi AS HDITEM
hdi.mask = %HDI_TEXT
hdi.psztext = VARPTR(szText)
hdi.cchtextmax = SIZEOF(szText)
hLvHeader = ListView_GetHeader(hwnd)
Header_GetItem(hLvHeader, nIndex, hdi)
' // Create a new font
LOCAL hFont AS DWORD
hFont = API_CreateFont("Trebuchet", 10, %FW_BOLD, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET)
' // Select the font into the current devide context
LOCAL hOldFont AS DWORD
hOldFont = SelectObject(@pnmcd.hdc, hFont)
' // Draw the button state...
IF (nState AND %CDIS_SELECTED) THEN
DrawFrameControl @pnmcd.hdc, @pnmcd.rc, %DFC_BUTTON, %DFCS_BUTTONPUSH OR %DFCS_PUSHED
ELSE
DrawFrameControl @pnmcd.hdc, @pnmcd.rc, %DFC_BUTTON, %DFCS_BUTTONPUSH
END IF
' // Paint the background
LOCAL hBrush AS DWORD
hBrush = CreateSolidBrush(RGB(200,168,255))'- (228,120,51))
InflateRect @pnmcd.rc, -2, -2
FillRect @pnmcd.hdc, @pnmcd.rc, hBrush
SetBkMode @pnmcd.hdc, %TRANSPARENT
' // Change your text color here...
SetTextColor @pnmcd.hdc, RGB(192,60,140) 'RGB(92,51,23)
' // Offset the text slightly if depressed...
IF (nState AND %CDIS_SELECTED) THEN InflateRect @pnmcd.rc, -2, -2
' // Draw multiline, using CRLF (i.e. szText = "Customer" & $CRLF & "number")
DrawText @pnmcd.hdc, szText, LEN(szText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER 'OR %DT_WORDBREAK
' // Draw multiline using word wrap (i.e. szText = "Customer number")
'DrawText @pnmcd.hdc, szText, LEN(szText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER OR %DT_WORDBREAK
' // Sraw single line with ellipsis... (i.e. szText = "Customer number")
'DrawText @pnmcd.hdc, szText, LEN(szText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER OR %DT_END_ELLIPSIS
' // Cleanup
IF hBrush THEN DeleteObject hBrush
IF hOldFont THEN SelectObject @pnmcd.hdc, hOldFont
IF hFont THEN DeleteObject hFont
' // Tell Windows the item has already been drawn
FUNCTION = %CDRF_SKIPDEFAULT
EXIT FUNCTION
END SELECT
END SELECT
END SELECT
FUNCTION = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Thanxx a lot Jose
Hello Jose
this is a very good program, but sadly it is written in PB.
anychance of converting it to O2 ?
No, I still don't have practice with O2.
Sounds like a good excuse. (for the time being) ;D