Wanted - Properties List control

[Chris Holbrook]

...or information leading to the capture of same, or very strong hints as to how to write one. Any offers?

[Scott Hauser]

http://www.kgpsoftware.com/prpt.htm

[Jules Marchildon]

Chris,

If this is for your designer, look at my QTAB visual designer, it can be found in PB's
download area under tools, look for "Visual Tab Designer".

Another standalone one, or start of one...

http://www.powerbasic.com/support/pbforums/showthread.php?t=22892&highlight=properties+listbox

HTH
Regards,
Jules

[Chris Holbrook]

http://www.powerbasic.com/support/pbforums/showthread.php?t=22892&highlight=properties+listbox

Thanks Jules, I took the liberty of posting a version back to Source Code Forum which compiles under 8.04.

[Chris Holbrook]

Scott, thanks, a) can't afford it b) it would put the rest of my app. to shame!

[Chris Boss]

The easiest way to write a property list control is to:

Superclass

the ListBox control.

Superclassing is a powerful way to create new controls classes. They are based on existing classes, but you can customize them any way you like.

Superclassing also gives you more control than does subclassing, since it allows you to change parameters of the class when registering (ie. extra window bytes).

To give even more power, you can use ownerdraw with the listbox. To do this, create a container window class to hold your property listbox class. In that classes window procedure process all the ownerdraw messages.

[Eros Olmi]

Chris,

If this is for your designer, look at my QTAB visual designer, it can be found in PB's
download area under tools, look for "Visual Tab Designer".

Another standalone one, or start of one...

http://www.powerbasic.com/support/pbforums/showthread.php?t=22892&highlight=properties+listbox

HTH
Regards,
Jules

Joles,

great code! Any chance to have this as stand alone control in order to set it and forget?
I mean, instead using window callback have its own callback procedure?

Thanks a lot
Eros

[Michael Mattias]

Any chance to have this as stand alone control in order to set it and forget?
I mean, instead using window callback have its own callback procedure

Subclass or superclass it yourself? That way you can let the existing code do the 'common' stuff yet still retain the option for application specific behavior.

It's a thought....

MCM

[Eros Olmi]

Yes, you are right. Maybe a good excercise for me to learn something

[Chris Holbrook]

Not having written a control before, I'm making some assumptions and would appreciate feedback before I go wasting aeons writing the wrong code:

• Using Jules Marchildon's code to handle the listbox
• Superclassing the listbox control
• Making storage of the property list items internal to the control's WNDPROC (using globalalloc etc to dynamically allocate storage for properties)
• driving the control with messages:
  • AddProperty
  • DeleteProperty
  • GetProperty (returning pointer to property udt via message to parent)
  • GetPropertyCount (returning count via message to parent)
  • SetProperty

[Eros Olmi]

Chris,

I've never 100% written a control by myself too but I use the following code from Ralph Berger that implements a splitter bar.
It is enough simple and quite well organized that maybe it can help you as general structure.

Your summary seems following the same schema used in the below code.

Ciao
Eros

'------------------------------------------------------------------------
' Module:        SPLITTER.bas
' Author:        Ralph Berger, [EMAIL="[email protected]"][email protected][/EMAIL]
' Creation Date: 07/07/00
' Description:   Implementation of a simple splitter
'                window control (like MFC STATIC CSplitterWnd
'                but WITH only two panes). Pane
'                disposition can be changed AT run-time.
'------------------------------------------------------------------------
'------------------------------------------------------------------------
 
  type SPLITTERINFO_TAG
      swsStyle    as long   '---style of the splitter (SWS_HORIZONTAL OR SWS_VERTICAL)
      hCursor     as long   '---cursor handle
      nSplitPos   as long   '---Position of the split BAR
      hwPane1     as long   '---handles of the pane (view) windows
      hwPane2     as long
      fMovingBar  as long   '---bool
      BarSize     as long
      PaneSizeMin as long
  end type
 
  %SWS_HORIZONTAL = 1
  %SWS_VERTICAL   = 2
 
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ' memory handling functions
 
  function SplitterWnd_GetSplitPos ( hwnd as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    function =  @lpsiInfo.nSplitPos
  end function
 
  function SplitterWnd_IsBarMoving ( hwnd as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    function = @lpsiInfo.fMovingBar
  end function
 
 
  function SplitterWindow_SetStyle (hwnd as long, swsStyle as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    @lpsiInfo.swsStyle = swsStyle
  end function
 
  function SplitterWnd_GetStyle ( byval hwnd as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    function = @lpsiInfo.swsStyle
  end function
 
 
  function SplitterWnd_SetCursor ( hwnd as long, hCursor as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    @lpsiInfo.hCursor = hCursor
  end function
 
 
  function SplitterWnd_GetCursor (hwnd as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    function = @lpsiInfo.hCursor
  end function
 
 
  function SplitterWnd_GetPanes (hwnd as long, hwPane1 as long, hwPane2 as long ) as long
   local lpsiInfo as SPLITTERINFO_TAG ptr
   lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
   hwPane1  = @lpsiInfo.hwPane1
   hwPane2  = @lpsiInfo.hwPane2
  end function
 
 
  function SplitterWnd_SetPanes (byval hwnd as long, byval hwPane1 as long, byval hwPane2 as long ) as long
   local lpsiInfo as SPLITTERINFO_TAG ptr
   local rc as rect
   lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
   getwindowrect hwPane1, rc
 
   @lpsiInfo.hwPane1     = hwPane1
   @lpsiInfo.hwPane2     = hwPane2
   @lpsiInfo.nSplitPos   = rc.nright-rc.nleft
 
   if (GetParent(hwPane1) <> hwnd) then SetParent hwPane1, hwnd
   if (GetParent(hwPane2) <> hwnd) then SetParent hwPane2, hwnd
 
  end function
 
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ' splitter functions
  function SplitterWnd_Redraw ( byval hwnd  as long ) as long
    local nPos     as long
    local hwPane1  as long
    local hwPane2  as long
    local rcClient as RECT
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    nPos = SplitterWnd_GetSplitPos( hwnd )
    SplitterWnd_GetPanes hwnd, hwPane1, hwPane2
    GetClientRect hwnd, rcClient
'      if Options_Get(hwnd, %ArrayOpt_DialogIsPixel) then
'      else
'        dialog pixels hwnd, rcClient.nLEFT, rcClient.ntop to units rcClient.nLEFT, rcClient.ntop
'        dialog pixels hwnd, rcClient.nRIGHT, rcClient.nbottom to units rcClient.nRIGHT, rcClient.nbottom
'      end if
    if SplitterWnd_GetStyle(hwnd) = %SWS_HORIZONTAL then
        MoveWindow hwPane1, 0, 0, rcClient.nright, nPos, %false ''%TRUE
        MoveWindow hwPane2, 0, nPos + @lpsiInfo.BarSize, rcClient.nright, rcClient.nbottom - (nPos + @lpsiInfo.BarSize), %false ''%TRUE
    else '' SWS_VERTICAL
        MoveWindow hwPane1, 0, 0, nPos, rcClient.nbottom, %false ''%TRUE
        MoveWindow hwPane2, nPos + @lpsiInfo.BarSize, 0, rcClient.nright - (nPos + @lpsiInfo.BarSize), rcClient.nbottom, %false ''%TRUE
    end if
    RedrawWindow hWnd, byval %null , %null, %RDW_INVALIDATE or %RDW_ERASE or %RDW_ALLCHILDREN
  end function
 
  function SplitterWnd_SetSplitPos (byval hwnd as long, byval nNewPos as integer ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    local rcClient as rect
    local nPosMax  as integer
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    if nNewPos < @lpsiInfo.PaneSizeMin then
       nNewPos = @lpsiInfo.PaneSizeMin
       exit function
    end if
    GetClientRect hwnd, rcClient
 
    if @lpsiInfo.swsStyle = %SWS_HORIZONTAL then
       nPosMax = rcClient.nbottom - (@lpsiInfo.PaneSizeMin + @lpsiInfo.BarSize)
    else
       nPosMax = rcClient.nright - (@lpsiInfo.PaneSizeMin + @lpsiInfo.BarSize)
    end if
    if nNewPos > nPosMax then nNewPos = nPosMax
    @lpsiInfo.nSplitPos = nNewPos
    SplitterWnd_Redraw hwnd
  end function
 
  function SplitterWnd_SetPercentSplitPos ( byval hwnd as long, byval nPercentPos as integer ) as long
    local rcClient as rect
    GetClientRect hwnd, rcClient
    if SplitterWnd_GetStyle( hwnd ) = %SWS_HORIZONTAL then
       SplitterWnd_SetSplitPos hwnd, (rcClient.nbottom * nPercentPos)/ 100
    else
       SplitterWnd_SetSplitPos hwnd, (rcClient.nright * nPercentPos) / 100
    end if
  end function
  function SplitterWnd_SetBarSize (byval hwnd as long, byval NewBarSize as integer ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    'local rcClient as rect
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    '---Check size is not bigger than client area
    'if nNewPos < @lpsiInfo.PaneSizeMin then
    '   nNewPos = @lpsiInfo.PaneSizeMin
    '   exit function
    'end if
    'GetClientRect hwnd, rcClient
 
    if NewBarSize < 0 then NewBarSize = 0
 
    function = @lpsiInfo.BarSize
    @lpsiInfo.BarSize = NewBarSize
    SplitterWnd_Redraw hwnd
  end function
  function SplitterWnd_SetPaneMinSize (byval hwnd as long, byval NewSize as integer ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    if NewSize < 0 then NewSize = 0
 
    function = @lpsiInfo.PaneSizeMin
    @lpsiInfo.PaneSizeMin = NewSize
    SplitterWnd_Redraw hwnd
  end function
 
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ' message handlers
 
  function SplitterWnd_OnCreate(byval hwnd as long, lVar as long ) as long
    local LPCREATESTRUCT as CREATESTRUCT ptr
    LPCREATESTRUCT = lVar
    '' WARNING !!!!
    '' This is a hack! IF the SIZE of a HGLOBAL (the SIZE of a pointer) is greater than 32 bits it
    '' won't work! (may be in a future 64 bit version of Windows or in other plataforms?)
    SetWindowLong hwnd, %GWL_USERDATA, @LPCREATESTRUCT.lpCreateParams
  end function
 
 
  function SplitterWnd_OnDestroy ( hwnd as long ) as long
    local lpsiInfo as long
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    function = GlobalFree (lpsiInfo)
  end function
 
  function SplitterWnd_OnSize( hwnd as long, wParam as long )  as long
    if wParam <> %SIZE_MINIMIZED then
        '' this will force a split pos recalculation"
         SplitterWnd_SetSplitPos hwnd, SplitterWnd_GetSplitPos(hwnd)
    end if
  end function
 
 
  function SplitterWnd_OnLButtonDown(hwnd as long) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    @lpsiInfo.fMovingBar = %TRUE
    SetCapture hwnd
  end function
 
  function SplitterWnd_OnLButtonUp( hwnd as long ) as long
    local lpsiInfo as SPLITTERINFO_TAG ptr
    local rcClient as rect
    lpsiInfo = GetWindowLong (hwnd, %GWL_USERDATA)
    if @lpsiInfo.fMovingBar then
       @lpsiInfo.fMovingBar = %FALSE
       ReleaseCapture
    end if
  end function
 
  function SplitterWnd_OnMouseMove( hwnd as long, Msg as long, wParam as long, lParam as long)  as long
    '' the class has no cursor, so we need TO SET it every time the mouse moves
    SetCursor SplitterWnd_GetCursor(hwnd)
    if SplitterWnd_IsBarMoving(hwnd) then
        if SplitterWnd_GetStyle(hwnd) = %SWS_HORIZONTAL then
           SplitterWnd_SetSplitPos hwnd, hiwrd(lParam)
        else '' SWS_VERTICAL
           SplitterWnd_SetSplitPos hwnd, lowrd(lParam)
        end if
    end if
  end function
 
 
  function SplitterWnd_OnPAINT( byval hWnd as long ) as long
    local hDc as long, _
          RC  as RECT
    hDC = GetDC(hWnd)
    GetClientRect hWnd, rc
    FillRect hDC, rc, CreateSolidBrush(GetSysColor(%COLOR_BTNFACE))
    ReleaseDc hWnd, hDC
  end function
 
 
  function SplitterWndProc (byval hWnd as long, byval wMsg as long, _
                            byval wParam as long, byval lParam as long) export as long
    local hWndOld as long
    select case wMsg
        case %WM_CREATE      : SplitterWnd_OnCreate      hWnd, lParam
        case %WM_DESTROY     : SplitterWnd_OnDestroy     hWnd
        case %WM_SIZE        : SplitterWnd_OnSize        hWnd, wParam
        case %WM_LBUTTONDOWN : SplitterWnd_OnLButtonDown hWnd
        case %WM_LBUTTONUP   : SplitterWnd_OnLButtonUp   hWnd
        case %WM_MOUSEMOVE   : SplitterWnd_OnMouseMove   hWnd, wMsg, wParam, lParam
        case %WM_PAINT       : SplitterWnd_OnPAINT       hWnd
    end select
    function = DefWindowProc(hWnd, wMsg, wParam, lParam)
  end function
 
  '' Public functions
  function SplitterWnd_RegisterClass() as long
   local xwndclass       as WndClassEx, _
         SplitClassName as string
   SplitClassName         = "TB_SplitterWndClass"
   xwndclass.style         = %CS_HREDRAW or %CS_VREDRAW or %CS_NOCLOSE
   xwndclass.cbSize        = sizeof(xWndClass)
   xwndclass.lpfnWndProc   = codeptr(SplitterWndProc)
   xwndclass.hInstance     = GetModuleHandle (byval 0&)
   xwndclass.hCursor       = 0 ''LoadCursor( %NULL, BYVAL %IDC_SIZEWE)
   xwndclass.hbrBackground = GetStockObject(%NULL_BRUSH)
   xwndclass.lpszClassName = strptr(SplitClassName)
   function = RegisterClassEx( xwndclass )
  end function
 
 
  function IsEmptyRect( myRect as rect ) as long
    function = ( (myRect.nright + _
                  myRect.nbottom + _
                  myRect.nLeft + _
                  myRect.nTop) = 0 )
  end function
 
 
  function SplitterWnd_Create ( byval hwParent  as long, _
                                byval hiInst    as long, _
                                byval uChildId  as long, _
                                byval swsStyle  as long, _
                                byval hCursor   as long, _
                                lprRect as RECT) as long
    local hwTheWindow as long
    local lpsiWndInfo as SPLITTERINFO_TAG ptr
    local rParentRect as RECT
    local x           as integer
    local y           as integer
    local nWidth      as integer
    local nHeight     as integer
    lpsiWndInfo = GlobalAlloc(%GPTR, len(SPLITTERINFO_TAG))
    if isfalse lpsiWndInfo then exit function
    @lpsiWndInfo.swsStyle   = swsStyle
    @lpsiWndInfo.hCursor    = hCursor
    @lpsiWndInfo.hwPane1    = %null
    @lpsiWndInfo.hwPane2    = %null
    @lpsiWndInfo.fMovingBar = %FALSE
    @lpsiWndInfo.nSplitPos  = 0
    @lpsiWndInfo.BarSize    = 5
    @lpsiWndInfo.PaneSizeMin= 10
    '' test the rectangle. IF NULL, the window will have the SIZE of the parent CLIENT area.
    if IsEmptyRect( lprRect ) then
        GetClientRect hwParent, rParentRect
        x = 0
        y = 0
        nWidth  = rParentRect.nright
        nHeight = rParentRect.nbottom
    else
        x = lprRect.nLEFT
        y = lprRect.ntop
        nWidth  = lprRect.nRIGHT' - x
        nHeight = lprRect.nbottom' - y
    end if
'                               %WS_CHILD or %WS_VISIBLE or %WS_CLIPSIBLINGS or %WS_CLIPCHILDREN, _' or %WS_BORDER, _
    hwTheWindow = CreateWindow("TB_SplitterWndClass", _
                               "Splitter", _
                               %WS_CHILD or %WS_VISIBLE or %WS_CLIPSIBLINGS or %WS_CLIPCHILDREN, _' or %WS_BORDER, _
                               x, y, nWidth, nHeight, _
                               hwParent, _
                               uChildId, _
                               hiInst, _
                               lpsiWndInfo)
    function = hwTheWindow
  end function

[Chris Holbrook]

Thanks Eros!

[Chris Holbrook]

Source code posted

over here in the Source Code Forum. Please try it and advise problems, improvements, etc

Just re-read Eros's comment above about "set and forget" - it doesn't work that way, you have to export the properties list while the control is active. I suppose you could return a handle for the properties list and GloballFree it when the application ends.

[Eros Olmi]

Great present Chris!

I will study your code and report any problem I will found (if any ).
So far it compiles and run perfectly. I'm using PBWIN803.

Ciao
Eros

[Chris Holbrook]

It seemed a fine piece of code until I started using it. To be brief, some bugs have been fixed and some faclities added, comments in the INCLUDE file header give a flavour of what the current version (in the Source Code Forum)does.

[William Van Hoecke]

property box

Might be of use for someone !!!

The property box can be called as a dll and pops up a modeless child dialog populated with a varietity of comboboxes, buttons to call font/color/file dialogs, plain variables etc...

The property box can have multiple instances which all return a unique Handle.

The property-control-box is populated from an array (the array can be loaded from an external file or embedded resource etc...)

When values are changed the control box changes the source-array and generates %WM_USER messages to the caller with the WPARAM & LPARAM containing extra info.

Have FUN