Announcement

**Borje Hagsten** · 2 May 2001, 02:39 PM

Never tried that one myself, but should be the same as trapping
lParam in WM_MEASUREITEM into a MEASUREITEMSTRUCT ptr and set the
itemHeight member to appropriate height + return %TRUE? Sounds too
easy - must be a catch somewhere. I'll see if I can try it later
on tonight.

------------------

**Semen Matusovski** · 2 May 2001, 02:56 PM

Borje --
I am sure that this is easy and theoretically I know how to do it
Mostly interesting to test a speed. The biggest "grid" includes about 20000 lines.
BTW - resizing - I made with BeginPaint.

PS. I wrote a test (exactly reconstructed another).
Speed is not bad on my PC (P-III-800, Win2000).

Code:

  #Compile Exe
  #Dim All
  #Register None
  #Include "WIN32API.INC"
  %ID_LIST1 = 101
  %mEl = 10000
  CallBack Function DlgProc
     Dim nEl As Static Long, hList As Long, i As Long
     Select Case CbMsg
        Case %WM_INITDIALOG
           Control Handle CbHndl, %ID_LIST1 To hList
           Dim arr(%mEl - 1) As Static String
           i = 50
           For nEl = 1 To %mEl
              i = i + 10: If i > 200 Then i = 50
              arr(nEl - 1) = "Item" + Str$(nEl) + " Height =" + Str$(i)
              SendMessage hList, %LB_ADDSTRING, nEl - 1, 0
              SendMessage hList, %LB_SETITEMHEIGHT, nEl - 1, i
           Next
           UpdateWindow hList
         Case %WM_DRAWITEM
            Local lpdis As DRAWITEMSTRUCT Ptr
            lpdis = CbLparam
            If @lpdis.itemID = &HFFFFFFFF Then Exit Function
            If IsFalse(@lpdis.itemState And %ODS_SELECTED) Then
               FillRect @lpdis.hDC, @lpdis.rcItem, GetStockObject(%WHITE_BRUSH)
               SetBkColor @lpdis.hDC, %WHITE
               SetTextColor @lpdis.hDC, %BLACK
               '     hOldPen = SelectObject(hDC, CreatePen(%PS_SOLID, 1, c1))
               MoveToEx @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nBottom - 1, ByVal %NULL
               LineTo @lpdis.hDC, @lpdis.rcItem.nRight, @lpdis.rcItem.nBottom - 1

            Else
               FillRect @lpdis.hDC, @lpdis.rcItem, GetStockObject(%BLACK_BRUSH)
               SetBkColor @lpdis.hDC, %BLACK
               SetTextColor @lpdis.hDC, %WHITE
            End If
            i = @lpdis.itemID
            TextOut @lpdis.hDC, 0, @lpdis.rcItem.ntop, ByVal StrPtr(arr(i)), Len(arr(i))
            Function = 1: Exit Function
      End Select
   End Function
  Function PbMain
     Local hDlg As Long
     Dialog New 0, "Test", , , 300, 200, %WS_CAPTION Or %WS_SYSMENU To hDlg
     Control Add ListBox, hDlg, %ID_LIST1, , 5, 5, 280, 190, _
        %WS_CHILD Or %LBS_OWNERDRAWVARIABLE Or _
        %WS_TABSTOP Or %LBS_DISABLENOSCROLL Or %WS_VSCROLL, %WS_EX_CLIENTEDGE
     Dialog Show Modal hDlg, Call DlgProc
  End Function

------------------
E-MAIL: [email protected]

[This message has been edited by Semen Matusovski (edited May 02, 2001).]

**Borje Hagsten** · 2 May 2001, 03:58 PM

Semen, just tested some. Not possible in DDT, but no problems in SDK
style dialog. Seems DDT engine eats up %WM_MEASUREITEM. Following
in SDK dialog doubles every other item's height, as example.
Interesting to see - many possibilities..

Code:

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Simple SDK-style template
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
#COMPILE EXE
#INCLUDE "WIN32API.INC"
 
GLOBAL hInst AS LONG  'instance handle
GLOBAL hBtn1 AS LONG  'OK button
GLOBAL hBtn2 AS LONG  'Exit button
GLOBAL hList AS LONG  'Lisbox handle
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main entrance
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION WINMAIN (BYVAL hInstance AS LONG, BYVAL hPrevInstance AS LONG, _
                  lpCmdLine       AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG
 
  LOCAL Msg         AS tagMsg
  LOCAL szAppName   AS ASCIIZ * 50
  LOCAL hWnd        AS LONG
  LOCAL wndclass    AS WndClassEx
  LOCAL rc          AS RECT
 
  hInst                  = hInstance
  szAppName              = "MYPROG"
  wndclass.cbSize        = SIZEOF(WndClass)
  wndclass.style         = %CS_HREDRAW OR %CS_VREDRAW
  wndclass.lpfnWndProc   = CODEPTR( WndProc )
  wndclass.hInstance     = hInstance
  wndclass.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
  wndclass.hbrBackground = GetStockObject(%LTGRAY_BRUSH)
  wndclass.lpszClassName = VARPTR( szAppName )
 
  IF registerClassEx(wndclass) = 0 THEN EXIT FUNCTION 'what else to do..?
 
  SystemParametersInfo %SPI_GETWORKAREA, BYVAL 0, VARPTR(rc), 0 'for centering on screen
 
  'Create a window using the registered class
  hWnd = CreateWindow(szAppName, _                           ' window class name
                      "LBS_OWNERDRAWVARIABLE test", _        ' window caption
                      %WS_CAPTION OR %WS_SYSMENU, _          ' window style
                      ((rc.nRight - rc.nLeft) - 300) / 2, _  ' initial x position
                      ((rc.nBottom - rc.nTop) - 200) / 2, _  ' initial y position
                      300, _                                 ' initial x size
                      200,_                                  ' initial y size
                      %NULL, _                               ' parent window handle
                      %NULL, _                               ' window menu handle
                      hInstance, _                           ' program instance handle
                      BYVAL %NULL)                           ' creation parameters
 
  'Display the window on the screen
  ShowWindow hWnd, iCmdShow : UpdateWindow hWnd
 
  'Main message loop:
  WHILE GetMessage(Msg, %NULL, 0, 0)
     TranslateMessage Msg
     DispatchMessage Msg
  Wend
 
  FUNCTION = msg.wParam
END FUNCTION
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main dialog procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
 
  SELECT CASE wMsg
    CASE %WM_CREATE
       LOCAL I AS LONG, style AS LONG,  zTxt AS ASCIIZ * %MAX_PATH
 
       style = %WS_CHILD OR %LBS_OWNERDRAWVARIABLE OR %LBS_HASSTRINGS OR %WS_TABSTOP OR %WS_VISIBLE
       hList = CreateWindowEx(%WS_EX_CLIENTEDGE, "LISTBOX", BYVAL 0, style, _
                              8, 8, 278, 120, hwnd, 100, hInst, BYVAL %NULL)
 
       FOR I = 0 TO 200
          IF I MOD 2 = 0 THEN
             zTxt = "Line" + STR$(I) & " is a bit long and will wrap against right border of list"
             SendMessage hList, %LB_ADDSTRING, 0, BYVAL VARPTR(zTxt)
          ELSE
             zTxt = "Line" + STR$(I)
             SendMessage hList, %LB_ADDSTRING, 0, BYVAL VARPTR(zTxt)
          END IF
       NEXT
 
       style = %BS_PUSHBUTTON + %WS_CHILD + %WS_VISIBLE + %WS_TABSTOP
       hBtn1 = CreateWindow("BUTTON", "&OK", style, 70, 140, 80, 22, hwnd, 101, hInst, %NULL)
       hBtn2 = CreateWindow("BUTTON", "E&xit", style, 150, 140, 80, 22, hwnd, 102, hInst, %NULL)
       SendMessage hwnd, %WM_SETFOCUS, 101, 0
 
     CASE %WM_COMMAND
        IF wParam = 101 THEN
           I = SendMessage(hList, %LB_GETCURSEL, 0, 0)
           CALL SendMessage(hList, %LB_GETTEXT, I, VARPTR(zTxt)) 'Get text
           MSGBOX zTxt
 
        ELSEIF wParam = 102 THEN
           SendMessage hWnd, %WM_CLOSE, wParam, lParam
 
        END IF
 
     CASE %WM_MEASUREITEM
        LOCAL lpmis AS MEASUREITEMSTRUCT PTR
        lpmis = lParam
        IF @lpmis.itemID MOD 2 = 0 THEN @lpmis.itemHeight = @lpmis.itemHeight * 2
        FUNCTION = %TRUE : EXIT FUNCTION
 
     CASE %WM_DRAWITEM
        LOCAL hBrush AS LONG, hBrushOld AS LONG, rct AS RECT, lpdis AS DRAWITEMSTRUCT PTR
        lpdis = lParam
        IF @lpdis.itemID = -1 THEN EXIT FUNCTION
 
        SELECT CASE @lpdis.itemAction
           CASE %ODA_DRAWENTIRE, %ODA_SELECT
              'CLEAR BACKGROUND
              hBrush = CreateSolidBrush(GetSysColor(%COLOR_INFOBK)) 'Create a background brush
              hBrushOld = SelectObject(@lpdis.hDC, hBrush)      'Select brush into device context
              CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush)  'Paint background color rectangle
              CALL SelectObject(@lpdis.hDC, hBrushOld)          'Select old brush back
              CALL DeleteObject(hBrush)                         'Delete brush
 
              'DRAW TEXT
              CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_INFOBK))           'Set text Background
              CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_INFOTEXT))       'Set text color
              CALL SendMessage(hList, %LB_GETTEXT, @lpdis.itemID, VARPTR(zTxt)) 'Get text to paint
              CALL DrawText(@lpdis.hDC, zTxt, LEN(zTxt), @lpdis.rcItem, _
                            %DT_EXPANDTABS OR %DT_NOPREFIX OR %DT_WORDBREAK)
 
              'SELECTED ITEM
              IF (@lpdis.itemState AND %ODS_SELECTED) THEN      'if selected
                 CALL InvertRect(@lpdis.hDC, @lpdis.rcItem)     'invert area around text only
              END IF
              FUNCTION = %TRUE : EXIT FUNCTION
 
           CASE %ODA_FOCUS
              CALL DrawFocusRect(@lpdis.hDC, @lpdis.rcItem) 'draw focus rectangle
              FUNCTION = %TRUE : EXIT FUNCTION
 
        END SELECT
 
     CASE %WM_DESTROY
        PostQuitMessage 0
        FUNCTION = 0 : EXIT FUNCTION
 
  END SELECT
  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION

------------------
Forgot to return true if in focus - now fixed..

[This message has been edited by Borje Hagsten (edited May 03, 2001).]

**Semen Matusovski** · 2 May 2001, 04:05 PM

Borje --
Posted own sample and noticed your.
What do you think about my LB_SETITEMHEIGHT ?
In real app my "grids" will be fixed similar like in sample:
a list of railways stations, a list of cargoes (NHM) and so on.
I know a "height" from the begining.

PS. Tomorrow plan to try to draw 3d column (order no.), similar like VB MSFlexGrid.
A little afraid that it's possible to decrease a speed. Maybe not.

[This message has been edited by Semen Matusovski (edited May 02, 2001).]

**Borje Hagsten** · 2 May 2001, 05:39 PM

Yes, that seems to be the way to do it in DDT. Replace TextOut with:

Code:

            InflateRect @lpdis.rcItem, -4, -4  '<- need to make rect a bit smaller if to draw on 3D borders..
            SetBkMode @lpdis.hDC, %TRANSPARENT '<- this one if to draw text on 3D "button" borders..
            CALL DrawText(@lpdis.hDC, BYVAL STRPTR(arr(i)), LEN(arr(i)), @lpdis.rcItem, _
                            %DT_EXPANDTABS OR %DT_NOPREFIX OR %DT_WORDBREAK)

and it will wrap text against right border. If to draw 3D items,
DrawFrameControl provides some nice effects. Replace FillRect with:

Code:

            IF ISFALSE(@lpdis.itemState AND %ODS_SELECTED) THEN
               CALL DrawFrameControl(@lpdis.hDC, @lpdis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH)
            ELSE

------------------

[This message has been edited by Borje Hagsten (edited May 02, 2001).]

**Semen Matusovski** · 3 May 2001, 12:06 AM

Borje --
Thanks for advices. I already tested left column.
Speed is normal (on my PC )

Two new "problems" (I didn't think yet, first of all, it's necessary to use not-own experience).

1) Redrawing - small flickering in left column (white -> gray) .

I beleive this is because Windows "asks" step by step and begin to draw, when bottom elements are not ready yet.
SETREDRAW ? But when to release ?
Maybe to draw "somehow" on memory DC and then to copy all ?
Or during redrawing first item of page to fill whole left column by gray color ?

2) Top line (titles). Separate control ? Not nice.

[This message has been edited by Semen Matusovski (edited May 03, 2001).]

**Borje Hagsten** · 3 May 2001, 02:06 AM

If to trap %WM_CTLCOLORLISTBOX, flicker is much less. Could do custom
drawing in list there. Think easiest way to do caption is by drawing
in directly on form in for example parent's WM_ERASEBKGNBKD

Code:

' if DrawFrameControl was used to produce 3D items, following removes flicker..
     CASE %WM_CTLCOLORLISTBOX
        FUNCTION = GetSysColorBrush(%COLOR_3DFACE)
        EXIT FUNCTION

Un-interesting sidepoint to all this: I've never really like the standard
listbox. Having done my own from scratch, I have learned a few things about
MS way of doing it - not good. Looks like amateur wrote it.

Relatively slow redraw and still it flickers a lot, plus when you scroll
up/down with arrow keys, selection tend to jump out of control borders.
Plus of course strange 16-bit limit in Win95/98. Like virtual ones better,
instant loading of even a million items and many more possibilities.
New version of VGlist soon ready - with a heap of neat features in it..

------------------

[This message has been edited by Borje Hagsten (edited May 03, 2001).]

**Aldo Cavini** · 3 May 2001, 02:36 AM

a few weeks ago there was a forum on listbox flickers (see http://www.powerbasic.com/support/pb...ead.php?t=3619

the way to completely eliminate it is to return a null_brush on the %wm_ctlcolorlistbox message, and to paint the items foreground and background the same time. the only problem is for that rows of the listbox are not filled. the system to paint that is easy if you use %lbs_ownerdrawfixed; may be you can solve it for %lbs_ownerdrawvariable (the problem is to know how many pixel rows are free).

------------------

**Semen Matusovski** · 6 Sep 2001, 12:40 PM

> The only problem is for that rows of the listbox are not filled. The system to paint that is easy if you use %LBS_OWNERDRAWFIXED; may be you can solve it for %LBS_OWNERDRAWVARIABLE (the problem is to know how many pixel rows are free).

Coming back ... Guys, what do you think about approach, selected in === ?
(I don't see troubles under Win2000).
Didn't test, but guess that the same can be used with Virtual ListView
(not nice effect, if to scroll and there are many rows).

Code:

  #Compile Exe
  #Dim All
  #Register None
  #Include "WIN32API.INC"

  %ID_LIST1 = 101
  %mEl = 100

  CallBack Function DlgProc
     Dim nEl As Long, i As Long, j As Long, lpdis As DRAWITEMSTRUCT Ptr, rc As RECT, tmp As Asciiz * 6
     Static hList As Long, hBrushListF As Long, hBrushListS As Long, hBrushListU As Long, hPenList As Long
     
     Select Case CbMsg
        Case %WM_INITDIALOG
           Control Handle CbHndl, %ID_LIST1 To hList
           Dim arr(%mEl - 1) As Static String
           Randomize GetTickCount
           i = 50
           For nEl = 0 To %mEl - 1
              i = Rnd(1) * 50 + 20
              arr(nEl) = "Height =" + Str$(i)
              SendMessage hList, %LB_ADDSTRING, nEl, 0
              SendMessage hList, %LB_SETITEMHEIGHT, nEl, i
           Next
           UpdateWindow hList
           
           hPenList = CreatePen(%PS_SOLID, 1, %GRAY)
           
           hBrushListF = CreateSolidBrush(&H808080)
           hBrushListS = CreateSolidBrush(&H800000)
           hBrushListU = CreateSolidBrush(&HFFC0FF)
           
        Case %WM_DESTROY
           DeleteObject hPenList
           DeleteObject hBrushListF
           DeleteObject hBrushListU
           DeleteObject hBrushListS
           
        Case %WM_CTLCOLORLISTBOX
           If CbLparam = hList Then Function = GetStockObject(%NULL_BRUSH)
             
        Case %WM_DRAWITEM
           lpdis = CbLparam
           i = @lpdis.itemID: If i = -1 Then Exit Function
           
           '===========================================================
            If i = %mEl - 1 Then
              GetClientRect hList, rc
              rc.nTop = @lpdis.rcItem.nBottom
              FillRect @lpdis.hDC, rc, GetStockObject(%GRAY_BRUSH)
           End If
           '===========================================================
           
           j = @lpdis.rcItem.nRight
           @lpdis.rcItem.nRight = 0.15 * j
           DrawFrameControl @lpdis.hDC, @lpdis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH
           SetBkMode @lpdis.hDC, %TRANSPARENT
           SetTextColor @lpdis.hDC, %BLUE
           
           tmp = Format$(i + 1)
           DrawText @lpdis.hDC, tmp, Len(tmp), @lpdis.rcItem, _
              %DT_SINGLELINE Or %DT_CENTER  Or %DT_VCENTER
           
           @lpdis.rcItem.nLeft = @lpdis.rcItem.nRight
           @lpdis.rcItem.nRight = j
           
           If IsFalse(@lpdis.itemState And %ODS_SELECTED) Then
              FillRect @lpdis.hDC, @lpdis.rcItem, hBrushListU
              SetTextColor @lpdis.hDC, %BLACK
           Else
              FillRect @lpdis.hDC, @lpdis.rcItem, hBrushListS
              SetTextColor @lpdis.hDC, %WHITE
           End If
           SelectObject @lpdis.hDC, hPenList
           MoveToEx @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nBottom - 1, ByVal %NULL
           LineTo @lpdis.hDC, @lpdis.rcItem.nRight, @lpdis.rcItem.nBottom - 1
           InflateRect @lpdis.rcItem, -5, 0
           Call DrawText(@lpdis.hDC, ByVal StrPtr(arr(i)), Len(arr(i)), @lpdis.rcItem, _
              %DT_EXPANDTABS Or %DT_NOPREFIX Or %DT_WORDBREAK Or %DT_VCENTER Or %DT_SINGLELINE)
           Function = 1: Exit Function
      End Select
   End Function
 
   Function PbMain
      Local hDlg As Long
      Dialog New 0, "Test", , , 300, 200, %WS_CAPTION Or %WS_SYSMENU To hDlg
      Control Add ListBox, hDlg, %ID_LIST1, , 5, 5, 280, 190, _
         %WS_CHILD Or %LBS_OWNERDRAWVARIABLE Or _
         %WS_TABSTOP Or %LBS_DISABLENOSCROLL Or %WS_VSCROLL, %WS_EX_CLIENTEDGE
      Dialog Show Modal hDlg, Call DlgProc
   End Function

------------------
E-MAIL: [email protected]

**Borje Hagsten** · 6 Sep 2001, 02:16 PM

Works fine in Win98 too. Nice and simple solution, Semen.

------------------

**Lance Edmonds** · 6 Sep 2001, 04:38 PM

Nice work Semen!

Scrolling long lists makes me a little dizzy though...

When there is 1 item, the background is dark gray, but light gray when there are zero items. Is this what you intended ("disabled" appearance) ?

------------------
Lance
PowerBASIC Support
mailto:[email protected][email protected]</A>

**Edwin Knoppert** · 6 Sep 2001, 11:34 PM

Hey Semen, missed you lately..
Holiday?

Btw,
I make use of 2 additional messages for my drawing.
WM_ERASE..
And WM_PAINT

Code:

    Case %WM_ERASEBKGND

        Call SendMessage( hWnd, %CP_GETBACKCOLOR, 0, ByVal 0& )

        '// Paint the background.
        @DBP.hBrush = CreateSolidBrush( @DBP.cBackColor )
        If @DBP.hBrush Then

            GetClientRect hWnd, R
            FillRect wParam, R, @DBP.hBrush
            DeleteObject @DBP.hBrush

            Function = 1
            Exit Function

        End If

    Case %WM_PAINT


            '// Don't let the background get repainted by it's parent when empty
            a = SendMessage( hWnd, %LB_GETCOUNT, 0, ByVal 0& )
            If a = 0 Then

                BeginPaint hWnd, ps
                EndPaint hWnd, ps

                Function = 0
                Exit Function

            End If

------------------

Announcement

LBS_OWNERDRAWVARIABLE

LBS_OWNERDRAWVARIABLE

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment