home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURMENU.ZIP / EDITMEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-03-01  |  45.3 KB  |  1,795 lines
  1. Program EditMenu;
  2.   {$C-,V-}
  3.   { ------------------------------------------------------------------------
  4.   This program is edit and create menu files that are to be used by the
  5.   TURMENU program.  The files could be copies of WANG PC menu, but this
  6.   utility should not be used to edit menu files to be used on a WANG PC.
  7.   ------------------------------------------------------------------------ }
  8.   {*Include File     STRING.INC ***** START *****}
  9.   {- Declare standard string types for function/procedure calling }
  10.   {- sequence.                                                    }
  11.  
  12.  Type
  13.   Str1=String[1];                           { Turbo Pascal requires that     }
  14.   Str2=String[2];                           { all parameters have a declared }
  15.   Str3=String[3];                           { type.  Since strings of varying}
  16.   Str4=String[4];                           { length must have different type}
  17.   Str5=String[5];                           { this file exists to be included}
  18.   Str6=String[6];                           { to make sure that the string   }
  19.   Str7=String[7];                           { types are declared.            }
  20.   Str8=String[8];                           { .............................. }
  21.   Str9=String[9];                           { .............................. }
  22.   Str10=String[10];                         { .............................. }
  23.   Str80=String[80];                         { 80 char string                 }
  24.   Str255=String[255];                       { Maximum string                 }
  25.  
  26.  
  27.   {*Include File End STRING.INC ***** END *****}
  28.  
  29.   {*Include File     ATTKBD.CON ***** START *****}
  30.  
  31.   { ***************************************************************** }
  32.   { ATT PC Keyboard definitions }
  33.   { ***************************************************************** }
  34.  
  35.  Const
  36.   RETURN_Key=#$0D;
  37.   BACKSPACE_Key=#$08;
  38.   ESCAPE_Key=#$1B;
  39.   BEEP_Key=#$07;
  40.   PREAMBLE_Key=#$00;
  41.   PREAMBLE_Byte=$00;
  42.   UP_Key=#$48;
  43.   DOWN_Key=#$50;
  44.   RIGHT_Key=#$4D;
  45.   LEFT_Key=#$4B;
  46.   HOME_Key=#$47;
  47.   INSERT_Key=#$52;
  48.   DELETE_Key=#$53;
  49.   PageDwn_Key=#$51;
  50.   PageUp_Key=#$49;
  51.   END_Key=#$4F;
  52.   TAB_Key=#$09;
  53.   BACKTAB_Key=#$0F;
  54.  
  55.   CTRL_LEFT_Key=#$73;
  56.   CTRL_RIGHT_Key=#$74;
  57.   CTRL_END_Key=#$75;
  58.   CTRL_PageDwn_Key=#$76;
  59.   CTRL_HOME_Key=#$77;
  60.   CTRL_PageUp_Key=#$84;
  61.  
  62.   SFKey01=#$3B;
  63.   SFKey02=#$3C;
  64.   SFKey03=#$3D;
  65.   SFKey04=#$3E;
  66.   SFKey05=#$3F;
  67.   SFKey06=#$40;
  68.   SFKey07=#$41;
  69.   SFKey08=#$42;
  70.   SFKey09=#$43;
  71.   SFKey10=#$44;
  72.  
  73.   Shift_SFKey01=#$54;
  74.   Shift_SFKey02=#$55;
  75.   Shift_SFKey03=#$56;
  76.   Shift_SFKey04=#$57;
  77.   Shift_SFKey05=#$58;
  78.   Shift_SFKey06=#$59;
  79.   Shift_SFKey07=#$5A;
  80.   Shift_SFKey08=#$5B;
  81.   Shift_SFKey09=#$5C;
  82.   Shift_SFKey10=#$5D;
  83.  
  84.   Alt_SFKey01=#$68;
  85.   Alt_SFKey02=#$69;
  86.   Alt_SFKey03=#$6A;
  87.   Alt_SFKey04=#$6B;
  88.   Alt_SFKey05=#$6C;
  89.   Alt_SFKey06=#$6D;
  90.   Alt_SFKey07=#$6E;
  91.   Alt_SFKey08=#$6F;
  92.   Alt_SFKey09=#$70;
  93.   Alt_SFKey10=#$71;
  94.  
  95.   { ***************************************************************** }
  96.  
  97.  
  98.   {*Include File End ATTKBD.CON ***** END *****}
  99.   {*Include File     SCAN.INC ***** START *****}
  100.  Function Read_Char(Var extend:Boolean):Char;
  101.   Type
  102.    Register=Record Case Boolean Of
  103.     True:(ax,bx,cx,dx,bp,si,di,ds,es,flags:Integer);
  104.     False:(al,ah,bl,bh,cl,ch,dl,dh:Byte);
  105.             End;
  106.   Var
  107.    Regs:Register;
  108.   Begin
  109.    With Regs Do
  110.     Begin
  111.      ah:=$07;
  112.      MsDos(Regs);
  113.      If al=PREAMBLE_Byte Then
  114.       Begin
  115.        extend:=True;
  116.        MsDos(Regs);
  117.       End
  118.      Else
  119.       extend:=False;
  120.      Read_Char:=Chr(al);
  121.     End;
  122.   End;
  123.  
  124.   {*Include File End SCAN.INC ***** END *****}
  125.   {*Include File     CENTER.INC ***** START *****}
  126.  Function Center(x,y:Integer):Integer;
  127.    { function to return centered position of something of length y in
  128.    a field of width x.                                              }
  129.  
  130.   Begin
  131.    If (y>x) Then
  132.     Center:=0
  133.    Else
  134.     Center:=((x-y)+1) Shr 1;
  135.   End;
  136.  
  137.   {*Include File End CENTER.INC ***** END *****}
  138.   {*Include File     INPUTUTI.INC ***** START *****}
  139.  Type
  140.   CharSet=Set Of Char;
  141.  
  142.  
  143.   {  UpcaseStr converts a string to upper case }
  144.  
  145.  Function UpcaseStr(S:Str80):Str80;
  146.   Var
  147.    P:Integer;
  148.   Begin
  149.    For P:=1 To Length(S) Do
  150.     S[P]:=UpCase(S[P]);
  151.    UpcaseStr:=S;
  152.   End;
  153.  
  154.   {  ConstStr returns a string with N characters of value C }
  155.  
  156.  Function ConstStr(C:Char;N:Integer):Str80;
  157.   Var
  158.    S:String[80];
  159.   Begin
  160.    If N<0 Then
  161.     N:=0;
  162.    S[0]:=Chr(N);
  163.    FillChar(S[1],N,C);
  164.    ConstStr:=S;
  165.   End;
  166.  
  167.   {  Beep sounds the terminal bell or beeper }
  168.  
  169.  Procedure Beep;
  170.   Begin
  171.    Write(BEEP_Key);
  172.   End;
  173.  
  174.  
  175.  Procedure InputStr(Var S:Str255;
  176.                     L,x,y:Integer;
  177.                     Term:CharSet;
  178.                     Var TC:Char);
  179.   Var
  180.    P:Integer;
  181.    ch:Char;
  182.    Special:Boolean;
  183.    InsertMode:Boolean;
  184.   Begin
  185.    NormVideo;
  186.    If Length(S)>L Then
  187.     S:=Copy(S,1,L);
  188.    GoToXY(x,y);Write(S,ConstStr('_',L-Length(S)));
  189.    InsertMode:=True;
  190.    P:=0;
  191.    Repeat
  192.     GoToXY(x+P,y);ch:=Read_Char(Special);
  193.     If Not Special Then
  194.      Begin
  195.       Case ch Of
  196.        #32..#126:If P<L Then
  197.                   Begin
  198.                    Case InsertMode Of
  199.                     True:Begin
  200.                           If Length(S)=L Then
  201.                            Delete(S,L,1);
  202.                           P:=P+1;
  203.                           Insert(ch,S,P);
  204.                           Write(Copy(S,P,L));
  205.                           If P=L Then P:=P-1;
  206.                          End;
  207.                     False:Begin
  208.                            P:=P+1;
  209.                            If P<=Length(S) Then
  210.                             Delete(S,P,1);
  211.                            Insert(ch,S,P);
  212.                            Write(Copy(S,P,L));
  213.                            If P=L Then P:=P-1;
  214.                           End;
  215.                    End;                     { case Insert Mode }
  216.                   End;
  217.  
  218.        BACKSPACE_Key:If P>0 Then
  219.                       Begin
  220.                        Delete(S,P,1);
  221.                        Write(BACKSPACE_Key,Copy(S,P,L),'_':1);
  222.                        P:=P-1;
  223.                       End
  224.                      Else Beep;
  225.       Else
  226.        If Not(ch In Term) Then Beep;
  227.       End;                                  { of case }
  228.      End
  229.     Else
  230.      Begin
  231.       Case ch Of
  232.        LEFT_Key:If P>0 Then
  233.                  P:=P-1
  234.                 Else Beep;
  235.        RIGHT_Key:If P<Length(S) Then
  236.                   P:=P+1
  237.                  Else Beep;
  238.        INSERT_Key:InsertMode:=Not InsertMode;
  239.        HOME_Key:P:=0;
  240.        END_Key:P:=Length(S);
  241.        DELETE_Key:If P<Length(S) Then
  242.                    Begin
  243.                     Delete(S,P+1,1);
  244.                     Write(Copy(S,P+1,L),'_':1);
  245.                    End;
  246.        CTRL_END_Key:Begin
  247.                      Write(ConstStr('_',Length(S)-P));
  248.                      Delete(S,P+1,L);
  249.                     End;
  250.       Else
  251.        Beep;
  252.       End;                                  {of case}
  253.      End;
  254.    Until ch In Term;
  255.    P:=Length(S);
  256.    GoToXY(x+P,y);
  257.    If L>P Then Write(ConstStr('_',L-P));
  258.    TC:=ch;
  259.    LowVideo;
  260.   End;
  261.  
  262.  
  263.  Procedure Select(Prompt:Str80;
  264.                   Term:CharSet;
  265.                   Var TC:Char);
  266.   Var
  267.    ch:Char;
  268.    Special:Boolean;
  269.   Begin
  270.    GoToXY(1,23);Write(Prompt,'? ');ClrEol;
  271.    Repeat
  272.     ch:=Read_Char(Special);
  273.     TC:=UpCase(ch);
  274.     If Not(TC In Term) Then
  275.      Beep;
  276.    Until TC In Term;
  277.    Case ch Of
  278.     #32..#126:Write(TC);
  279.    End;
  280.   End;
  281.  
  282.  Procedure ClearLines(F,L:Integer);
  283.   Var
  284.    I:Integer;
  285.   Begin
  286.    For I:=F To L Do
  287.     Begin
  288.      GoToXY(1,I);ClrEol;
  289.     End;
  290.   End;
  291.  
  292.  
  293.   {*Include File End INPUTUTI.INC ***** END *****}
  294.   {*Include File     MESSAGE.INC ***** START *****}
  295.  Procedure Message(S:Str80);
  296.   Begin
  297.    GoToXY(1,25);ClrEol;
  298.    If Length(S)>0 Then
  299.     Begin
  300.      NormVideo;
  301.      Write('ERROR: ',S);
  302.      LowVideo;
  303.      Beep;
  304.     End;
  305.   End;
  306.  
  307.   {*Include File End MESSAGE.INC ***** END *****}
  308.   {*Include File     MENUREC.INC ***** START *****}
  309.  Type
  310.  
  311.   PromptField=Record
  312.                x,y:Integer;
  313.                Txt:String[80];
  314.               End;
  315.  
  316.   Path=String[50];
  317.   Headers=Array[1..3] Of PromptField;
  318.  
  319.   FileName=Record
  320.             Name:String[8];
  321.             Ext:String[3];
  322.            End;
  323.  
  324.   ParmsField=String[50];
  325.  
  326.   BlockByte=Record
  327.              o:Byte;
  328.              b:Byte;
  329.             End;
  330.  
  331.   MenuIndex=Array[0..51] Of BlockByte;
  332.   HelpIndex=Array[0..528] Of BlockByte;
  333.  
  334.   MenuEntry=Record
  335.              Prompt:PromptField;
  336.              DirPath:Path;
  337.              Fname:FileName;
  338.              Parms:ParmsField;
  339.              Help:Integer;
  340.              Flag:Integer;
  341.              Drive:String[2];
  342.             End;
  343.  
  344.   WMenuPtr=^WMenu;
  345.   WMenu=Record
  346.          EntryCount:Integer;
  347.          Line:Headers;
  348.          DisplayEntry:Array[1..24] Of MenuEntry;
  349.         End;
  350.  
  351.   HelpScreen=Record
  352.               HLine:Array[1..22] Of PromptField;
  353.              End;
  354.  
  355.   WHelpPtr=^WHelp;
  356.   WHelp=Record
  357.          LastHelp:Integer;
  358.          Htxt:Array[1..24] Of HelpScreen;
  359.         End;
  360.  
  361.   bytechar=Record Case Boolean Of
  362.    True:(C:Char);
  363.    False:(b:Byte);
  364.            End;
  365.  
  366.   MenuPointer=^MenuBuffer;
  367.   MenuBuffer=Record
  368.               Buf:Array[1..5,0..255] Of bytechar;
  369.              End;
  370.  
  371.   HelpPointer=^HelpBuffer;
  372.   HelpBuffer=Record
  373.               Buf:Array[1..187,0..255] Of bytechar;
  374.              End;
  375.  
  376.   ByteFile=File;
  377.  
  378.   Screen=Array[1..24] Of String[80];
  379.  
  380.  
  381.  Const
  382.   Term1:Set Of Char=[RETURN_Key,ESCAPE_Key];
  383.   Term2:Set Of Char=[RETURN_Key,ESCAPE_Key,TAB_Key];
  384.  
  385.  
  386.   {*Include File End MENUREC.INC ***** END *****}
  387.   {*Include File     SCREEN.INC ***** START *****}
  388.  Const
  389.   ScreenWidth=80;
  390.  
  391.  
  392.  Procedure InputScreen(Var S:Screen;
  393.                        F,L:Integer;
  394.                        Term:CharSet;
  395.                        Var TC:Char);
  396.   Var
  397.    x,y,P:Integer;
  398.    ch:Char;
  399.    Special:Boolean;
  400.    InsertMode:Boolean;
  401.   Begin
  402.    NormVideo;
  403.    For P:=F To L Do
  404.     Begin
  405.      GoToXY(1,P);ClrEol;Write(S[P],ConstStr('_',ScreenWidth-Length(S[P])));
  406.     End;
  407.    InsertMode:=True;
  408.    P:=0;
  409.    x:=1;
  410.    y:=F;
  411.    Repeat
  412.     GoToXY(x+P,y);ch:=Read_Char(Special);
  413.     If Not Special Then
  414.      Begin
  415.       Case ch Of
  416.        #32..#126:If P<ScreenWidth Then
  417.                   Begin
  418.                    Case InsertMode Of
  419.                     True:Begin
  420.                           If Length(S[y])=ScreenWidth Then
  421.                            Delete(S[y],ScreenWidth,1);
  422.                           P:=P+1;
  423.                           Insert(ch,S[y],P);
  424.                           Write(Copy(S[y],P,ScreenWidth));
  425.                           If P=ScreenWidth Then P:=P-1;
  426.                          End;
  427.                     False:Begin
  428.                            P:=P+1;
  429.                            If P<=Length(S[y]) Then
  430.                             Delete(S[y],P,1);
  431.                            Insert(ch,S[y],P);
  432.                            Write(Copy(S[y],P,ScreenWidth));
  433.                            If P=ScreenWidth Then P:=P-1;
  434.                           End;
  435.                    End;
  436.                   End;
  437.  
  438.        RETURN_Key:Begin
  439.                    If y<L Then
  440.                     y:=y+1
  441.                    Else y:=F;
  442.                    P:=0;
  443.                   End;
  444.  
  445.        BACKSPACE_Key:If P>0 Then
  446.                       Begin
  447.                        Delete(S[y],P,1);
  448.                        Write(BACKSPACE_Key,Copy(S[y],P,ScreenWidth),'_':1);
  449.                        P:=P-1;
  450.                       End
  451.                      Else Beep;
  452.       Else
  453.        If Not(ch In Term) Then Beep;
  454.       End;
  455.      End
  456.     Else
  457.      Begin
  458.       Case ch Of
  459.        LEFT_Key:If P>0 Then
  460.                  P:=P-1
  461.                 Else Beep;
  462.        RIGHT_Key:If P<Length(S[y]) Then
  463.                   P:=P+1
  464.                  Else Beep;
  465.        UP_Key:If y>F Then
  466.                y:=y-1
  467.               Else Beep;
  468.        PageUp_Key:y:=F;
  469.        INSERT_Key:InsertMode:=Not InsertMode;
  470.        DOWN_Key:If y<L Then
  471.                  y:=y+1
  472.                 Else Beep;
  473.        PageDwn_Key:y:=L;
  474.        HOME_Key:P:=0;
  475.        END_Key:P:=Length(S[y]);
  476.        DELETE_Key:If P<Length(S[y]) Then
  477.                    Begin
  478.                     Delete(S[y],P+1,1);
  479.                     Write(Copy(S[y],P+1,ScreenWidth),'_':1);
  480.                    End;
  481.        CTRL_END_Key:Begin
  482.                      Write(ConstStr('_',Length(S[y])-P));
  483.                      Delete(S[y],P+1,ScreenWidth);
  484.                     End;
  485.       Else
  486.        Beep;
  487.       End;                                  {of case}
  488.      End;
  489.    Until (ch In Term);
  490.    TC:=ch;
  491.    LowVideo;
  492.   End;
  493.  
  494.  Procedure OutScreen(Var S:Screen;F,L:Integer);
  495.   Var
  496.    I:Integer;
  497.   Begin
  498.    For I:=F To L Do
  499.     Begin
  500.      GoToXY(1,I);ClrEol;Write(S[I]);
  501.     End;
  502.   End;
  503.  
  504.   {*Include File End SCREEN.INC ***** END *****}
  505.   {*Include File     HANDLE.INC ***** START *****}
  506.   {  The Following functions were written to take care of the ReadBlock
  507.   bug in Turbo V3.0.  The FileHandle function returns the MSDOS file
  508.   handle to be used in reading from a file.  The DosBlockRead function
  509.   will attempt to read Recs number of bytes from a file with handle
  510.   FileH.  If no error occurs then the number of bytes read will be
  511.   return in Result, otherwise Result will be -1.
  512.  
  513.   Gary W. Miller
  514.   70127,3674    Compuserve
  515.  
  516.   }
  517.  
  518.  Function FileHandle(Var FilVar):Integer;
  519.   Var
  520.    H:Integer Absolute FilVar;
  521.   Begin
  522.    FileHandle:=H;
  523.   End;
  524.  
  525.  
  526.  Procedure DosBlockRead(FileH:Integer;Var buffer;Recs:Integer;Var Result:Integer);
  527.   Type
  528.    DosRegs=Record Case Integer Of
  529.     1:(ax,bx,cx,dx,bp,si,di,ds,es,flags:Integer);
  530.     2:(al,ah,bl,bh,cl,ch,dl,dh:Byte);
  531.            End;
  532.   Var
  533.    Regs:DosRegs;
  534.   Begin
  535.    With Regs Do
  536.     Begin
  537.      ds:=Seg(buffer);                       { location of Buffer segment }
  538.      dx:=Ofs(buffer);                       {                    offset  }
  539.      cx:=Recs;                              { number of bytes to read    }
  540.      ah:=$3f;                               { Read File or Device Code   }
  541.      bx:=FileH;                             { Pass file handle           }
  542.     End;
  543.    MsDos(Regs);                             { do it , close your eyes    }
  544.    With Regs Do
  545.     Begin
  546.      If (flags And 1)<>0 Then
  547.       Result:=-1                            { crap, we blew it           }
  548.      Else
  549.       Result:=ax;                           { tell me what you read      }
  550.     End;
  551.   End;
  552.  
  553.  
  554.  Procedure DosBlockWrite(FileH:Integer;Var buffer;Recs:Integer;Var Result:Integer);
  555.   Type
  556.    DosRegs=Record Case Integer Of
  557.     1:(ax,bx,cx,dx,bp,si,di,ds,es,flags:Integer);
  558.     2:(al,ah,bl,bh,cl,ch,dl,dh:Byte);
  559.            End;
  560.   Var
  561.    Regs:DosRegs;
  562.   Begin
  563.    With Regs Do
  564.     Begin
  565.      ds:=Seg(buffer);                       { location of Buffer segment }
  566.      dx:=Ofs(buffer);                       {                    offset  }
  567.      cx:=Recs;                              { number of bytes to write   }
  568.      ah:=$40;                               { Write File or Device Code  }
  569.      bx:=FileH;                             { Pass file handle           }
  570.     End;
  571.    MsDos(Regs);                             { do it , close your eyes    }
  572.    With Regs Do
  573.     Begin
  574.      If (flags And 1)<>0 Then
  575.       Result:=-1                            { crap, we blew it           }
  576.      Else
  577.       Result:=ax;                           { tell me what you wrote     }
  578.     End;
  579.   End;
  580.  
  581.  
  582.   {*Include File End HANDLE.INC ***** END *****}
  583.  
  584.  Var
  585.   FooMenu:WMenuPtr;
  586.   FooHelp:WHelpPtr;
  587.   FooMBuf:MenuPointer;
  588.   FooHBuf:HelpPointer;
  589.   MenuName:String[80];
  590.   HelpName:String[80];
  591.   MenuFile:ByteFile;
  592.   HelpFile:ByteFile;
  593.   TC:Char;
  594.   I:Integer;
  595.   Help:Boolean;
  596.   Ok:Boolean;
  597.   Create:Boolean;
  598.   LastHelp:Integer;
  599.   SelEntry:Integer;
  600.   SelFun:Integer;
  601.  
  602.  
  603.   {*Include File     OUTCHOIC.INC ***** START *****}
  604.  Procedure DisplayChoice(Var Foo;MaxEntry:Integer;Flag:Integer);
  605.   Type
  606.    DisplayTable=Array[0..10] Of PromptField;
  607.   Var
  608.    ScrTxt:DisplayTable Absolute Foo;
  609.    k:Integer;
  610.   Begin
  611.    MaxEntry:=MaxEntry-1;
  612.    For k:=0 To MaxEntry Do
  613.     Begin
  614.      If k=Flag Then
  615.       Begin
  616.        NormVideo;
  617.        With ScrTxt[k] Do
  618.         Begin
  619.          GoToXY(x,y);Write(Txt);
  620.          LowVideo;
  621.         End;
  622.       End
  623.      Else
  624.       With ScrTxt[k] Do
  625.        Begin
  626.         GoToXY(x,y);Write(Txt);
  627.        End;
  628.     End;                                    { For k = 0 to MaxEntry }
  629.   End;
  630.  
  631.  Procedure MakeChoice(Var Foo;
  632.                       MaxEntry:Integer;
  633.                       Var Flag:Integer;
  634.                       Var TC:Char);
  635.   Type
  636.    DisplayTable=Array[0..10] Of PromptField;
  637.   Var
  638.    ScrTxt:DisplayTable Absolute Foo;
  639.    Special:Boolean;
  640.  
  641.   Begin
  642.    MaxEntry:=MaxEntry-1;
  643.    Repeat
  644.     With ScrTxt[Flag] Do
  645.      GoToXY(x-1,y);
  646.     TC:=Read_Char(Special);
  647.     If Not(TC In Term2) Then
  648.      Case TC Of
  649.       #$20:Begin
  650.             LowVideo;
  651.             With ScrTxt[Flag] Do
  652.              Begin
  653.               GoToXY(x,y);Write(Txt);
  654.               NormVideo;
  655.              End;
  656.             Flag:=Flag+1;
  657.             If Flag>MaxEntry Then Flag:=0;
  658.             With ScrTxt[Flag] Do
  659.              Begin
  660.               GoToXY(x,y);Write(Txt);
  661.               LowVideo;
  662.              End;
  663.            End;
  664.  
  665.       #$08:Begin
  666.             LowVideo;
  667.             With ScrTxt[Flag] Do
  668.              Begin
  669.               GoToXY(x,y);Write(Txt);
  670.               NormVideo;
  671.              End;
  672.             Flag:=Flag-1;
  673.             If Flag<0 Then Flag:=MaxEntry;
  674.             With ScrTxt[Flag] Do
  675.              Begin
  676.               GoToXY(x,y);Write(Txt);
  677.               LowVideo;
  678.              End;
  679.            End;
  680.      Else
  681.       Beep;
  682.      End;                                   { case TC of }
  683.    Until (TC In Term2);
  684.   End;
  685.  
  686.  
  687.   {*Include File End OUTCHOIC.INC ***** END *****}
  688.   {*Include File     MENUENTR.INC ***** START *****}
  689.  Const
  690.   FlagTxt:Array[0..5] Of PromptField=
  691.   ((x:23;y:22;Txt:'Menu'),(x:38;y:22;Txt:'Program'),(x:8;y:23;Txt:'Other'),
  692.   (x:23;y:23;Txt:'System Func'),(x:38;y:23;Txt:'Command.com'),
  693.   (x:8;y:22;Txt:'Batch Stream'));
  694.  
  695.  Procedure OutEntry(Var Line:MenuEntry);
  696.   Var
  697.    k:Integer;
  698.   Begin
  699.    With Line Do
  700.     Begin
  701.      ClearLines(19,24);
  702.      NormVideo;
  703.      With Line.Prompt Do
  704.       Begin
  705.        GoToXY(x,y+1);Write(Txt,ConstStr('_',32-Length(Txt)));
  706.       End;
  707.      LowVideo;
  708.      GoToXY(6,19);Write('File Name:');
  709.      GoToXY(26,19);Write('File Extension:');
  710.      GoToXY(46,19);Write('On Drive:');
  711.      GoToXY(3,20);Write('In Directory:');
  712.      GoToXY(5,21);Write('Parameters:');
  713.      GoToXY(2,22);Write('Type:');
  714.      GoToXY(51,22);Write('TAB    - Accept Screen');
  715.      GoToXY(51,23);Write('ESCAPE - Cancel Operation');
  716.      NormVideo;
  717.      GoToXY(17,19);Write(Fname.Name,ConstStr('_',8-Length(Fname.Name)));
  718.      GoToXY(42,19);Write(Fname.Ext,ConstStr('_',3-Length(Fname.Ext)));
  719.      GoToXY(56,19);Write(Drive,ConstStr('_',1-Length(Drive)));
  720.      GoToXY(17,20);Write(DirPath,ConstStr('_',50-Length(DirPath)));
  721.      GoToXY(17,21);Write(Parms,ConstStr('_',50-Length(Parms)));
  722.      LowVideo;
  723.      DisplayChoice(FlagTxt,6,Flag);
  724.     End;                                    { with Line }
  725.   End;
  726.  
  727.  Procedure EditEntry(Var Line:MenuEntry;Var TC:Char);
  728.   Var
  729.    SLine:MenuEntry;
  730.    L:Integer;
  731.   Begin
  732.    SLine:=Line;
  733.    With Line Do
  734.     Begin
  735.      L:=1;
  736.      Repeat
  737.       Case L Of
  738.        1:With Prompt Do
  739.           InputStr(Txt,32,x,y+1,Term2,TC);
  740.        2:InputStr(Fname.Name,8,17,19,Term2,TC);
  741.        3:InputStr(Fname.Ext,3,42,19,Term2,TC);
  742.        4:InputStr(Drive,1,56,19,Term2,TC);
  743.        5:InputStr(DirPath,50,17,20,Term2,TC);
  744.        6:InputStr(Parms,50,17,21,Term2,TC);
  745.        7:MakeChoice(FlagTxt,6,Flag,TC);
  746.       End;                                  { case L of }
  747.       L:=L+1;
  748.       If L>8 Then L:=1;
  749.      Until (TC=TAB_Key) Or (TC=ESCAPE_Key);
  750.     End;                                    { with Line }
  751.    If TC=ESCAPE_Key Then
  752.     Line:=SLine;
  753.    ClearLines(19,24);
  754.   End;
  755.  
  756.   {*Include File End MENUENTR.INC ***** END *****}
  757.   {*Include File     MENUUTIL.INC ***** START *****}
  758.  Procedure DisplayInfo(Var Prompt:PromptField;Var buffer);
  759.   Type
  760.    LineRec=Record
  761.             y:Byte;
  762.             x:Byte;
  763.             Txt:String[255];
  764.            End;
  765.  
  766.   Var
  767.    MenuLine:LineRec Absolute buffer;
  768.    I:Integer;
  769.    Flag:Boolean;
  770.   Begin
  771.    With MenuLine Do
  772.     Begin
  773.      If x=$ff Then
  774.       Begin
  775.        I:=1;
  776.        While Txt[I]<>#03 Do
  777.         I:=I+1;
  778.        x:=40-((I) Shr 1);
  779.       End;
  780.      If Txt[0]=Chr(2) Then
  781.       Begin
  782.        I:=1;
  783.        Flag:=True;
  784.        While Txt[I]<>#03 Do
  785.         Begin
  786.          If Flag And (Txt[I]>#$20) Then
  787.           Flag:=False;
  788.          I:=I+1;
  789.         End;
  790.        If Not Flag Then
  791.         Txt[0]:=Chr(I-1)
  792.        Else
  793.         Txt[0]:=Chr(0);
  794.       End;
  795.      Prompt.x:=x;
  796.      Prompt.y:=y;
  797.      Prompt.Txt:=Txt;
  798.     End;                                    { with MenuRec }
  799.   End;
  800.  
  801.  Procedure Entry(I:Integer;Var b,o:Byte;Var buffer);
  802.   Type
  803.    OffRec=Record
  804.            offset:Byte;
  805.            blk:Byte;
  806.           End;
  807.    OffTable=Array[0..52] Of OffRec;
  808.   Var
  809.    table:OffTable Absolute buffer;
  810.   Begin
  811.    With table[I] Do
  812.     Begin
  813.      b:=blk;
  814.      o:=offset;
  815.     End;
  816.   End;
  817.  
  818.  Procedure FileInfo(Var buffer;
  819.                     Var Stuff:MenuEntry);
  820.   Type
  821.    RunRec=Record
  822.            pflag:Byte;
  823.            phelp:Byte;
  824.            junk:Byte;
  825.            pdisk:Byte;
  826.            ptxt:Array[1..255] Of Char;
  827.           End;
  828.   Var
  829.    prec:RunRec Absolute buffer;
  830.    Fnme:String[14];
  831.    F:Integer;
  832.    k,P:Integer;
  833.    I:Integer;
  834.   Begin
  835.    With prec,Stuff Do
  836.     Begin
  837.      Flag:=pflag;
  838.      Help:=phelp;
  839.      If pdisk=0 Then
  840.       Drive:=''
  841.      Else
  842.       Drive:=Chr($40+pdisk);
  843.      DirPath:='';
  844.      F:=0;
  845.      k:=1;
  846.      If (ptxt[k]='/') Or (ptxt[k]='\') Then
  847.       Begin
  848.        k:=k+1;
  849.        Repeat
  850.         F:=F+1;
  851.         DirPath[F]:=ptxt[k];
  852.         k:=k+1;
  853.        Until ptxt[k]=#$20;
  854.        k:=k+1;
  855.        DirPath[0]:=Chr(F-1);
  856.       End;
  857.      F:=0;
  858.      Fnme:='';
  859.      P:=k+7;
  860.      For I:=k To k+10 Do
  861.       Begin
  862.        If ptxt[I]<>#$20 Then
  863.         Begin
  864.          F:=F+1;
  865.          Fnme[F]:=ptxt[I];
  866.         End;
  867.        If I=P Then
  868.         Begin
  869.          F:=F+1;
  870.          Fnme[F]:='.';
  871.         End;
  872.       End;
  873.      Fnme[0]:=Chr(F);
  874.      F:=Pos('.',Fnme);
  875.      Fname.Name:=Copy(Fnme,1,F-1);
  876.      Fname.Ext:=Copy(Fnme,F+1,Length(Fnme));
  877.      Parms:='';
  878.      k:=0;
  879.      I:=I+1;
  880.      While ptxt[I]<>#$03 Do
  881.       Begin
  882.        k:=k+1;
  883.        Parms[k]:=ptxt[I];
  884.        I:=I+1;
  885.       End;
  886.      Parms[0]:=Chr(k);
  887.     End;
  888.   End;
  889.  
  890.  
  891.   {*Include File End MENUUTIL.INC ***** END *****}
  892.   {*Include File     MENUEXTR.INC ***** START *****}
  893.  Procedure ExtractInfo(Var Menu:WMenu;
  894.                        Var MBuffer:MenuBuffer;
  895.                        Var LastHelp:Integer);
  896.   Var
  897.    k:Integer;
  898.    L:Integer;
  899.    b,o:Byte;
  900.  
  901.   Begin
  902.    For k:=1 To 3 Do
  903.     Begin
  904.      Entry(k,b,o,MBuffer);
  905.      DisplayInfo(Menu.Line[k],MBuffer.Buf[b,o]);
  906.     End;
  907.    Entry(0,b,o,MBuffer);
  908.    L:=MBuffer.Buf[b,o+1].b;
  909.    Menu.EntryCount:=L;
  910.    L:=L-1;
  911.    LastHelp:=0;
  912.    For k:=0 To L Do
  913.     With Menu.DisplayEntry[k+1] Do
  914.      Begin
  915.       Entry(k+4,b,o,MBuffer);
  916.       DisplayInfo(Prompt,MBuffer.Buf[b,o]);
  917.       Entry(k+4+Menu.EntryCount,b,o,MBuffer);
  918.       FileInfo(MBuffer.Buf[b,o],Menu.DisplayEntry[k+1]);
  919.       If Help>0 Then
  920.        If Help>LastHelp Then LastHelp:=Help;
  921.      End;
  922.   End;
  923.  
  924.  Procedure ExtractHelp(I:Integer;Var Help:WHelp;Var HBuffer:HelpBuffer);
  925.   Var
  926.    k,L,t,m:Integer;
  927.    b,o:Byte;
  928.   Begin
  929.    For k:=1 To I Do
  930.     With Help.Htxt[k] Do
  931.      Begin
  932.       L:=1+(k-1)*22;
  933.       m:=1;
  934.       For t:=L To L+21 Do
  935.        Begin
  936.         Entry(t,b,o,HBuffer);
  937.         DisplayInfo(HLine[m],HBuffer.Buf[b,o]);
  938.         m:=m+1;
  939.        End;
  940.      End;
  941.    Help.LastHelp:=I;
  942.   End;
  943.  
  944.  Procedure ReadMenu(Var Fname:Str80;Var Good:Boolean;Var MBuffer:MenuBuffer);
  945.   Var
  946.    k:Integer;
  947.    FilVar:ByteFile;
  948.    Result:Integer;
  949.   Begin
  950.    Assign(FilVar,Fname);
  951.    {$I-}Reset(FilVar);                      {$I+}
  952.    Good:=(IOResult=0);
  953.    If Good Then
  954.     Begin
  955.      k:=1;
  956.      Repeat
  957.       With MBuffer Do
  958.        DosBlockRead(FileHandle(FilVar),Buf[k],4096,Result);
  959.       k:=k+16;
  960.      Until Result=0;
  961.      Close(FilVar);
  962.     End;
  963.   End;
  964.  
  965.  Procedure ReadHelp(Var Fname:Str80;Var Good:Boolean;Var HBuffer:HelpBuffer);
  966.   Var
  967.    k:Integer;
  968.    FilVar:ByteFile;
  969.    Result:Integer;
  970.   Begin
  971.    Assign(FilVar,Fname);
  972.    {$I-}Reset(FilVar);                      {$I+}
  973.    Good:=(IOResult=0);
  974.    If Good Then
  975.     Begin
  976.      k:=1;
  977.      Repeat
  978.       With HBuffer Do
  979.        DosBlockRead(FileHandle(FilVar),Buf[k],4096,Result);
  980.       k:=k+16;
  981.      Until Result=0;
  982.      Close(FilVar);
  983.     End;
  984.   End;
  985.  
  986.  
  987.  
  988.   {*Include File End MENUEXTR.INC ***** END *****}
  989.   {*Include File     MENUFIX.INC ***** START *****}
  990.  Procedure MenuCursorSet(Var Menu:WMenu);
  991.   Var
  992.    I:Integer;
  993.    MaxLen1,MaxLen2:Integer;
  994.    ScrWidth:Integer;
  995.    HalfWay:Integer;
  996.    yset:Integer;
  997.    xset1,xset2:Integer;
  998.  
  999.   Begin
  1000.    For I:=1 To 3 Do
  1001.     With Menu.Line[I] Do
  1002.      Begin
  1003.       x:=Center(80,Length(Txt));
  1004.       y:=I-1;
  1005.      End;
  1006.    MaxLen1:=0;
  1007.    MaxLen2:=0;
  1008.    ScrWidth:=80;
  1009.    If Menu.EntryCount>12 Then
  1010.     Begin
  1011.      HalfWay:=(Menu.EntryCount+1) Shr 1;
  1012.      ScrWidth:=40;
  1013.     End
  1014.    Else
  1015.     HalfWay:=Menu.EntryCount;
  1016.    For I:=1 To Menu.EntryCount Do
  1017.     With Menu.DisplayEntry[I].Prompt Do
  1018.      Begin
  1019.       If I<=HalfWay Then
  1020.        Begin
  1021.         If Length(Txt)>MaxLen1 Then
  1022.          MaxLen1:=Length(Txt);
  1023.        End
  1024.       Else
  1025.        If Length(Txt)>MaxLen2 Then
  1026.         MaxLen2:=Length(Txt);
  1027.      End;
  1028.    yset:=6+Center(12,HalfWay);
  1029.    xset1:=Center(ScrWidth,MaxLen1);
  1030.    xset2:=39+Center(ScrWidth,MaxLen2);
  1031.    For I:=1 To HalfWay Do
  1032.     Begin
  1033.      With Menu.DisplayEntry[I].Prompt Do
  1034.       Begin
  1035.        x:=xset1;
  1036.        y:=yset;
  1037.       End;
  1038.      If I+HalfWay<=Menu.EntryCount Then
  1039.       With Menu.DisplayEntry[I+HalfWay].Prompt Do
  1040.        Begin
  1041.         x:=xset2;
  1042.         y:=yset;
  1043.        End;
  1044.      yset:=yset+1;
  1045.     End;
  1046.   End;
  1047.  
  1048.  
  1049.   {*Include File End MENUFIX.INC ***** END *****}
  1050.   {*Include File     OUTMENU.INC ***** START *****}
  1051.  Procedure DisplayTxt(Var Prompt:PromptField);
  1052.   Begin
  1053.    With Prompt Do
  1054.     Begin
  1055.      GoToXY(x,y+1);Write(Txt);
  1056.     End;
  1057.   End;
  1058.  
  1059.  Procedure OutMenu(Var Menu:WMenu;Select:Integer);
  1060.   Var
  1061.    I:Integer;
  1062.  
  1063.   Begin
  1064.    With Menu Do
  1065.     Begin
  1066.      ClearLines(1,18);
  1067.      For I:=1 To 3 Do
  1068.       DisplayTxt(Line[I]);
  1069.      For I:=1 To EntryCount Do
  1070.       DisplayTxt(DisplayEntry[I].Prompt);
  1071.      NormVideo;
  1072.      DisplayTxt(DisplayEntry[Select].Prompt);
  1073.      LowVideo;
  1074.     End;
  1075.   End;
  1076.  
  1077.  Procedure MoveSelect(Var Old,New:Integer;Var Menu:WMenu);
  1078.   Begin
  1079.    With Menu.DisplayEntry[Old] Do
  1080.     DisplayTxt(Prompt);
  1081.    NormVideo;
  1082.    With Menu.DisplayEntry[New] Do
  1083.     DisplayTxt(Prompt);
  1084.    LowVideo;
  1085.    Old:=New;
  1086.   End;
  1087.  
  1088.  Procedure MenuSelect(Var Menu:WMenu;
  1089.                       Var Sel:Integer;
  1090.                       Var TC:Char);
  1091.   Var
  1092.    Special:Boolean;
  1093.    NextOne:Integer;
  1094.   Begin
  1095.    Repeat
  1096.     With Menu.DisplayEntry[Sel].Prompt Do
  1097.      GoToXY(x-1,y+1);
  1098.     TC:=Read_Char(Special);
  1099.     If Not(TC In Term2) Then
  1100.      Case TC Of
  1101.       #$20:Begin
  1102.             NextOne:=Sel+1;
  1103.             If NextOne>Menu.EntryCount Then
  1104.              NextOne:=1;
  1105.             MoveSelect(Sel,NextOne,Menu);
  1106.            End;
  1107.  
  1108.       #$08:Begin
  1109.             NextOne:=Sel-1;
  1110.             If NextOne<1 Then
  1111.              NextOne:=Menu.EntryCount;
  1112.             MoveSelect(Sel,NextOne,Menu);
  1113.            End;
  1114.      Else
  1115.       Beep;
  1116.      End;                                   { case TC of }
  1117.    Until (TC In Term2);
  1118.   End;
  1119.  
  1120.  
  1121.   {*Include File End OUTMENU.INC ***** END *****}
  1122.   {*Include File     SWAPENTR.INC ***** START *****}
  1123.  Procedure SwapEntry(Var Menu:WMenu;New,Old:Integer);
  1124.   Var
  1125.    SLine:MenuEntry;
  1126.   Begin
  1127.    With Menu Do
  1128.     Begin
  1129.      SLine:=DisplayEntry[Old];
  1130.      DisplayEntry[Old]:=DisplayEntry[New];
  1131.      DisplayEntry[New]:=SLine;
  1132.      DisplayEntry[New].Prompt.x:=DisplayEntry[Old].Prompt.x;
  1133.      DisplayEntry[New].Prompt.y:=DisplayEntry[Old].Prompt.y;
  1134.      DisplayEntry[Old].Prompt.x:=SLine.Prompt.x;
  1135.      DisplayEntry[Old].Prompt.y:=SLine.Prompt.y;
  1136.     End;
  1137.   End;
  1138.  
  1139.   {*Include File End SWAPENTR.INC ***** END *****}
  1140.   {*Include File     PRINTMEN.INC ***** START *****}
  1141.  Procedure PrintPrompt(Var List:Text;Var Prompt:PromptField);
  1142.   Begin
  1143.    With Prompt Do
  1144.     Begin
  1145.      WriteLn(List,'Position (',x:0,',',y:0,')');
  1146.      WriteLn(List,Txt);
  1147.     End;
  1148.   End;
  1149.  
  1150.  Procedure PrintEntry(Var List:Text;Var MEntry:MenuEntry);
  1151.   Begin
  1152.    With MEntry Do
  1153.     Begin
  1154.      PrintPrompt(List,Prompt);
  1155.      WriteLn(List,'Path : ',DirPath);
  1156.      WriteLn(List,'File : ',Fname.Name);
  1157.      WriteLn(List,'Ext  : ',Fname.Ext);
  1158.      WriteLn(List,'Parm : ',Parms);
  1159.      WriteLn(List,'Help : ',Help);
  1160.      WriteLn(List,'Flag : ',Flag);
  1161.      WriteLn(List,'Drive: ',Drive);
  1162.     End;
  1163.   End;
  1164.  
  1165.  Procedure PrintMenu(Var Menu:WMenu;Var List:Text);
  1166.   Var
  1167.    I:Integer;
  1168.   Begin
  1169.    With Menu Do
  1170.     Begin
  1171.      WriteLn(List,'No. of entries :',EntryCount:3);
  1172.      WriteLn(List,'      Heading lines');
  1173.      For I:=1 To 3 Do
  1174.       PrintPrompt(List,Line[I]);
  1175.      For I:=1 To EntryCount Do
  1176.       PrintEntry(List,DisplayEntry[I]);
  1177.     End;
  1178.   End;
  1179.  
  1180.   {*Include File End PRINTMEN.INC ***** END *****}
  1181.   {*Include File     EDTHEAD.INC ***** START *****}
  1182.  Procedure EditHeaders(Var Menu:WMenu;Var TC:Char);
  1183.   Var
  1184.    SLine:Headers;
  1185.    L:Integer;
  1186.  
  1187.   Begin
  1188.    With Menu Do
  1189.     Begin
  1190.      ClrScr;
  1191.      LowVideo;
  1192.      GoToXY(31,1);Write('Menu Edit Utility');
  1193.      GoToXY(36,1);Write('Release 1.0');
  1194.      GoToXY(51,19);Write('TAB    - Accept Screen');
  1195.      GoToXY(51,20);Write('ESCAPE - Terminate');
  1196.      GoToXY(51,21);Write('RETURN - Next Field');
  1197.      NormVideo;
  1198.      GoToXY(1,4);Write('Enter Text to be centered on the first three lines.');
  1199.      LowVideo;
  1200.      GoToXY(6,6);Write('Line One: ');NormVideo;Write(Line[1].Txt);LowVideo;
  1201.      GoToXY(6,8);Write('Line Two: ');NormVideo;Write(Line[2].Txt);LowVideo;
  1202.      GoToXY(4,10);Write('Line Three: ');NormVideo;Write(Line[3].Txt);LowVideo;
  1203.      SLine:=Line;
  1204.      L:=1;
  1205.      Repeat
  1206.       With Line[L] Do
  1207.        InputStr(Txt,60,16,(L Shl 1)+4,Term2,TC);
  1208.       L:=L+1;
  1209.       If L>3 Then L:=1;
  1210.      Until (TC=TAB_Key) Or (TC=ESCAPE_Key);
  1211.      If TC=TAB_Key Then
  1212.       Begin
  1213.        For L:=1 To 3 Do
  1214.         With Line[L] Do
  1215.          Begin
  1216.           x:=40-(Length(Txt) Shr 1);
  1217.           y:=L-1;
  1218.          End;
  1219.       End
  1220.      Else
  1221.       Line:=SLine;
  1222.     End;                                    { with }
  1223.   End;
  1224.  
  1225.  
  1226.   {*Include File End EDTHEAD.INC ***** END *****}
  1227.   {*Include File     EDTSEL.INC ***** START *****}
  1228.  Const
  1229.   FunSel:Array[0..6] Of PromptField=
  1230.   ((x:3;y:19;Txt:'Add'),(x:3;y:20;Txt:'Edit'),(x:3;y:21;Txt:'Reorder'),
  1231.   (x:16;y:19;Txt:'Delete'),(x:16;y:20;Txt:'Edit Header'),
  1232.   (x:16;y:21;Txt:'Edit Help Screen'),(x:16;y:22;Txt:'End Menu Update'));
  1233.  
  1234.  Procedure DisplayFunction(EdtFun:Integer);
  1235.   Begin
  1236.    ClearLines(19,22);
  1237.    DisplayChoice(FunSel,7,EdtFun);
  1238.    GoToXY(51,19);Write('TAB    - Select Operation');
  1239.    GoToXY(51,20);Write('ESCAPE - Terminate');
  1240.    GoToXY(51,21);Write('SPACE  - Next Operation');
  1241.   End;
  1242.  
  1243.  Procedure EditFunction(Var EdtFun:Integer;Var TC:Char);
  1244.   Begin
  1245.    MakeChoice(FunSel,7,EdtFun,TC)
  1246.   End;
  1247.  
  1248.   {*Include File End EDTSEL.INC ***** END *****}
  1249.   {*Include File     ADDENTRY.INC ***** START *****}
  1250.  Procedure AddEntry(Var Menu:WMenu;Var Select:Integer;Var TC:Char);
  1251.   Var
  1252.    I:Integer;
  1253.    SaveMenu:WMenuPtr;
  1254.    SSelect:Integer;
  1255.   Begin
  1256.    With Menu Do
  1257.     Begin
  1258.      If EntryCount>=24 Then
  1259.       Message('Menu is Full, 24 entries')
  1260.      Else
  1261.       Begin                                 { Not Full }
  1262.        New(SaveMenu);
  1263.        SaveMenu^ :=Menu;
  1264.        SSelect:=Select;
  1265.        If EntryCount>0 Then
  1266.         Begin
  1267.          Select:=Select+1;
  1268.          For I:=EntryCount Downto Select Do
  1269.           DisplayEntry[I+1]:=DisplayEntry[I];
  1270.         End
  1271.        Else
  1272.         Select:=1;
  1273.        FillChar(DisplayEntry[Select],SizeOf(DisplayEntry[Select]),0);
  1274.        EntryCount:=EntryCount+1;
  1275.        MenuCursorSet(Menu);
  1276.        OutMenu(Menu,Select);
  1277.        OutEntry(DisplayEntry[Select]);
  1278.        EditEntry(DisplayEntry[Select],TC);
  1279.        If TC=ESCAPE_Key Then
  1280.         Begin
  1281.          Menu:=SaveMenu^;
  1282.          Select:=SSelect;
  1283.         End;
  1284.        Dispose(SaveMenu);
  1285.        MenuCursorSet(Menu);
  1286.        OutMenu(Menu,Select);
  1287.       End;                                  { Not Full }
  1288.     End;                                    { with Menu }
  1289.   End;
  1290.  
  1291.   {*Include File End ADDENTRY.INC ***** END *****}
  1292.   {*Include File     EDITMENU.INC ***** START *****}
  1293.  Procedure EditMenuEntry(Var Menu:WMenu;Select:Integer;Var TC:Char);
  1294.   Begin
  1295.    With Menu Do
  1296.     Begin
  1297.      OutEntry(DisplayEntry[Select]);
  1298.      EditEntry(DisplayEntry[Select],TC);
  1299.      If TC<>ESCAPE_Key Then
  1300.       MenuCursorSet(Menu);
  1301.      OutMenu(Menu,Select);
  1302.     End;
  1303.   End;
  1304.  
  1305.  
  1306.   {*Include File End EDITMENU.INC ***** END *****}
  1307.   {*Include File     REORDER.INC ***** START *****}
  1308.  Const
  1309.   Directions:Set Of Char=[TAB_Key,UP_Key,DOWN_Key];
  1310.  
  1311.  Procedure ReorderEntry(Var Menu:WMenu;Var Select:Integer;Var TC:Char);
  1312.   Var
  1313.    Special:Boolean;
  1314.   Begin
  1315.    ClearLines(19,24);
  1316.    GoToXY(51,19);Write('TAB        - Complete Move');
  1317.    GoToXY(51,20);Write('UP Arrow   - Move Entry Up');
  1318.    GoToXY(51,21);Write('DOWN Arrow - Move Entry Down');
  1319.    Repeat
  1320.     With Menu.DisplayEntry[Select].Prompt Do
  1321.      GoToXY(x-1,y+1);
  1322.     TC:=Read_Char(Special);
  1323.     If TC In Directions Then
  1324.      Case TC Of
  1325.       UP_Key:If Select>1 Then
  1326.               Begin
  1327.                SwapEntry(Menu,Select-1,Select);
  1328.                With Menu.DisplayEntry[Select].Prompt Do
  1329.                 Begin
  1330.                  GoToXY(x,y+1);Write('':32);
  1331.                  GoToXY(x,y+1);Write(Txt);
  1332.                 End;
  1333.                Select:=Select-1;
  1334.                NormVideo;
  1335.                With Menu.DisplayEntry[Select].Prompt Do
  1336.                 Begin
  1337.                  GoToXY(x,y+1);Write('':32);
  1338.                  GoToXY(x,y+1);Write(Txt);
  1339.                 End;
  1340.                LowVideo;
  1341.               End;
  1342.  
  1343.       DOWN_Key:If Select<Menu.EntryCount Then
  1344.                 Begin
  1345.                  SwapEntry(Menu,Select+1,Select);
  1346.                  With Menu.DisplayEntry[Select].Prompt Do
  1347.                   Begin
  1348.                    GoToXY(x,y+1);Write('':32);
  1349.                    GoToXY(x,y+1);Write(Txt);
  1350.                   End;
  1351.                  Select:=Select+1;
  1352.                  NormVideo;
  1353.                  With Menu.DisplayEntry[Select].Prompt Do
  1354.                   Begin
  1355.                    GoToXY(x,y+1);Write('':32);
  1356.                    GoToXY(x,y+1);Write(Txt);
  1357.                   End;
  1358.                  LowVideo;
  1359.                 End;
  1360.  
  1361.      End                                    { case of TC }
  1362.     Else
  1363.      Beep;
  1364.    Until (TC=TAB_Key);
  1365.   End;
  1366.  
  1367.  
  1368.   {*Include File End REORDER.INC ***** END *****}
  1369.   {*Include File     DELENTRY.INC ***** START *****}
  1370.  Procedure DeleteEntry(Var Menu:WMenu;Var Sel:Integer;Var TC:Char);
  1371.   Var
  1372.    I:Integer;
  1373.    SaveMenu:WMenuPtr;
  1374.   Begin
  1375.    With Menu Do
  1376.     Begin
  1377.      If EntryCount<1 Then
  1378.       Message('Menu is empty')
  1379.      Else
  1380.       Begin                                 { Not Empty }
  1381.        New(SaveMenu);
  1382.        SaveMenu^ :=Menu;
  1383.        For I:=Sel To EntryCount Do
  1384.         DisplayEntry[I]:=DisplayEntry[I+1];
  1385.        EntryCount:=EntryCount-1;
  1386.        MenuCursorSet(Menu);
  1387.        OutMenu(Menu,Sel);
  1388.        Select('Confirm Delete (Y/N):',['Y','N'],TC);
  1389.        ClearLines(19,24);
  1390.        If TC='N' Then
  1391.         Begin
  1392.          Menu:=SaveMenu^;
  1393.          OutMenu(Menu,Sel);
  1394.         End;
  1395.        If Sel>EntryCount Then
  1396.         Sel:=EntryCount;
  1397.        Dispose(SaveMenu);
  1398.       End;                                  { Not Empty }
  1399.     End;                                    { with Menu }
  1400.   End;
  1401.  
  1402.   {*Include File End DELENTRY.INC ***** END *****}
  1403.   {*Include File     EDITHELP.INC ***** START *****}
  1404.  Procedure EditHelp(Var Menu:WMenu;
  1405.                     Var SelEntry:Integer;
  1406.                     Var HelpTxt:WHelp;
  1407.                     Var TC:Char);
  1408.  
  1409.   Var
  1410.    I:Integer;
  1411.    Scr:Screen;
  1412.    SHelp:Integer;
  1413.    SLastHelp:Integer;
  1414.    InUse:Array[1..24] Of Byte;
  1415.  
  1416.   Begin
  1417.    With Menu.DisplayEntry[SelEntry] Do
  1418.     Begin
  1419.      SHelp:=Help;
  1420.      SLastHelp:=HelpTxt.LastHelp;
  1421.      If (Help=0) Then
  1422.       Begin
  1423.        If (SLastHelp<24) Then
  1424.         Begin
  1425.          HelpTxt.LastHelp:=HelpTxt.LastHelp+1;
  1426.          Help:=HelpTxt.LastHelp;
  1427.          With HelpTxt Do
  1428.           FillChar(Htxt[Help],SizeOf(Htxt[Help]),0);
  1429.         End
  1430.        Else
  1431.         Begin
  1432.          FillChar(InUse,SizeOf(InUse),0);
  1433.          For I:=1 To Menu.EntryCount Do
  1434.           If Menu.DisplayEntry[I].Help<>0 Then
  1435.            InUse[I]:=1;
  1436.          I:=1;
  1437.          While InUse[I]=1 Do
  1438.           I:=I+1;
  1439.          Help:=I;
  1440.          With HelpTxt Do
  1441.           FillChar(Htxt[Help],SizeOf(Htxt[Help]),0);
  1442.         End;
  1443.       End;
  1444.      With HelpTxt.Htxt[Help] Do
  1445.       Begin
  1446.        For I:=1 To 22 Do
  1447.         Scr[I]:=HLine[I].Txt;
  1448.       End;
  1449.      ClearLines(23,24);
  1450.      GoToXY(21,24);Write('TAB - Accept Screen,  ESCAPE - Cancel Operation');
  1451.      InputScreen(Scr,1,22,[ESCAPE_Key,TAB_Key],TC);
  1452.      If TC=ESCAPE_Key Then
  1453.       Begin
  1454.        Help:=SHelp;
  1455.        HelpTxt.LastHelp:=SLastHelp;
  1456.       End
  1457.      Else
  1458.       Begin
  1459.        With HelpTxt.Htxt[Help] Do
  1460.         For I:=1 To 22 Do
  1461.          With HLine[I] Do
  1462.           Begin
  1463.            x:=1;
  1464.            y:=I;
  1465.            Txt:=Scr[I];
  1466.           End;
  1467.       End;
  1468.     End;
  1469.    ClrScr;
  1470.   End;
  1471.  
  1472.  
  1473.   {*Include File End EDITHELP.INC ***** END *****}
  1474.   {*Include File     WBUFFER.INC ***** START *****}
  1475.  Procedure StringOut(Var b,o:Integer;
  1476.                      Var Foo;
  1477.                      Var buffer);
  1478.   Type
  1479.    Str255=String[255];
  1480.   Var
  1481.    WBuf:HelpBuffer Absolute buffer;
  1482.    PassedStr:Str255 Absolute Foo;
  1483.    I:Integer;
  1484.   Begin
  1485.    For I:=1 To Length(PassedStr) Do
  1486.     Begin
  1487.      WBuf.Buf[b,o].C:=PassedStr[I];
  1488.      o:=o+1;
  1489.      If o>255 Then
  1490.       Begin
  1491.        o:=0;
  1492.        b:=b+1;
  1493.       End;
  1494.     End;
  1495.   End;
  1496.  
  1497.  Procedure PromptOut(Var b,o:Integer;
  1498.                      Var Prompt:PromptField;
  1499.                      Var buffer);
  1500.   Var
  1501.    Dummy:String[84];
  1502.   Begin
  1503.    With Prompt Do
  1504.     Begin
  1505.      Dummy[0]:=Chr(3);
  1506.      Dummy[1]:=Chr(y);
  1507.      Dummy[2]:=Chr(x);
  1508.      Dummy[3]:=#$02;
  1509.      Dummy:=Dummy+Txt;
  1510.      Dummy:=Dummy+#$03;
  1511.      StringOut(b,o,Dummy,buffer);
  1512.     End;
  1513.   End;
  1514.  
  1515.  Procedure InfoOut(Var b,o:Integer;
  1516.                    Var Info:MenuEntry;
  1517.                    Var buffer);
  1518.   Var
  1519.    Dummy:String[255];
  1520.    I:Integer;
  1521.   Begin
  1522.    With Info Do
  1523.     Begin
  1524.      Dummy[0]:=Chr(4);
  1525.      Dummy[1]:=Chr(Flag);
  1526.      Dummy[2]:=Chr(Help);
  1527.      Dummy[3]:=#$02;
  1528.      If (Drive='') Or (Drive=' ') Then
  1529.       Dummy[4]:=Chr(0)
  1530.      Else
  1531.       Dummy[4]:=Chr(Ord(Drive[1])-$40);
  1532.      If Not(DirPath='') Then
  1533.       Begin
  1534.        DirPath:='\'+DirPath+'\';
  1535.        Dummy:=Dummy+DirPath+' ';
  1536.       End;
  1537.      With Fname Do
  1538.       Begin
  1539.        For I:=Length(Name)+1 To 8 Do
  1540.         Name[I]:=' ';
  1541.        Name[0]:=Chr(8);
  1542.        For I:=Length(Ext)+1 To 3 Do
  1543.         Ext[I]:=' ';
  1544.        Ext[0]:=Chr(3);
  1545.        Dummy:=Dummy+Name+Ext;
  1546.       End;
  1547.      Dummy:=Dummy+Parms+#$03;
  1548.      StringOut(b,o,Dummy,buffer);
  1549.     End;
  1550.   End;
  1551.  
  1552.  
  1553.  
  1554.   {*Include File End WBUFFER.INC ***** END *****}
  1555.   {*Include File     HELPBUF.INC ***** START *****}
  1556.  Procedure WriteHelpBuffer(Var Help:WHelp;
  1557.                            Var b,o:Integer;
  1558.                            Var buffer);
  1559.   Var
  1560.    IndexTable:HelpIndex Absolute buffer;
  1561.    Dummy:String[80];
  1562.    I:Integer;
  1563.    k:Integer;
  1564.    index:Integer;
  1565.   Begin
  1566.    index:=0;
  1567.    b:=0;
  1568.    o:=0;
  1569.    If Help.LastHelp>0 Then
  1570.     With Help Do
  1571.      Begin
  1572.       o:=34;
  1573.       b:=5;
  1574.       IndexTable[index].b:=b;
  1575.       IndexTable[index].o:=o;
  1576.       Dummy:=#$00+Chr(LastHelp)+#$02;
  1577.       StringOut(b,o,Dummy,buffer);
  1578.       For I:=1 To LastHelp Do
  1579.        With Htxt[I] Do
  1580.         For k:=1 To 22 Do
  1581.          Begin
  1582.           index:=index+1;
  1583.           IndexTable[index].b:=b;
  1584.           IndexTable[index].o:=o;
  1585.           PromptOut(b,o,HLine[k],buffer);
  1586.          End;
  1587.      End;
  1588.   End;
  1589.  
  1590.  
  1591.  
  1592.  
  1593.   {*Include File End HELPBUF.INC ***** END *****}
  1594.   {*Include File     MENUBUF.INC ***** START *****}
  1595.  Procedure WriteMenuBuffer(Var Menu:WMenu;
  1596.                            Var b,o:Integer;
  1597.                            Var buffer);
  1598.   Var
  1599.    IndexTable:MenuIndex Absolute buffer;
  1600.    Dummy:String[80];
  1601.    I:Integer;
  1602.    index:Integer;
  1603.   Begin
  1604.    index:=0;
  1605.    With Menu Do
  1606.     Begin
  1607.      o:=(EntryCount*4)+8;
  1608.      b:=1;
  1609.      IndexTable[index].b:=b;
  1610.      IndexTable[index].o:=o;
  1611.      Dummy:=#$00+Chr(EntryCount)+#$02;
  1612.      StringOut(b,o,Dummy,buffer);
  1613.      For I:=1 To 3 Do
  1614.       Begin
  1615.        index:=index+1;
  1616.        IndexTable[index].b:=b;
  1617.        IndexTable[index].o:=o;
  1618.        PromptOut(b,o,Line[I],buffer);
  1619.       End;
  1620.      For I:=1 To EntryCount Do
  1621.       Begin
  1622.        index:=index+1;
  1623.        IndexTable[index].b:=b;
  1624.        IndexTable[index].o:=o;
  1625.        PromptOut(b,o,DisplayEntry[I].Prompt,buffer);
  1626.       End;
  1627.      For I:=1 To EntryCount Do
  1628.       Begin
  1629.        index:=index+1;
  1630.        IndexTable[index].b:=b;
  1631.        IndexTable[index].o:=o;
  1632.        InfoOut(b,o,DisplayEntry[I],buffer);
  1633.       End;
  1634.     End;
  1635.   End;
  1636.  
  1637.  
  1638.  
  1639.  
  1640.   {*Include File End MENUBUF.INC ***** END *****}
  1641.   {*Include File     WBACK.INC ***** START *****}
  1642.  Procedure WriteMenu(Var FilVar:ByteFile;
  1643.                      b:Integer;
  1644.                      Var Good:Boolean;
  1645.                      Var MBuffer:MenuBuffer);
  1646.   Var
  1647.    k:Integer;
  1648.    Result:Integer;
  1649.   Begin
  1650.    {$I-}Rewrite(FilVar);                    {$I+}
  1651.    Good:=(IOResult=0);
  1652.    If Good Then
  1653.     Begin
  1654.      For k:=1 To b Do
  1655.       With MBuffer Do
  1656.        DosBlockWrite(FileHandle(FilVar),Buf[k],256,Result);
  1657.      Close(FilVar);
  1658.     End;
  1659.   End;
  1660.  
  1661.  Procedure WriteHelp(Var FilVar:ByteFile;
  1662.                      b:Integer;
  1663.                      Var Good:Boolean;
  1664.                      Var HBuffer:HelpBuffer);
  1665.   Var
  1666.    k:Integer;
  1667.    Result:Integer;
  1668.   Begin
  1669.    {$I-}Rewrite(FilVar);                    {$I+}
  1670.    Good:=(IOResult=0);
  1671.    If Good Then
  1672.     Begin
  1673.      For k:=1 To b Do
  1674.       With HBuffer Do
  1675.        DosBlockWrite(FileHandle(FilVar),Buf[k],256,Result);
  1676.      Close(FilVar);
  1677.     End;
  1678.    If b=0 Then
  1679.     Erase(FilVar);
  1680.   End;
  1681.  
  1682.  Procedure WriteBack(Var Menu:WMenu;
  1683.                      Var MBuf:MenuBuffer;
  1684.                      Var Help:WHelp;
  1685.                      Var HBuf:HelpBuffer);
  1686.  
  1687.   Var
  1688.    b,o:Integer;
  1689.    Good:Boolean;
  1690.   Begin
  1691.    WriteMenuBuffer(Menu,b,o,MBuf);
  1692.    WriteMenu(MenuFile,b,Good,MBuf);
  1693.    WriteHelpBuffer(Help,b,o,HBuf);
  1694.    WriteHelp(HelpFile,b,Good,HBuf);
  1695.   End;
  1696.  
  1697.  
  1698.  
  1699.   {*Include File End WBACK.INC ***** END *****}
  1700.  
  1701.  Begin
  1702.   ClrScr;
  1703.   LowVideo;
  1704.   New(FooMenu);
  1705.   New(FooHelp);
  1706.   New(FooMBuf);
  1707.   New(FooHBuf);
  1708.   FillChar(FooMenu^,SizeOf(FooMenu^),0);
  1709.   FillChar(FooMBuf^,SizeOf(FooMBuf^),0);
  1710.   FillChar(FooHelp^,SizeOf(FooHelp^),0);
  1711.   FillChar(FooHBuf^,SizeOf(FooHBuf^),0);
  1712.   MenuName:='';
  1713.   Repeat
  1714.    GoToXY(1,1);Write('Menu File Name: ');
  1715.    InputStr(MenuName,25,17,1,Term1,TC);
  1716.    If TC<>ESCAPE_Key Then
  1717.     Begin
  1718.      I:=Pos('.',MenuName);
  1719.      If I=0 Then
  1720.       HelpName:=MenuName+'.HLP'
  1721.      Else
  1722.       HelpName:=Copy(MenuName,1,I)+'HLP';
  1723.      Assign(MenuFile,MenuName);
  1724.      Assign(HelpFile,HelpName);
  1725.      Create:=False;
  1726.      {$I-}Reset(MenuFile){$I+};
  1727.      Ok:=(IOResult=0);
  1728.      If Not Ok Then
  1729.       Begin
  1730.        Select('File does not exits, Create [Y,N]',['Y','N'],TC);
  1731.        If TC='Y' Then
  1732.         Begin
  1733.          {$I-}Rewrite(MenuFile){$I+};
  1734.          Ok:=(IOResult=0);
  1735.          Create:=True;
  1736.         End;
  1737.       End;
  1738.     End;
  1739.   Until Ok Or (TC=ESCAPE_Key);
  1740.   If TC<>ESCAPE_Key Then
  1741.    Begin
  1742.     Close(MenuFile);
  1743.     If Not Create Then
  1744.      Begin
  1745.       ReadMenu(MenuName,Ok,FooMBuf^);
  1746.       ReadHelp(HelpName,Help,FooHBuf^);
  1747.       ExtractInfo(FooMenu^,FooMBuf^,LastHelp);
  1748.       If Help Then
  1749.        ExtractHelp(LastHelp,FooHelp^,FooHBuf^);
  1750.      End;
  1751.     EditHeaders(FooMenu^,TC);
  1752.     SelEntry:=1;
  1753.     SelFun:=0;
  1754.     OutMenu(FooMenu^,SelEntry);
  1755.     If Create Then
  1756.      AddEntry(FooMenu^,SelEntry,TC);
  1757.     If TC<>ESCAPE_Key Then
  1758.      Repeat
  1759.       DisplayFunction(SelFun);
  1760.       Repeat
  1761.        MenuSelect(FooMenu^,SelEntry,TC);
  1762.        If TC=RETURN_Key
  1763.        Then EditFunction(SelFun,TC);
  1764.       Until Not(TC=RETURN_Key);
  1765.       If TC<>ESCAPE_Key Then
  1766.        Begin
  1767.         Case SelFun Of
  1768.          0:AddEntry(FooMenu^,SelEntry,TC);
  1769.          1:EditMenuEntry(FooMenu^,SelEntry,TC);
  1770.          2:ReorderEntry(FooMenu^,SelEntry,TC);
  1771.          3:DeleteEntry(FooMenu^,SelEntry,TC);
  1772.          4:Begin
  1773.             EditHeaders(FooMenu^,TC);
  1774.             OutMenu(FooMenu^,SelEntry);
  1775.            End;
  1776.  
  1777.          5:Begin
  1778.             EditHelp(FooMenu^,SelEntry,FooHelp^,TC);
  1779.             OutMenu(FooMenu^,SelEntry);
  1780.            End;
  1781.  
  1782.          6:WriteBack(FooMenu^,FooMBuf^,FooHelp^,FooHBuf^);
  1783.         End;
  1784.         TC:=RETURN_Key;
  1785.        End;
  1786.      Until (TC=ESCAPE_Key) Or (SelFun=6);
  1787.     If (TC=ESCAPE_Key) And Create Then
  1788.      Erase(MenuFile);
  1789.    End;
  1790.   Dispose(FooMenu);
  1791.   Dispose(FooHelp);
  1792.   Dispose(FooMBuf);
  1793.   Dispose(FooHBuf);
  1794.  End.
  1795.