Simple Menu - Advice Please

DOS specific questions.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Simple Menu - Advice Please

Postby Gablea » Sep 22, 2014 19:17

Hi all,
3 Things
1. I recently updated to version 1.0.000 on both my Windows Compiler as well as the DOS Compiler and I have not had any problems with compiling applications.
2. Why Does one of my screens flicker even when I am using ScreenLock and ScreenUnlock?

3. I have been trying to make a simple menu in FreeBASIC but I am not having much luck. Below is a artist
impression of how I would like the menu to look

Image

any advice on the above menu would be great (or even some sample code)
bcohio2001
Posts: 552
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Simple Menu - Advice Please

Postby bcohio2001 » Sep 22, 2014 22:06

Is this mouse or keyboard driven? Or both?
Submenus, or just direct to whatever is selected?

Share what you have so far. I have tried, and got tired of it, many times.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Simple Menu - Advice Please

Postby Gablea » Sep 22, 2014 22:52

This will be keyboard Driven only
yes i would Like sub menus as well as direct select (that would be for the Point of Sale menu)

I have nothing yet as I DO not have a clue how to do this (ive only started to learn how to do menus in FreeBASIC)
angros47
Posts: 1626
Joined: Jun 21, 2005 19:04

Re: Simple Menu - Advice Please

Postby angros47 » Sep 23, 2014 8:51

If you want your menu to work in DOS, too, you should do it in text mode: use the COLOR command to set the background color to white, then clear the screen and print your menu.

Something like this:

Code: Select all

dim as string MenuItems(...)={"1. Point of sales", "2. Stock Menu", "3. Supplier Menu", "4. Cashier Menu"}

dim Selected as integer


dim k as string
do

   color 0,7
   cls
   for I as integer=0 to 3
      if I=Selected then color 14,1 else color 0,7
      Print MenuItems(i)
   next
   sleep
   k=inkey

   if k=chr(255)+"H" then Selected-=1
   if k=chr(255)+"P" then Selected+=1
   if Selected<0 then Selected=3
   if Selected>3 then Selected=0

loop until k=chr(13)


You can draw the border of your menu using characters: chr(191), chr(192), chr(217), chr(218) for angles, chr(179) for vertical lines, chr(192) for horizontal lines.
bcohio2001
Posts: 552
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: Simple Menu - Advice Please

Postby bcohio2001 » Oct 05, 2014 13:22

It's not pretty and may still need some tweaks here and there.
There is a lot that is not ready, but the basics are there.

Code: Select all

/'NOTES
This must be loaded LAST, or the subs in main program must be declared.
As of now all subs called must not have any parameters.

Each menu MUST have an exit.
Ensure that any separators are NOT the first or last item in your menu.

Items not implimented at all, or in progress.
DosMenu_Boarder_1H2V
DosMenu_Boarder_2H1V
DosMenu_Input_Mouse (also DosMenu_Input_Mix)
DosMenu_SubMenu_Cascade_AlignBoarder
Scrolling -- for menus that have over 24 options
'/

#Ifndef DosMenu_Boarder_Single
'boarder flags (no boarder the 4 bits will be 0, also the default)
#Define DosMenu_Boarder_Single &h0001
#Define DosMenu_Boarder_Double &h0002
#Define DosMenu_Boarder_1H2V &h0004 'Horizontal 1 line - vertical 2
#Define DosMenu_Boarder_2H1V &h0008 'Horizontal 2 lines - vertical 1
#Define DosMenu_Boarder_Mask &h000F 'easier than or'ing 4 defines

#Define DosMenu_FullRowSelect &h0010

#Define DosMenu_SubMenu_Cascade &h0020 'if not set will overwrite
#Define DosMenu_SubMenu_Cascade_AlignBoarder &h0040 'if set child will share boarder with it's parent

'input flags
#Define DosMenu_Input_KB &h0080
#Define DosMenu_Input_Mouse &h0100
#Define DosMenu_Input_Mix (DosMenu_Input_KB Or DosMenu_Input_Mouse)

'menu justification
#Define DosMenu_Justify_Left &h0200
'#Define DosMenu_Justify_Right &h0400
'#Define DosMenu_Justify_Center (DosMenu_Justify_Left Or DosMenu_Justify_Right) 'looks odd
#Define DosMenu_Justify_Center &h0400

#Define DosMenu_Default (DosMenu_Justify_Left Or DosMenu_Input_KB)
'Location
#Define DosMenu_Loc_UpperLeft "ul"
#Define DosMenu_Loc_UpperRight "ur"
#Define DosMenu_Loc_BottomLeft "bl"
#Define DosMenu_Loc_BottomRight "br"
#Define DosMenu_Loc_Center "c"

Type _DosMenu As DosMenu 'forward typing
Type DosMenuItem
   As String Label
   As String QuickKey 'key to press to automaticly use
   As Integer Opt 'menu, sub, exit
   As _DosMenu Ptr Child 'child menu to call if selected
   Dim RunSub As Sub () 'subroutine to call if selected NO PARAMETERS
End Type

Type DosMenu
   'creating
   Declare Constructor(T As String, Location As String, SetupFlags As Integer=DosMenu_Default) 'define main
   Declare Constructor(T As String, X As Integer, Y As Integer, SetupFlags As Integer=DosMenu_Default) 'define main
   Declare Constructor(T As String, ParentMenu As DosMenu Ptr) 'define submenu
   Declare Sub DefineCallMenu(L As String, Q As String, ChildMenu As DosMenu Ptr) 'call a submenu
   Declare Sub DefineCallSub(L As String, Q As String, Sub2Run As Any Ptr) 'call a subroutine
   Declare Sub DefineSep() 'create a seperator
   Declare Sub DefineExit(L As String, Q As String) 'Exit menu option -- must have only one for each menu
   Declare Sub SetMainColor(F As Integer, B As Integer) 'optional
   Declare Sub SetSelColor(F As Integer, B As Integer) 'optional
   'only used on Parent
   Declare Sub Execute() 'do not use on child menu
   '
   Private:
   Declare Sub DrawMe()
   Declare Sub InitDraw() 'draws boarders or spaces
   Declare Sub InitDraw_AlignBoarder() 'draws boarders or spaces when child menu shares boarder
   Declare Function FlagSet(IsFlag As Integer) As Integer
   'main prg has no reason to access variables
   As DosMenuItem DMI(Any) 'array of selections
   As Integer TotItems 'count of selections
   As Integer LongestItemLen
   '
   As String Title
   As Integer Flags
   As Integer Selected
   '
   As DosMenu Ptr Parent 'Parent menu to copy off of
   As Integer ItemNum 'Parents Item number that called submenu
   'Location
   As String CalcLoc
   As Integer LocX, LocY
   As Integer Scroll 'scrollable flag
   '
   'submenu will take on parents setting
   As Integer MainFG = 7 'lo-res white
   As Integer SelFG = 0 'black
   As Integer SelBG = 7 'lo-res white
   As Integer MainBG = 0 'black
   As Integer BoarderIdx
End Type

Constructor DosMenu(T As String, Location As String, SetupFlags As Integer=DosMenu_Default)
Title = T
Flags = SetupFlags
LongestItemLen = Len(T)
'final location depends on number of items or length of longest item
CalcLoc = Location
'make sure both _Cascade are CLEAR if center screen
If CalcLoc = DosMenu_Loc_Center Then
   Flags And= &hFFFFFF9F
Else
   'if want to align boarders make sure _Cascade flag is on also
   If FlagSet(DosMenu_SubMenu_Cascade_AlignBoarder) Then Flags And= DosMenu_SubMenu_Cascade
EndIf
End Constructor

Constructor DosMenu(T As String, X As Integer, Y As Integer, SetupFlags As Integer=DosMenu_Default)
Title = T
Flags = SetupFlags
LongestItemLen = Len(T)
LocX = X
LocY = Y 'need to be verfied to not wrap
CalcLoc = "user"
'make sure both _Cascade are CLEAR
Flags And= &hFFFFFF9F
End Constructor

Constructor DosMenu(T As String, ParentMenu As DosMenu Ptr)
this.Title = T
this.Parent = ParentMenu
this.LongestItemLen = Len(T)
'set this menu colors to parent's colors and boarder type
this.Flags = Parent->Flags
this.MainFG = Parent->MainFG
this.MainBG = Parent->MainBG
this.SelFG = Parent->SelFG
this.SelBG = Parent->SelBG
'pre-set location for overwrite
This.LocX = Parent->LocX
this.LocY = Parent->LocY
this.CalcLoc = Parent->CalcLoc
End Constructor

Sub DosMenu.DefineCallMenu(L As String, Q As String, ChildMenu As DosMenu Ptr)
   ReDim Preserve this.DMI(this.TotItems)
   this.DMI(this.TotItems).Label = L
   this.DMI(this.TotItems).QuickKey = Q
   this.DMI(this.TotItems).Child = ChildMenu
   ChildMenu->ItemNum = this.TotItems
   this.DMI(this.TotItems).Opt = 1
   this.TotItems += 1
   If Len(L) > this.LongestItemLen Then this.LongestItemLen = Len(L)
End Sub

Sub DosMenu.DefineCallSub(L As String, Q As String, Sub2Run As Any Ptr)
   ReDim Preserve this.DMI(this.TotItems)
   this.DMI(this.TotItems).Label = L
   this.DMI(this.TotItems).QuickKey = Q
   this.DMI(this.TotItems).RunSub = Sub2Run
   this.DMI(this.TotItems).Opt = 2
   this.TotItems += 1
   If Len(L) > this.LongestItemLen Then this.LongestItemLen = Len(L)
End Sub

'optional
Sub DosMenu.SetMainColor(F As Integer, B As Integer)
   this.MainFG = F
   this.MainBG = B
End Sub

'optional
Sub DosMenu.SetSelColor(F As Integer, B As Integer)
   this.SelFG = F
   this.SelBG = B
End Sub

Sub DosMenu.DefineSep()
   'should not be first or last
   ReDim Preserve this.DMI(this.TotItems)
   this.DMI(this.TotItems).Label = "-"
   this.TotItems += 1
End Sub

Sub DosMenu.DefineExit(L As String, Q As String)
   ReDim Preserve this.DMI(this.TotItems)
   this.DMI(this.TotItems).Label = L
   this.DMI(this.TotItems).QuickKey = Q
   this.DMI(this.TotItems).Opt = 3
   this.TotItems += 1
   If Len(L) > this.LongestItemLen Then this.LongestItemLen = Len(L)
End Sub

Sub DosMenu.Execute()
   Dim As Integer Char(this.TotItems+1, this.LongestItemLen + 3) 'Characters where menu is.
   Dim As Integer Clr(this.TotItems+1, this.LongestItemLen + 3) 'Colors where menu is.
   Dim As Integer x, y, z
   Dim As Integer OptActivate, ChildCount
   Dim As String k
   'save current cursor status
   'result = Locate( [row], [column], [state] )
   x = Locate
   'new_column = lobyte( result )
   Dim As Integer OrigY = Pos
   'new_row = hibyte( result )
   Dim As Integer OrigX = CsrLin
   'new_state = hiword( result )
   Dim As Integer OrigC = HiWord(x)
   Locate 1,1,0 'ensure cursor off
   'user's subs may clear menus off screen
   Dim As DosMenu Ptr P 'temp parent holder
   ReDim As DosMenu Ptr M(0)
   M(0) = @this
   P = @this
   While P->Parent
      ChildCount += 1
      ReDim Preserve M(ChildCount)
      M(ChildCount) = P->Parent
      P = P->Parent
   Wend
   'if has more than 24 items scrollable ...
   'may need tweeks...
   If FlagSet(DosMenu_SubMenu_Cascade) And This.Parent <> 0 Then
      'child
      Select Case this.CalcLoc
         Case "user"
            'THIS SHOULD NOT HIT
            'correct wrap horizontally
            'OVERWRITE
            'If this.LocY + this.LongestItemLen > 78 Then this.LocY = 78 - this.LongestItemLen
            '
         Case DosMenu_Loc_UpperRight
            'cascade on left side going down
            this.LocX = 2 + this.ItemNum 'put title on same line as menuitem
            'If this.TotItems > 24 Then this.Scroll = 1
            this.LocY = this.Parent->LocY - this.LongestItemLen
            If this.FlagSet(DosMenu_SubMenu_Cascade_AlignBoarder) Then this.LocY -= 4
            '
         Case DosMenu_Loc_BottomRight
            'cascade on left side going up
            this.LocX = this.Parent->LocX + this.ItemNum - this.TotItems
            this.LocY = this.Parent->LocY - this.LongestItemLen
            If this.FlagSet(DosMenu_SubMenu_Cascade_AlignBoarder) Then this.LocY -= 4
            '
         Case DosMenu_Loc_BottomLeft
            this.LocX = this.Parent->LocX + this.ItemNum - this.TotItems
            this.LocY = this.Parent->LongestItemLen
            If this.FlagSet(DosMenu_SubMenu_Cascade_AlignBoarder) Then this.LocY += 4
            '
         Case DosMenu_Loc_Center
            'OVERWRITE
            'THIS SHOULD NOT HIT
            'this.LocX = (25 - this.TotItems)\2
            'this.LocY = (78 - this.LongestItemLen)\2
            '
         Case Else
            'DosMenu_Loc_UpperLeft
            LocX = 2 + this.ItemNum 'put title on same line as menuitem
            If this.TotItems > 24 Then this.Scroll = 1
            LocY = this.Parent->LongestItemLen
            If this.FlagSet(DosMenu_SubMenu_Cascade_AlignBoarder) Then this.LocY += 4
            '
      End Select
   Else
      'Parent menu or Overwrite
      Select Case this.CalcLoc
         Case "user"
            'correct wrap horizontally
            If this.LocY + this.LongestItemLen > 77 Then this.LocY = 77 - this.LongestItemLen
            '
         Case DosMenu_Loc_UpperRight
            this.LocX = 1
            If this.TotItems > 24 Then this.Scroll = 1
            this.LocY = 77 - this.LongestItemLen
            '
         Case DosMenu_Loc_BottomRight
            this.LocX = 23 - this.TotItems
            this.LocY = 77 - this.LongestItemLen
            '
         Case DosMenu_Loc_BottomLeft
            this.LocX = 23 - this.TotItems
            this.LocY = 1
            '
         Case DosMenu_Loc_Center
            this.LocX = (23 - this.TotItems)\2
            this.LocY = (77 - this.LongestItemLen)\2
            '
         Case Else
            'DosMenu_Loc_UpperLeft
            LocX = 1
            If this.TotItems > 24 Then this.Scroll = 1
            LocY = 1
            '
      End Select
   EndIf
   '
   If this.LocX < 1 Then
      this.LocX = 1
      this.Scroll = 1
   EndIf
   'set index for boarder in DrawMe
   If FlagSet(DosMenu_Boarder_Mask) Then
      'some form of boarder
      If FlagSet(DosMenu_Boarder_Single) Then
         this.BoarderIdx = 1
      ElseIf FlagSet(DosMenu_Boarder_Double) Then
         this.BoarderIdx = 2
      ElseIf FlagSet(DosMenu_Boarder_1H2V) Then
         this.BoarderIdx = 1 '3 'not implimented
      ElseIf FlagSet(DosMenu_Boarder_2H1V) Then
         this.BoarderIdx = 2 '4 'not implimented
      EndIf
   EndIf
   'get screen (may be a copy of previous menu, or nothing at all)
   'account for scroll
   z = IIf(this.Scroll, 24, this.TotItems+1)
   For x = 0 To z
      For y = 0 To this.LongestItemLen + 3
         Char(x,y) = Screen(x + this.LocX, y + this.LocY, 0)
         Clr(x,y) = Screen(x + this.LocX, y + this.LocY, 1)
      Next
   Next
   If this.FlagSet(DosMenu_SubMenu_Cascade_AlignBoarder) Then
      'WIP
      this.InitDraw_AlignBoarder 'draw borders or spaces, child menu shares boarder
   Else
      this.InitDraw 'draw borders or spaces, child menu partially overwrites parent
   EndIf
   Do
      this.DrawMe() 'draw menu items
      OptActivate = -1 'option activate flag
      'start input wait loop
      Do
         If this.FlagSet(DosMenu_Input_KB) Then
            'Keyboard
            k = InKey
            If Len(k) Then
               If k = Chr(27) Then Exit Do, Do 'escape key - exit menu
               'check cursor keys
               If k = Chr(255) + "H" And this.Selected > 0 Then
                  'up
                  this.Selected -= 1
                  If this.DMI(this.Selected).Label = "-" Then this.Selected -= 1
                  Exit Do 'exit input loop only
               EndIf
               If k = Chr(255) + "P" And this.Selected < this.TotItems -1 Then
                  'down
                  this.Selected += 1
                  If this.DMI(this.Selected).Label = "-" Then this.Selected += 1
                  Exit Do 'exit input loop only
               EndIf
               'left and right only to activate submenu
               If this.DMI(this.Selected).Child Then
                  If k = Chr(255) + "M" Then
                     'right
                     this.DMI(this.Selected).Child->Execute()
                  EndIf
               EndIf
               If this.Parent Then
                  'in child menu
                  If k = Chr(255) + "K" Then
                     'left cursor, same as escape key (exit menu!)
                     Exit Do, Do
                  EndIf
               EndIf
               'check for .QuickKey or enter key
               If k = Chr(13) Then
                  OptActivate = this.Selected
               Else
                  x = 0 'loop control
                  Do
                     If k = this.DMI(x).QuickKey Then
                        this.Selected = x
                        this.DrawMe()
                        OptActivate = x
                        Exit Do
                     EndIf
                     x += 1
                  Loop Until x = this.TotItems
                  'if fall out then invalid keypress
                  If OptActivate = -1 Then Beep
               EndIf
               '
               If OptActivate > -1 Then Exit Do 'keypress activate
            EndIf
         EndIf
         If FlagSet(DosMenu_Input_Mouse) Then
            'mouse
            GetMouse(x, y,, z) 'ignore wheel
         EndIf
         Sleep 1, 1
      Loop
      If OptActivate > -1 Then
         Select Case this.DMI(OptActivate).Opt
            Case 1
               'call child menu
               If FlagSet(DosMenu_SubMenu_Cascade) Then
                  this.DMI(OptActivate).Child->Execute()
               Else
                  'overwrite
                  'return to original
                  'account for scroll
                  z = IIf(this.Scroll, 24, this.TotItems+1)
                  For x = 0 To z
                     For y = 0 To this.LongestItemLen + 3
                        Locate x + this.LocX, y + this.LocY
                        Color Clr(x,y) And &hf, Clr(x,y) Shr 4
                        Print Chr(Char(x,y))
                     Next
                  Next
                  this.DMI(OptActivate).Child->Execute()
                  'redo boarders
                  this.InitDraw
               EndIf
               '
            Case 2
               'call sub
               this.DMI(OptActivate).RunSub()
               'user's sub may overwrite parent and children menus
               For x = ChildCount To 0 Step -1
                  M(x)->InitDraw()
                  If x Then M(x)->DrawMe()
               Next
               '
            Case 3
               'exit menu
               Exit Do
               '
         End Select
      EndIf
   Loop
   'return to original
   'account for scroll
   z = IIf(this.Scroll, 24, this.TotItems+1)
   For x = 0 To z
      For y = 0 To this.LongestItemLen + 3
         Locate x + this.LocX, y + this.LocY
         Color Clr(x,y) And &hf, Clr(x,y) Shr 4
         Print Chr(Char(x,y))
      Next
   Next
   Locate OrigX, OrigY, OrigC
End Sub

'Private:
'this could be a macro?
Function DosMenu.FlagSet(IsFlag As Integer) As Integer
   If (Flags And IsFlag) Then Return 1 'any non zero
   Return 0
End Function

'MAKE SCROLLABLE
Sub DosMenu.DrawMe()
   Dim As Integer x, y, PadL, PadR
   '
   Color this.MainFG, this.MainBG
   For x = 0 To this.TotItems - 1
      'ignore any seperators
      If this.DMI(x).Label <> "-" Then
         Locate x + this.LocX + 1, this.LocY + 2
         y = this.LongestItemLen - Len(this.DMI(x).Label)
         If this.FlagSet(DosMenu_Justify_Center) Then
            PadL = y\2
         Else
            'assume left
            PadL = 0
         EndIf
         PadR = y - PadL
         If x = this.Selected Then
            If this.FlagSet(DosMenu_FullRowSelect) Then
               Color SelFG, SelBG
               Print Space(PadL);
            Else
               Print Space(PadL);
               Color SelFG, SelBG
            EndIf
         Else
            Print Space(PadL); 'justify
         EndIf
         Print this.DMI(x).Label;
         If x = this.Selected Then
            If this.FlagSet(DosMenu_FullRowSelect) Then
               Print Space(PadR)
               Color this.MainFG, this.MainBG
            Else
               Color this.MainFG, this.MainBG
               Print Space(PadR)
            EndIf
         Else
            Print Space(PadR) 'justify
         EndIf
      EndIf
   Next
End Sub

'this will run if DosMenu_SubMenu_Cascade_AlignBoarder is NOT set or the first (main) menu
Sub DosMenu.InitDraw()
   'Boarders
   'left top, right top, vertical bar, vertical w/ tab for left side, vertical w/ tab for left side, horizontal bar, left bottom, right bottom
   Static As Integer Boarders(2, 7) => { _
   {32,32,32,32,32,32,32,32}, _
   {218,191,179,195,180,196,192,217}, _
   {201,187,186,204,185,205,200,188} _
   }
   Dim As Integer x, PadL, PadR
   '
   Color this.MainFG, this.MainBG
   'top line
   Locate this.LocX, this.LocY
   x = this.LongestItemLen - Len(this.Title)
   PadL = x\2
   PadR = x - PadL
   '
   '"user" and DosMenu_Loc_Center always overwrite (DosMenu_SubMenu_Cascade gets zeroed)
   Print Chr(Boarders(this.BoarderIdx, 0)); 'left top
   Print String(PadL, Boarders(this.BoarderIdx, 5)); 'h bar
   Print " ";this.Title;" "; 'ensure a space before and after
   Print String(PadR, Boarders(this.BoarderIdx, 5)); 'h bar
   Print Chr(Boarders(this.BoarderIdx, 1)) 'right top
   '
   For x = 0 To this.TotItems - 1
      Locate x + this.LocX + 1, this.LocY
      If this.DMI(x).Label <> "-" Then
         Print Chr(Boarders(this.BoarderIdx, 2));" " 'vertical bar
         '
         Locate x + this.LocX + 1, this.LocY + this.LongestItemLen + 2
         Print " ";Chr(Boarders(this.BoarderIdx, 2)) 'vertical bar
      Else
         'separator
         Print Chr(Boarders(this.BoarderIdx, 3)); 'vertical bar
         Print String(this.LongestItemLen + 2, Boarders(this.BoarderIdx, 5)); 'h bar
         Print Chr(Boarders(this.BoarderIdx, 4)) 'vertical bar
      EndIf
   Next
   'bottom line (use last x)
   Locate x + this.LocX + 1, this.LocY
   Print Chr(Boarders(this.BoarderIdx, 6)); 'bottom left
   Print String(this.LongestItemLen + 2, Boarders(this.BoarderIdx, 5)); 'h bar
   'line print continue needed for DosMenu_Loc_BottomRight
   Print Chr(Boarders(this.BoarderIdx, 7)); 'bottom right
End Sub

'WORK IN PROGRESS
'this will run if DosMenu_SubMenu_Cascade_AlignBoarder is set
Sub DosMenu.InitDraw_AlignBoarder()
   'Boarders
   'left top, right top, vertical bar, vertical w/ tab for left side, vertical w/ tab for left side, horizontal bar, left bottom, right bottom
   'horizontal bar tab up, horizontal bar tab down, cross
   Static As Integer Boarders(2, 10) => { _
   {32,32,32,32,32,32,32,32,32,32,32}, _
   {218,191,179,195,180,196,192,217,193,194,197}, _
   {201,187,186,204,185,205,200,188,202,203,206} _
   }
   Dim As Integer x, y, PadL, PadR
   '
   Color this.MainFG, this.MainBG
   'top line
   Locate this.LocX, this.LocY
   y = this.LongestItemLen - Len(this.Title)
   PadL = y\2
   PadR = y - PadL
   '
   '"user" and DosMenu_Loc_Center always overwrite (DosMenu_SubMenu_Cascade gets zeroed)
   y = 0
   If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
      'cascading submenu
      If this.CalcLoc = DosMenu_Loc_UpperLeft Then
         y = 3
         'if option above selected is a sep, then y = 10
         If this.Itemnum > 0 AndAlso this.Parent->DMI(this.ItemNum - 1).Label = "-" Then y = 10
      EndIf
      If this.CalcLoc = DosMenu_Loc_BottomLeft And this.Parent->TotItems <= this.Selected Then y = 3
   EndIf
   Print Chr(Boarders(this.BoarderIdx, y)); 'left top
   Print String(PadL, Boarders(this.BoarderIdx, 5)); 'h bar
   Print " ";this.Title;" "; 'ensure a space before and after
   Print String(PadR, Boarders(this.BoarderIdx, 5)); 'h bar
   y = 1
   If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
      'cascading submenu
      If this.CalcLoc = DosMenu_Loc_UpperRight Then
         y = 4
         'if option above selected is a sep, then y = 10
         If this.ItemNum > 0 AndAlso this.Parent->DMI(this.ItemNum - 1).Label = "-" Then y = 10
      EndIf
      If this.CalcLoc = DosMenu_Loc_BottomRight And this.Parent->TotItems <= this.Selected Then y = 4
   EndIf
   Print Chr(Boarders(this.BoarderIdx, y)) 'right top
   '
   For x = 0 To this.TotItems - 1
      Locate x + this.LocX + 1, this.LocY
      If this.DMI(x).Label <> "-" Then
         y = 2 'NOT DONE
         If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
            'cascading submenu
            If this.CalcLoc = DosMenu_Loc_UpperLeft Then
               If this.Parent->DMI(this.ItemNum - 1 + x).Label = "-" Then y = 4
            EndIf
            If this.CalcLoc = DosMenu_Loc_BottomLeft Then y = 3
         EndIf
         Print Chr(Boarders(this.BoarderIdx, y));" " 'vertical bar
         '
         Locate x + this.LocX + 1, this.LocY + this.LongestItemLen + 2
         y = 2 'NOT DONE
         If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
            'cascading submenu
            If this.CalcLoc = DosMenu_Loc_UpperRight Then y = 4
            If this.CalcLoc = DosMenu_Loc_BottomRight Then y = 4
         EndIf
         Print " ";Chr(Boarders(this.BoarderIdx, 2)) 'vertical bar
      Else
         'separator
         y = 3 'NOT DONE
         If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
            'cascading submenu
            If this.CalcLoc = DosMenu_Loc_UpperLeft Then y = 4
            If this.CalcLoc = DosMenu_Loc_BottomLeft Then y = 4
         EndIf
         Print Chr(Boarders(this.BoarderIdx, 3)); 'vertical bar
         Print String(this.LongestItemLen + 2, Boarders(this.BoarderIdx, 5)); 'h bar
         y = 4 'NOT DONE
         If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
            'cascading submenu
            If this.CalcLoc = DosMenu_Loc_UpperRight Then y = 4
            If this.CalcLoc = DosMenu_Loc_BottomRight Then y = 4
         EndIf
         Print Chr(Boarders(this.BoarderIdx, 4)) 'vertical bar
      EndIf
   Next
   'bottom line (use last x)
   Locate x + this.LocX + 1, this.LocY
   y = 6 'NOT DONE
   If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
      'cascading submenu
      If this.CalcLoc = DosMenu_Loc_UpperLeft Then y = 4
      If this.CalcLoc = DosMenu_Loc_BottomLeft Then y = 4
   EndIf
   Print Chr(Boarders(this.BoarderIdx, 6)); 'bottom left
   Print String(this.LongestItemLen + 2, Boarders(this.BoarderIdx, 5)); 'h bar
   y = 7 'NOT DONE
   If this.Parent <> 0 And this.FlagSet(DosMenu_SubMenu_Cascade) = 1 Then
      'cascading submenu
      If this.CalcLoc = DosMenu_Loc_UpperRight Then y = 4
      If this.CalcLoc = DosMenu_Loc_BottomRight Then y = 4
   EndIf
   Print Chr(Boarders(this.BoarderIdx, 7)) 'bottom right
End Sub

#EndIf

'test area
#Define Test_DosMenu 'comment out to disable test
#Ifdef Test_DosMenu

'dummy subs to call
Sub Sub1()
   'do something
   'this was just a single beep, but since it also indicates invalid keypress
   Locate 12, 60
   Print "BEEP"
   Sleep 500
   Locate 12, 60
   Print "    "
End Sub

Sub Sub2
   'do something
   For x As Integer = 1 To 2
      Beep
      Sleep 700
   Next
End Sub

Sub Sub3()
   'do something
   For x As Integer = 1 To 3
      Beep
      Sleep 700
   Next
End Sub

Sub Sub4
   'do something
   Beep
   Sleep 400
   Sub2
   Sleep 1000
   Sub3
End Sub

'put data on screen to test overwrites
Color 5,3 'odd color
Dim As Integer MyFlags
For MyFlags = 1 To 24
   Print String(79, "x")
Next

MyFlags = (DosMenu_Boarder_Single Or DosMenu_Default Or DosMenu_SubMenu_Cascade)
'test for all locations
'Dim As DosMenu MyMenu = DosMenu("Test Menu", DosMenu_Loc_UpperLeft, MyFlags)
'Dim As DosMenu MyMenu = DosMenu("Test Menu", DosMenu_Loc_UpperRight, MyFlags)
'Dim As DosMenu MyMenu = DosMenu("Test Menu", DosMenu_Loc_BottomLeft, MyFlags)
'Dim As DosMenu MyMenu = DosMenu("Test Menu", DosMenu_Loc_BottomRight, MyFlags)
'Dim As DosMenu MyMenu = DosMenu("Test Menu", DosMenu_Loc_Center, MyFlags)
Dim As DosMenu MyMenu = DosMenu("Test Menu", 5, 8, MyFlags)
Dim As DosMenu My_SubMenu = DosMenu("Test Sub Menu", @MyMenu)

MyMenu.DefineCallSub("Beep speaker once", "1", @Sub1) 'Might confuse with invalid input so print "BEEP"
MyMenu.DefineCallSub("Beep speaker twice", "2", @Sub2)
MyMenu.DefineCallSub("Beep speaker 3 times", "3", @Sub3)
MyMenu.DefineSep()
MyMenu.DefineCallMenu("Open test menu", "t", @My_SubMenu)
MyMenu.DefineSep()
MyMenu.DefineExit("Exit","x")

My_SubMenu.DefineCallSub("Beep weird", "w", @Sub4)
My_SubMenu.DefineCallSub("Beep speaker 3 times", "3", @Sub3) 'ran out of options....
My_SubMenu.DefineSep()
My_SubMenu.DefineExit("Exit","x")

MyMenu.Execute()
'DO NOT DO THIS --> My_SubMenu.Execute()
Sleep 2000

#EndIf

Return to “DOS”

Who is online

Users browsing this forum: No registered users and 3 guests