Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TOOLKIT.ZIP/MENU.TTT

Text File | 1986-09-28 | 13.3 KB | 338 lines

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                                                                           }
{           T E C H N O J O C K S     T U R B O    T O O L K I T            }
{                                                                           }
{                      Module   :   Menu.TTT                                }
{                                                                           }
{                      Version  :   3.0 , October 1, 1986                   }
{                                                                           }
{                      Purpose  :   Procedures for Menu creation            }
{                                                                           }
{                 Requirements  :   Decl.TTT                                }
{                                   FastWrit.TTT                            }
{                                   Window.ttt                              }
{                                   Misc.ttt                                }
{                                                                           }
{  Proc  DisplayMenu(MenuDef:Menu_record;                                   }
{                    Window:Boolean                                         }
{                    var Choice,Errorcode : integer);                       }
{                                                                           }
{                                                                           }
{                                                Bob Ainsbury               }
{                                                Technojock                 }
{                                                Houston                    }
{                                                [phone]             }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

Procedure DisplayMenu(MenuDef:Menu_record;Window:Boolean;
                          var Choice,Errorcode : integer);
Const
Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Numbers  = '123456789';
var
I,J,X2,Y2 : integer;
TextWidth : byte;

   Procedure GetDimensions;
   var Fullwidth,Fulldepth: integer;

     Procedure CheckPrefix;         { 0   no prefix  }
     begin                          { 1   numbers prefix}
     with MenuDef do                { 2   letters prefix}
     begin                          { 3   function key prefix}
      If PicksPerLine < 1 then PicksPerLine := 1;
      If (AddPrefix = 1) and (TotalPicks = 10) then
        AddPrefix := 3;
      If (AddPrefix in [1,3]) and (TotalPicks > 10) then
        AddPrefix := 2;
      If (Addprefix > 3) or (TotalPicks > 26) or (Addprefix < 0) then
       Addprefix := 0;
     end; {do}
     end; {CheckPrefix}

     Procedure FindWidestLine;
     var extra : integer;
     begin
     with MenuDef do
      begin
       Textwidth := 0;
       For I := 1 to TotalPicks do
        If length(Text[I]) > TextWidth then
         Textwidth := length(Text[I]);         {find the longest text}
       Case AddPrefix of
       0   : Extra := 0;
       1,2 : Extra := 2;
       3   : If TotalPicks < 10 then
               Extra := 3
              else
               Extra := 4;
       end;  {case}
       TextWidth := TextWidth + Extra;
       If TextWidth > 80 then  {at least one of the lines is > 80 chars}
        For J := I to TotalPicks do
         If length(text[J]) - 80 - Extra> 0 then
          Delete(Text[J],81,length(text[J]) - 80 - Extra);
       If length(heading) - 80 > 0 then
         Delete(Heading,81,length(heading) - 80);
       If length(Heading) > Textwidth*PicksPerLine + PicksPerLine + 1 then
        Textwidth := (length(Heading) - PicksPerLine - 1) div PicksPerLine;
      end;
     end;   {Proc FindWidestLine}

   Procedure Prefix;
   begin
   With MenuDef do
   begin
   Case AddPrefix of
   1 : for I := 1 to TotalPicks do
        Text[I] := int_to_str(I) + ' ' + Text[I];
   2 : for I := 1 to TotalPicks do
        Text[I] := Copy(Alphabet,I,1) + ' ' + Text[I];
   3 : If TotalPicks < 10 then
        for I := 1 to TotalPicks do
         Text[I] := 'F'+Int_to_Str(I) + ' ' + Text[I]
       else
       begin                           {add extra space for F10 }
        for I := 1 to 9 do
         Text[I] := 'F'+Int_to_Str(I) + '  ' + Text[I];
        Text[10] := 'F10 '+ Text[10];
       end;
   end; {case}
   end;  {do}
   end;

   Procedure LengthenText;
   var J : integer;
   begin
   With MenuDef do
   begin
    For I := 1 to TotalPicks do
     For J := length(Text[I]) + 1 to Textwidth do
      Text[I] :=  Text[I] + ' ';
   end; {do}
   end;

   begin                              {Get_Dimensions}
   CheckPrefix;
   FindWidestLine;
   With MenuDef do
   begin
    If (Addprefix > 0) then Prefix;
    LengthenText;
    {determine sensible values for left and right columns}
    If TextWidth*PicksPerLine + PicksPerLine + 1 > 80 then  {check picks fit }
    begin
     Repeat
      PicksPerLine := PicksPerLine - 1;
     Until TextWidth*PicksPerLine + PicksPerLine + 1 <= 80;
    end;

    If TextWidth*PicksPerLine + PicksPerLine + 1 > 78 then   {check box fits}
     BoxType := 0;
    Fullwidth := Textwidth*PicksPerLine + PicksPerLine + 1;
    If BoxType > 0 then                               {add 2 to width if box }
     Fullwidth := Fullwidth + 2;
    If TopleftXY[1] = 0 then
     TopleftXY[1] := (80 - Fullwidth) div 2;
    If TopLeftXY[1] + Fullwidth <= 80 then
     X2 := TopleftXY[1] + Fullwidth
    else
    begin
     X2 := 80;
     TopLeftXY[1] := 80 - Fullwidth + 1;
    end;
    {determine sensible values for top and bottom rows}
    Fulldepth := TotalPicks div PicksPerLine;   {no of full rows of picks}
    If TotalPicks mod PicksPerLine > 0 then     {+1 if partial row of picks}
     Fulldepth := Fulldepth + 1;
    If Fulldepth > 23 then Heading := '';       {check there is room for head}
    If length(Heading) > 0 then
     Fulldepth := fulldepth + 2;                { add 1 for blank line }
    If Fulldepth > 25 then
    begin
     TotalPicks := 25 * PicksPerLine;
     Fulldepth := 25;
    end;
    If Fulldepth > 23 then BoxType := 0;
    If BoxType <> 0 then Fulldepth := Fulldepth + 2;
    If TopLeftXY[2] <= 0 then
     TopLeftXY[2] := (25 - Fulldepth) div 2 +1;
    If TopLeftXY[2] + Fulldepth - 1 <= 25 then
     Y2 := TopleftXY[2] + Fulldepth - 1
    else
    begin
     Y2 := 25;
     TopLeftXY[2] := 25 - Fulldepth + 1;
    end;
   end;   {do}
   end;   {proc GetDimensions}

   Procedure Write_Text(Item:integer;Highlight:boolean);
   Var X,Y,A:integer;
   begin
   With MenuDEf do
   begin
    A := Item mod PicksPerLine;
    Y := Item div PicksPerLine +TopleftXY[2] - 1;
    If A  <> 0 then
     Y := Y + 1;
    If BoxType > 0 then Y := Y + 1;               {add 1 for top box line    }
    If length(Heading) > 0 then Y := Y + 2 ;      {add 2 for space and header}
    If A = 0 then A := PicksPerLine;      {A is now the no of picks from left}
    X := (A - 1)*(TextWidth + 1)+ TopleftXY[1]+1;{title width + 1 for a space}
    If Boxtype > 0 then X := X + 1;              {add 1 for the left box line}
    If Highlight then
     WriteAt(X,Y,colors[1],colors[2],text[item])
    else
     WriteAT(X,Y,colors[3],colors[4],text[item]);
   end;  {do}
   end;  {Proc Write_Text}

   Procedure CreateMenu;
   begin
   with MenuDef do
   begin
    If Window then
     MkWin(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[3],colors[4],0)
    else
     ClearText(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[3],colors[4]);
    If (Boxtype > 0) and (Boxtype <= 4) then
     Box(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[5],colors[4],Boxtype);
    If length(Heading) > 0 then
     WriteBetween
     (TopleftXY[1],X2,TopLeftXY[2]+1,colors[5],colors[4],Heading);
    For I := 1 to TotalPicks do
     Write_Text(I,false);
    Write_Text(Choice,True);       {Highlight Default}
   end; {do}
   end; {Proc CreateMenu}

   Procedure Process_Keystrokes;
   var Selected: Boolean;CHpk:char;Oldchoice:integer;
   begin
   Selected := false;
   With MenuDef do
   begin
    Repeat
     Wait_for_Keypress(CHpk);
     If CHpk  in [' ',Esckey,EnterKey] then funckey := true;
     If Funckey = true then
     begin
      Case Upcase(CHpk) of
      CursorDown         : begin
                            Write_text(Choice,false);
                            Choice := Choice + PicksPerLine;
                            If Choice > TotalPicks then
                             Choice := (Choice mod PicksPerLine) + 1;
                            Write_Text(Choice,true);
                           end;
      CursorUp           : begin
                            Write_Text(Choice,false);
                            Choice := Choice - PicksPerLine;
                            If Choice < 1 then
                            begin
                             Choice := Choice + PicksPerline;
                             Choice :=
                             ((TotalPicks div PicksPerLine)*PicksPerLine)
                             - PicksPerLine + 1 + Choice - 2;
                             If Choice + PicksPerLine <= TotalPicks then
                              Choice := Choice + PicksPerLine;   {phew!}
                            end;
                            Write_Text(Choice,true);
                           end;
      CursorLeft         : begin
                            Write_Text(Choice,False);
                            Choice := choice - 1;
                            If choice = 0 then Choice := PicksPerLine;
                            Write_Text(Choice,true);
                           end;
      ' ',
      CursorRight        : begin
                            Write_Text(Choice,false);
                            Choice := Choice + 1;
                            If choice > TotalPicks then Choice := 1;
                            Write_Text(Choice,true);
                           end;
      HomeKey            : begin
                            Write_Text(Choice,false);
                            Choice := 1;
                            Write_Text(Choice,true);
                           end;
      Endkey             : begin
                            Write_Text(Choice,false);
                            Choice := TotalPicks;
                            Write_Text(Choice,true);
                           end;
      EnterKey           : begin
                            Selected := true;
                            Errorcode := 0;
                           end;
      EscKey             : If AllowEsc then
                           begin
                            Selected := true;
                            ErrorCode := 99;
                           end;
      F1,F2,F3,F4,F5,
      F6,F7,F8,F9,F10    : If Addprefix = 3 then
                           begin
                            Oldchoice := Choice;
                            Case Upcase(Chpk) of
                            F1 : If TotalPicks >= 1  then choice := 1 else choice := 0;
                            F2 : If TotalPicks >= 2  then choice := 2 else choice := 0;
                            F3 : If TotalPicks >= 3  then choice := 3 else choice := 0;
                            F4 : If TotalPicks >= 4  then choice := 4 else choice := 0;
                            F5 : If TotalPicks >= 5  then choice := 5 else choice := 0;
                            F6 : If TotalPicks >= 6  then choice := 6 else choice := 0;
                            F7 : If TotalPicks >= 7  then choice := 7 else choice := 0;
                            F8 : If TotalPicks >= 8  then choice := 8 else choice := 0;
                            F9 : If TotalPicks >= 9  then choice := 9 else choice := 0;
                            F10: If TotalPicks >= 10 then choice := 10 else choice := 0;
                            end;  {case}
                            If Choice = 0 then
                             Choice := Oldchoice
                            else
                            begin
                             Write_Text(Oldchoice,false);
                             Write_Text(Choice,true);
                             Selected := true;
                             Errorcode := 0;
                            end;
                           end;
      end; {case}
     end   {Funckey true}
     else  {funkey false}
     begin
      If (AddPrefix in [1,3]) then   {Number or Function Prefix}
      begin
       If (Str_to_int(CHpk) in [1..TotalPicks]) then
       begin
        Write_Text(Choice,false);
        Choice := Str_to_Int(CHpk);
        Write_Text(Choice,true);
        Selected := true;
        ErrorCode := 0;
       end;
      end
      else                     {Letter Prefix}
       If AddPrefix = 2 then
        If (pos(upcase(CHpk),Alphabet) in [1..TotalPicks]) then
        begin
         Write_Text(Choice,false);
         Choice := pos(upcase(CHpk),Alphabet);
         Write_Text(Choice,true);
         Selected := true;
         Errorcode := 0;
        end;
     end;
    Until Selected;
   end; {do}
   end; {proc Process_keystrokes}

begin
GetDimensions;
CreateMenu;
Process_Keystrokes;
If Window then RmWin;
end;        {Main Procedure DisplayMenu}