question to multiline listview

[Frank Brübach]

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  
   

ListView_AddItem(hListView, 0, 0, "1")
  ListView_SetItemText(hListView, 0, 1, "Doe, John") ?

Code Select Expand

' ########################################################################################
' 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

[José Roca]

 

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:

Code Select Expand


hwnd = pWindow.CreateWindow(%NULL, "Multiline Header ListView", 0, 0, 640, 350, -1, -1, CODEPTR(WindowProc))


640 is the width and 350 the height.

b) how to change the background and text color of  

This will change the colors of the entire ListView.

Code Select Expand


  ListView_SetBkColor(hListView, %BLUE)
  ListView_SetTextColor(hListView, %RED)


[Frank Brübach]

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

[Chris Chancellor]

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.

[José Roca]

Thet is old code for PBWin 9. Anyway, from WinUtils.inc you only need the API_CreateFont function, that I have added.

Code Select Expand


' ########################################################################################
' 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
' ========================================================================================


[Chris Chancellor]

Thanxx a lot Jose

[Chris Chancellor]

Hello Jose

this is a very good program, but sadly it is written in PB.

anychance of converting it to O2 ?

[José Roca]

No, I still don't have practice with O2.

[Mike Lobanovsky]

Sounds like a good excuse. (for the time being)