Announcement

Collapse
No announcement yet.

Special-purpose menu

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Special-purpose menu

    Code:
    ' 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
    '___________________________________________________________________________________________________________
    ------------------
    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

    ------------------
    Best regards
    Jules
    www.rpmarchildon.com

    Comment


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


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

      Comment


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


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

        Comment

        Working...
        X