Special-purpose menu

[DienyduToit]

' Snippet from project code, somewhat pruned down, which provides what, to all intents and purposes, is
' a menu. This "menu", however, as opposed to a listbox, can have several columns per row, where all the
' columns on a row represent a total information item, not separate menu items.
'
' This means that one does not have to use a fixed width font (e.g. Courier new) to ensure alignment, but,
' more important, any item in any column may respond in any way necessary - not just by colour changes as
' in the example below. I needed something of this nature in my project, and quite a lot of updating is
' required other than colour change - that is only to keep the user posted.
' Also, using the scrollbar enables the keyboard cursor keys without any need for sub-classing - unless
' the menu has less than 7 items (in this example) in which case the mouse has to be used to select.
'
' I do not own, and am unable (so far) to obtain, any Windows programming book(s) such as Petzold, Rector and
' Newcomer &c, and am therefore not in a position to judge whether this is a re-invention of the wheel.
' For all I know this posting belongs in the Dubious Humour Forum.
'
' Any comments ... ?
'
#Compile Exe "MenuTest.exe"
'#Debug Error On
'___________________________________________________________________________________________________________

' ** Eliminate unnecessary macros
%NOANIMATE    = 1
%NODRAGLIST   = 1
%NOHEADER     = 1
%NOIMAGELIST  = 1
%NOLISTVIEW   = 1
%NOTABCONTROL = 1
%NOTRACKBAR   = 1
%NOTREEVIEW   = 1
%NOUPDOWN     = 1
%Navy         = &H800000???
%Silver      = &HC0C0C0???
'___________________________________________________________________________________________________________

#Include "WIN32API.INC"  'My project has its own include file here (about 23K,
                         'as opposed to 780K for WIN32API.INC)
'___________________________________________________________________________________________________________

 Global MenuData$ ()
 Global hDlg&, shFont&, spq&, smx&, ScrBar&, Mtop&, xPos&, tPos&, ColsUsed&, spq1&, spq2&, spq3&
'___________________________________________________________________________________________________________

 Declare Sub               BuildMenu
 Declare CallBack Function dlgProc
 Declare Function          MakeFont(ByVal Font As String, ByVal PointSize As Long) As Long
'___________________________________________________________________________________________________________

Function MakeFont(ByVal Font As String, ByVal PointSize As Long) As Long

  Local hDC      As Long
  Local CyPixels As Long

  hDC = GetDC (%HWND_DESKTOP)
  CyPixels  = GetDeviceCaps (hDC, %LOGPIXELSY)
  ReleaseDC %HWND_DESKTOP, hDC

  PointSize = (PointSize * CyPixels) \ 72

  Function = CreateFont (0-PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
            %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
            %DEFAULT_QUALITY, %FF_DONTCARE, ByCopy Font)
 End Function
'___________________________________________________________________________________________________________

Sub BuildMenu
 n&=14501
 For i&=Mtop& To Mtop&+5                             ' Trigger repaint of the menu
  t$=MenuData$(i&)
  Control Set Text hDlg&, n&, " "+Left$(t$,8)
  Control Set Text hDlg&, n&+1, Mid$(t$,10,10)+" "
  Control Set Text hDlg&, n&+2, Mid$(t$,20,10)+" "
  Control Set Text hDlg&, n&+3, Mid$(t$,30,10)+" "
  n&=n&+4
  Next
 xPos&=Mtop&-1
 End Sub
'__________________________________________________________________________________________________________

CallBack Function dlgProc

 Local Lb As LogBrush
 Static BlueBrush&, CyanBrush&, GrayBrush&, GreenBrush&, NavyBrush&
 Static RedBrush&, SilverBrush&, WhiteBrush&, YellowBrush&
 Static si As SCROLLINFO

 Select Case CbMsg

 Case %WM_INITDIALOG
   Lb.lbStyle   = %BLACK_BRUSH
   Lb.lbColor   = %Blue
  BlueBrush&   = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Cyan
  CyanBrush&   = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Gray
  GrayBrush&   = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Green
  GreenBrush& = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Navy
  NavyBrush& = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Red
  RedBrush&    = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Silver
  SilverBrush& = CreateBrushIndirect(Lb)
   Lb.lbColor   = %White
  WhiteBrush&  = CreateBrushIndirect(Lb)
   Lb.lbColor   = %Yellow
  YellowBrush& = CreateBrushIndirect(Lb)

  Control Handle CbHndl, 14001 To hCtl&
  si.cbSize = SizeOf(si)
  si.fMask = %SIF_ALL
  si.nMin = 0
  si.nMax = spq&-1
  si.nPage = 6
  si.nPos = 0
  si.nTrackPos = 0
  SetScrollInfo hCtl&, %SB_CTL, si, %True

 Case %WM_CTLCOLORSTATIC
  Ci&=GetDlgCtrlID(CbLparam)

  Select Case Ci&
   
  Case 14000
   SetTextColor CbWparam, %Navy
   SetBkColor CbWparam, %Silver
   Function = SilverBrush&

  Case 14501 To smx&
   c&=(Ci&-1) Mod 4
   If c&>ColsUsed& Then                  ' "Dead" columns (inaccessible to user) may be done this way if
    SetTextColor CbWparam, %Gray         ' they are always to the righthand end. Selected items in any
    SetBkColor CbWparam, %Silver         ' column anywhere could be disabled with an "instr" applied to
    Function = SilverBrush&              ' a prepared string of dead items.
   Else
    itm&=Ci&-14501                       'itm& is the row number (1 based)), and c& the column, from 0 to 3
    itm&=Fix(itm&\4)+1+(Mtop&-1)
    If itm&=spq1& Or itm&=spq2& Or itm&=spq3& Then
     If c&=0 Or _
        c&=1 And itm&=spq1& Or _
        c&=2 And itm&=spq2& Or _
        c&=3 And itm&=spq3& Then
      SetTextColor CbWparam, %Black
      SetBkColor CbWparam, %Yellow
      Function = YellowBrush&
     Else
      SetTextColor CbWparam, %Black
      SetBkColor CbWparam, %Cyan
      Function = CyanBrush&
      End If
    Else
     SetTextColor CbWparam, %Black
     SetBkColor CbWparam, %Cyan
     Function = CyanBrush&
     End If
    End If
   End Select

 Case %WM_VSCROLL

  Select Case LoWrd(CbWparam)

   Case %SB_LINEDOWN
    If Mtop&<Spq&-5 Then
     Incr Mtop&
     Incr tPos&
     Call BuildMenu
     End If

   Case %SB_LINEUP
    If Mtop&>1 Then
     Decr Mtop&
     Decr tPos&
     Call BuildMenu
     End If

   Case %SB_PAGEUP
    If Mtop&=1 Then Exit Function
    If Mtop&>5 Then
     Mtop&=Mtop&-5
     tPos&=tPos&-5
    Else
     Mtop&=1
     tPos&=0
     End If
    Call BuildMenu

   Case %SB_PAGEDOWN
    If Mtop&=Spq&-5 Then Exit Function
    Mtop&=Mtop&+5
    tPos&=tPos&+5
    If Mtop&>Spq&-5 Then
     Mtop&=Spq&-5
     tPos&=Mtop&-1
     End If
    Call BuildMenu

   Case %SB_TOP
    If Mtop&=1 Then Exit Function
    Mtop&=1
    tPos&=0
    Call BuildMenu

   Case %SB_BOTTOM
    If Mtop&=Spq&-5 Then Exit Function
    Mtop&=Spq&-5
    tPos&=Spq&-6
    Call BuildMenu

   Case %SB_THUMBTRACK
    tpos&=HiWrd(CbWparam)
    If tpos&>xpos& Then
     dff&=tPos&-xPos&
     Mtop&=Mtop&+dff&
    Else
     dff&=xPos&-tPos&
     Mtop&=Mtop&-dff&
     End If
    If Mtop&<1 Then Mtop&=1
    If Mtop&>Spq&-5 Then Mtop&=Spq&-5
    Call BuildMenu
    End Select

  Control Handle hDlg&, 14001 To ScrBar&
  SetScrollPos ScrBar&, %SB_CTL, tPos&, %True

 Case %WM_COMMAND

  Select Case CbCtlMsg

  Case %BN_CLICKED, %STN_CLICKED       '(i.e., "Case 0, 0")
   Ci&=GetDlgCtrlID(CbLparam)

   Select Case Ci&
    
   Case 14002
    Dialog End hDlg&
    
   Case 14501 To smx&
    c&=(Ci&-1) Mod 4
    itm&=Ci&-14501
    itm&=Fix(itm&\4)+1+(Mtop&-1)
    If c&=1 And itm&=spq1& Or c&=2 And itm&=spq2& Or c&=3 And itm&=spq3& Then Exit Function
    spl&=Ci&-c&
    If c&=0 Then                 'Selecting first column selects ALL columns in row
     spq1&=itm&
     spq2&=itm&
     spq3&=itm&
     End If
    If c&=1 Then spq1&=itm&      'Selecting any other column
    If c&=2 Then spq2&=itm&      'causes selection of
    If c&=3 Then spq3&=itm&      'column 1 plus that column ONLY
    Call BuildMenu
    End Select
   End Select

 Case %WM_DESTROY
  DeleteObject BlueBrush&
  DeleteObject CyanBrush&
  DeleteObject GrayBrush&
  DeleteObject GreenBrush&
  DeleteObject NavyBrush&
  DeleteObject RedBrush&
  DeleteObject SilverBrush&
  DeleteObject WhiteBrush&
  DeleteObject YellowBrush&
  End Select
 End Function
'___________________________________________________________________________________________________________

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 Style As Long
 Local lf As LogFont

 Style = %WS_SYSMENU Or _
         %WS_OVERLAPPEDWINDOW Or _
         %WS_MINIMIZEBOX

 Dialog New 0, "Menu test", 0, 0, 534, 372, Style To hDlg&

 Style& = %WS_POPUP Or _
          %DS_SETFONT Or _
          %DS_NOFAILCREATE Or _
          %DS_MODALFRAME Or _
          %DS_3DLOOK

 hFont& = MakeFont("MS Sans Serif", 10)
 GetObject hFont&, SizeOf(lf), ByVal VarPtr(lf)
 lf.lfWeight = %FW_BOLD
 shFont& = CreateFontIndirect(lf)

 Mtop&=1
 xPos&=0
 ColsUsed&=3     'Setting this to less than number of columns after col. 1 disables the rightmost ones
 spq&=21         ' - it would be quite easy to provide a mask string to disable items selectively
 spq1&=1         'Change spq& value on previous line to enlarge/reduce the menu
 spq2&=2         ' spq1/2/3 are the initial (default) selections in the menu
 spq3&=3
 m&=spq&
 If m&>6 Then m&=6
 w&=223                ' w& (width) provides for a scrollbar when necessary
 If spq&<7 Then w&=218
 Control Add Frame, hDlg&, 14000, "Menu of the third kind", 158,  96, w&,   m&*11+16
 Control Send hDlg&, 14000, %WM_SETFONT, shFont&, 1
 Control Add Label, hDlg&, smx&,   "", 160, 107, w&-4, m&*11+4, ,%SS_WHITEFRAME  '(Cosmetic only)
 smx&=14501            ' Block of equates reserved for menu items, from 14501 to final value of smx&
 n&=0

 For i&=1 To m&*4 Step 4
  Incr n&
  Control Add Label, hDlg&, smx&,   "", 162, n&*11+98,  40,  11, %SS_LEFT Or _
                                                                 %SS_NOTIFY', _
                                                                 '%WS_EX_WINDOWEDGE
  Control Send hDlg&, smx&, %WM_SETFONT, shFont&, 1
  Control Add Label, hDlg&, smx&+1, "", 202, n&*11+98,  55,  11, %SS_RIGHT Or _
                                                                 %SS_NOTIFY', _
                                                                 '%WS_EX_WINDOWEDGE
  Control Send hDlg&, smx&+1, %WM_SETFONT, shFont&, 1
  Control Add Label, hDlg&, smx&+2, "", 257, n&*11+98,  55,  11, %SS_RIGHT Or _
                                                                 %SS_NOTIFY', _
                                                                 '%WS_EX_WINDOWEDGE
  Control Send hDlg&, smx&+2, %WM_SETFONT, shFont&, 1
  Control Add Label, hDlg&, smx&+3, "", 312, n&*11+98,  55,  11, %SS_RIGHT Or _
                                                                 %SS_NOTIFY', _
                                                                 '%WS_EX_WINDOWEDGE
  Control Send hDlg&, smx&+3, %WM_SETFONT, shFont&, 1
  smx&=smx&+4
  Next

 Mtop&=1
 If spq&>6 Then Control Add ScrollBar, hDlg&, 14001, "",      368, 109, 10, m&*11, _
                                                          %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %SBS_VERT

 Control Add Button, hDlg&, 14002, "Exit",      244, 200, 50,16
 Control Send hDlg&, 14002, %WM_SETFONT, shFont&, 1

 ReDim MenuData$ (spq&)

 t$=""                        'Create dummy menu items. Project actually calls a function in a DLL module
                              'which returns a string of fixed length menu items. If random "dead" items
                              'apply, it could easily also return a "mask" string of these as well.
 For i&=1 To spq&
  MenuData$(i&)=Format$(i&, "Item ###")+"  Column 1  Column 2  Column 3"
  Next

 Call BuildMenu
 Dialog Show Modal hDlg& Call dlgProc
 End Function
'___________________________________________________________________________________________________________

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

[Jules Marchildon]

Gave it a spin, on start up the highlight bar is scattered from
column to column until you scroll up and down a few times it clears
up to look like one continuous highlight bar.


Regards, Jules

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

[Peter Amick]

Also gave it a try, the scrollbar works, but can't select any item.


------------------
Peter Amick
Baybuild Solutions

[DienyduToit]

The initial display shows three different items being selected vertically. In each case the first column is selected as well. This is deliberate, in order to demonstrate that each item may be attached to a different whatnot.

The object (in my project) is to do a quotation, where the final three columns represent three different quantities being quoted on. The first column is a list of suppliers of a given material required for the job, whose prices are necessary to complete the quotation.

This way of doing enables one to select a different (or the same) supplier for each of the quantities, where some suppliers may have a single fixed price, and others allow discounts based on quantity. Selecting the first column is to use that supplier only. The other columns may be used to specify differently.

The same structure may be imagined, as having six columns instead of four, with the names of (say) five local supermarkets across the top above the last five, the first column being a list of commodities to be purchased. Opposite each commodity its price appears under each supplier name. You could use a thing like that to compile a shopping list of selected commodities, and have a total at the bottom to show which shop is the most economical in total, and then possibly make two (or more) separate shopping lists with best priced items selected per supermarket.

In any event, I have now found further real uses for it. The one I'm on now has ten columns, of which the second has a label and all the others are textboxes requiring input. Still part of my quotation project (which, BTW, is for the printing industry) this is concerned with the ink which is used in a print job.

The columns are Coverage percent, Kilogrammes of ink per 1000 sq.m., and then eight columns to hold the number of colours to be printed with
one or more of eight ink types (normal black, trico colours, matchings,
UV ink etc.). Each ink type has a different cost, and different colours may very likely have different coverage percentages in which case more than one line of entry is necessary. In any event, where both sides of the paper are printed, each side requires its own entries.

This is a somewhat different use of this structure to the original, but it has the advantage that entries may be made where they belong, i.e., on the actual line, with no need for additional text boxes. It also permits total freedom as to font selection, text and background colour and processing of input. It is a matter of simplicity to identify row and column, using two very simple functions which receive the handle of any of the textboxes and return column and row. Delphi offers a thing called a Scroll Grid or some such, but the cost in compiled code is horrendous, as is, it seems, anything else in 4GL (???).

My ink entry "menu" provides five lines of entry on view and a disabled scrollbar which is adequate for simple jobbing work. There are cases, such as magazines, where many sections are necesssary, even different paper types with different absorption coefficients (affecting coverage), so that in such a case scrolling is very likely necessary.

In any event, I find this very simple to operate, and I wonder what ready-made alternatives there may be - and, if any, are they likely to be more resources-efficient?


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