No announcement yet.

Special-purpose menu

  • Filter
  • Time
  • Show
Clear All
new posts

  • Special-purpose menu

    ' 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
    %NOLISTVIEW   = 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, _
                %DEFAULT_QUALITY, %FF_DONTCARE, ByCopy Font)
     End Function
    Sub BuildMenu
     For i&=Mtop& To Mtop&+5                             ' Trigger repaint of the menu
      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)+" "
     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
       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
      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.
        itm&=Ci&-14501                       'itm& is the row number (1 based)), and c& the column, from 0 to 3
        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&
          SetTextColor CbWparam, %Black
          SetBkColor CbWparam, %Cyan
          Function = CyanBrush&
          End If
         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
         End If
        Call BuildMenu
       Case %SB_PAGEDOWN
        If Mtop&=Spq&-5 Then Exit Function
        If Mtop&>Spq&-5 Then
         End If
        Call BuildMenu
       Case %SB_TOP
        If Mtop&=1 Then Exit Function
        Call BuildMenu
       Case %SB_BOTTOM
        If Mtop&=Spq&-5 Then Exit Function
        Call BuildMenu
       Case %SB_THUMBTRACK
        If tpos&>xpos& Then
         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")
       Select Case Ci&
       Case 14002
        Dialog End hDlg&
       Case 14501 To smx&
        c&=(Ci&-1) Mod 4
        If c&=1 And itm&=spq1& Or c&=2 And itm&=spq2& Or c&=3 And itm&=spq3& Then Exit Function
        If c&=0 Then                 'Selecting first column selects ALL columns in row
         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 _
     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 _
     hFont& = MakeFont("MS Sans Serif", 10)
     GetObject hFont&, SizeOf(lf), ByVal VarPtr(lf)
     lf.lfWeight = %FW_BOLD
     shFont& = CreateFontIndirect(lf)
     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
     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&
     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', _
      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', _
      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', _
      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', _
      Control Send hDlg&, smx&+3, %WM_SETFONT, shFont&, 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"
     Call BuildMenu
     Dialog Show Modal hDlg& Call dlgProc
     End Function
    Last edited by Gary Beene; 12 Jul 2014, 07:54 PM. Reason: Code: tags

  • #2
    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



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

      Peter Amick
      Baybuild Solutions
      Peter Amick
      Baybuild Solutions


      • #4
        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?