Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP5MENU.ZIP/MENUCODE.PAS

Pascal/Delphi Source File | 1989-01-22 | 43.4 KB | 1,262 lines

{
Copyright (c) 1988 BittWare Computing, ALL RIGHTS RESERVED
}
unit menucode;
{$v-}
interface
uses
        menuvars,
        crt,
        beepkey4,
        dos;
const
{error constants}
     InputOK        = 0;
     InputError     = 1;
     NoInput        = 2;
     NoOutput       = 3;

var
        DirList         :PickListPtr;
        DirScreen       :HalfScreenPtr;
        ConfirmMenu     :MenuPtr;
        ConfirmScreen   :ConfirmScreenPtr;

procedure InitMenuCode;
function Confirmed(InitVal,Auto: boolean):boolean;
procedure ConvertString(var InpStr:LineStrg; MaxCh,VarCode:byte;
                      var RtnCode:byte; VarAddr:pointer);
procedure InputString(InpStr:LineStrg; MaxCh:byte;
                      var OutStr:LineStrg; var RtnCode:byte);
procedure UpdateMenu(MenuName:MenuPtr);
procedure WaitEscape;
procedure sv_screen(x1,y1,x2,y2:byte;screen_dat:HalfScreenPtr);
procedure restore_screen(x1,y1,x2,y2:byte;screen_dat:HalfScreenPtr);
procedure sv_wh_screen(screen_dat:screenptr);
procedure restore_wh_screen(screen_dat:screenptr);
procedure border(x1,y1,x2,y2,fg,bg:byte);

procedure HideCurs;
procedure UnHideCurs;
procedure ErrorMessage;
procedure CloseIOWindow(MessageList:MessagePtr);
procedure OpenIOWindow(MessageList:MessagePtr);
function pass_keycode(var ch:char):byte;
procedure OpenPullDownMenu(MenuList:MenuPtr);
function PullDownMenu(MenuList:MenuPtr):byte;
procedure ClosePullDownMenu(MenuList:MenuPtr);
function PickHeader(y:byte;HdrList:HdrPtr):byte;
function PickList(InputList:PickListPtr):byte;
procedure OpenPickList(InputList:PickListPtr);
procedure ClosePickList(InputList:PickListPtr);
procedure GetFile(var RtnFileName:FileString;FileMask:FileString;path:linestrg;var RtnCode:byte);
function Real2Str(InpReal:real;w,d:byte):string;
Function exist(FileName:linestrg):boolean;
Function LoadHelpFile(var HelpFilePath:LineStrg;HelpFileName:FileString):boolean;
procedure OpenHeader(y:byte;HdrList:HdrPtr);

implementation
var
        ch              :char;
        TimeQuit        :boolean;
        PickListMax          :byte;
        Xpos,Ypos            :byte;
        MaxRows              :byte;
        y                    :byte;
        PickListSelX         :byte;
        PickListSelY         :byte;
        Keycode          :byte;
        PDrtn            :byte;

function Real2Str(InpReal:real;w,d:byte):string;
const
     HiReal = 1e5;
     LoReal = 1e-3;
var
     StringVar  :string[20];
begin
     if (abs(InpReal) >= 1e5) then str(InpReal:w:-1,StringVar);
     if ((abs(InpReal) < 1e-2) and (InpReal <> 0))
          then str(InpReal:w:-1,StringVar);
     if ((abs(InpReal) < 1e5) and (abs(InpReal) >= 1e-2) or (InpReal = 0))
          then str(InpReal:w:d,StringVar);
     while(stringVar[1] = ' ') do
           delete(StringVar,1,1);
     Real2Str := StringVar;
end;

procedure HideCurs;
begin
     regs.ah := 1;
     regs.ch := $20;
     regs.cl := 0;
     intr($10,regs);
end;

procedure UnHideCurs;
begin
     regs.ah := 1;
     regs.ch := CursStart;
     regs.cl := CursEnd;
     intr($10,regs);
end;

procedure PDSel(MenuList:MenuPtr;MenuSel:byte);forward;

procedure ErrorMessage;
var
     ta   :byte;
begin
     ta := TextAttr;
     Bad_Beep;
     OpenIOWindow(ErrorList);
     writeln('Error # ',ErrorNum);
     writeln(ErrorMessStr[ErrorNum]);
     writeln('Hit <Esc> to continue...');
     InEsc;
     CloseIOWindow(ErrorList);
     ErrorNum := NoError;
     TextAttr := ta;
end;

procedure SetTxtFg(col:byte);
begin
        TxtFg := col;
        TextColor(col);
end;

procedure SetTxtBg(col:byte);
begin
        TxtBg := col;
        TextBackground(col);
end;

procedure sv_screen(x1,y1,x2,y2:byte;screen_dat:HalfScreenPtr);
var
        i,j     :byte;
        indx    :integer;
begin
        indx := 0;
        for i := x1 to x2 do
                for j := y1 to y2 do begin
                        indx := indx + 1;
                        screen_dat^[indx] := screen^[j,i].ch;
                        indx := indx + 1;
                        screen_dat^[indx] := screen^[j,i].at;
                end;
end;

procedure restore_screen(x1,y1,x2,y2:byte;screen_dat:HalfScreenPtr);
var
        i,j     :byte;
        indx    :integer;
begin
        indx := 0;
        for i := x1 to x2 do
                for j := y1 to y2 do begin
                        indx := indx + 1;
                        screen^[j,i].ch := screen_dat^[indx];
                        indx := indx + 1;
                        screen^[j,i].at := screen_dat^[indx];
                end;
end;

procedure sv_wh_screen(screen_dat:screenptr);
begin
        screen_dat^ := screen^;
end;

procedure restore_wh_screen(screen_dat:screenptr);
begin
        screen^ := screen_dat^;
end;

procedure border(x1,y1,x2,y2,fg,bg:byte);
var
     i         :integer;
begin
     TextColor(fg);
     TextBackground(bg);

     for i := succ(x1) to pred(x2) do begin
         gotoxy(i,y1);
         write(#196);
         gotoxy(i,y2);
         write(#196);
     end;

     for i := succ(y1) to pred(y2) do begin
         gotoxy(x1,i);
         write(#179);
         gotoxy(x2,i);
         write(#179);
     end;

     gotoxy(x1,y1);
     write(#218);
     gotoxy(x2,y1);
     write(#191);
     gotoxy(x1,y2);
     write(#192);
     gotoxy(x2,y2);
     write(#217);

end;

procedure OpenIOWindow(MessageList:MessagePtr);
var
        x1,y1,x2,y2,indx,l,x      :byte;
        wx1,wy1,wx2,wy2       :byte;
begin
     if not(auto) then begin
        MessageList^.OldX := wherex;
        MessageList^.OldY := wherey;
        MessageList^.OldWindMin := WindMin;
        MessageList^.OldWindMax := WindMax;
        x1 := MessageList^.x;
        y1 := MessageList^.y;
        x2 := x1 + MessageList^.dX + 1;
        y2 := y1 + MessageList^.dY + 1;
        sv_screen(x1,y1,x2,y2,MessageList^.ScreenBufPtr);
        window(1,1,80,25);
        border(x1,y1,x2,y2,MessageList^.BorderFg,MessageList^.BorderBg);
        l := length(MessageList^.Title);
        if l <> 0 then begin
                x := round((x2-x1-l)/2) + x1;
                gotoxy(x,y1);
                write(MessageList^.Title);
        end;
        window(succ(x1),succ(y1),pred(x2),pred(y2));
        TextBackground(MessageList^.Bg);
        TextColor(MessageList^.Fg);
        clrscr;
     end;
end;

procedure CloseIOWindow(MessageList:MessagePtr);
var
        x1,y1,x2,y2,indx,l,x      :byte;
        wx1,wy1,wx2,wy2       :byte;
begin
     if not(auto) then begin
        x1 := MessageList^.x;
        y1 := MessageList^.y;
        x2 := x1 + MessageList^.dX + 1;
        y2 := y1 + MessageList^.dY + 1;
        restore_screen(x1,y1,x2,y2,MessageList^.ScreenBufPtr);
        wx1 := lo(MessageList^.OldWindMin) + 1;
        wy1 := hi(MessageList^.OldWindMin) + 1;
        wx2 := lo(MessageList^.OldWindMax) + 1;
        wy2 := hi(MessageList^.OldWindMax) + 1;
        window(wx1,wy1,wx2,wy2);
        gotoxy(MessageList^.OldX,MessageList^.OldY);
     end;
end;

procedure HelpMessage;
var
     indx           :integer;
     pagenum        :byte;
     LastHelpNum    :array[1..MaxHelpPages] of integer;
     InpHelpNum     :integer;
     NoMoreHelp     :boolean;
     ch             :char;
     First          :boolean;
     ta             :byte;
begin
     ta := TextAttr;
     OpenIOWindow(HelpList);
     if HelpFileFound then begin
          if HelpNum > MaxHelps then begin
               ErrorNum := SeekPastHelp;
          end
          else begin
               NoMoreHelp := false;
               InpHelpNum := HelpNum;
               PageNum := 1;
               First := true;
               repeat
                    seek(HelpFile,HelpNum);
                    read(HelpFile,HelpVar);
                    clrscr;
                    for indx := 1 to MaxHelpLines do
                         writeln(HelpVar.str[indx]);
                    writeln;
                    if ((HelpVar.NextRec = 0) and First) then begin
                            write('<Esc> - Return');
                            NoMoreHelp := true;
                            InEsc;
                    end
                    else begin
                            First := false;
                            write('<N> - next, <B> - back, <Esc> - Return');
                            inkey(['N','B',#27],ch);
                            case ch of
                                 'B'  :begin
                                           if PageNum = 1 then bad_beep
                                           else begin
                                                HelpNum := LastHelpNum[PageNum];
                                                dec(PageNum);
                                           end;
                                      end;
                                 'N'  :begin
                                           if HelpVar.NextRec = 0 then bad_beep
                                           else begin
                                                inc(PageNum);
                                                LastHelpNum[PageNum] := HelpNum;
                                                HelpNum := HelpVar.NextRec;
                                           end;
                                      end;
                                 #27  :NoMoreHelp := true;
                            end;
                    end;
               until NoMoreHelp;
               HelpNum := InpHelpNum;
          end;
     end
     else begin
          writeln('Help file was not found upon initialization..');
          writeln('Help number = ',HelpNum);
          writeln;
          write('Hit <Esc> to continue');
          InEsc;
     end;
     CloseIOWindow(HelpList);
     TextAttr := ta;
end;

function pass_keycode(var ch:char):byte;
var
        pass_key_int    :byte;
        RtnOk     :boolean;
begin
repeat
        RtnOk := true;
        ch := readkey;
        func_key_bool := false;
        Pass_key_int := 255;
        ch := upcase(ch);
        case ch of
                #0     :begin
                              func_key_bool := true;
                              ch := readkey;
                              Pass_key_int := func_key;
                              case ch of
                                      lt_arr_asc  :Pass_key_int := lt_arr;
                                      fn_home_asc :Pass_key_int := fn_home;
                                      fn_end_asc  :Pass_key_int := fn_end;
                                      fn_pgdn_asc :Pass_key_int := fn_pgdn;
                                      fn_pgup_asc :Pass_key_int := fn_pgup;
                                      rt_arr_asc  :Pass_key_int := rt_arr;
                                      up_arr_asc  :Pass_key_int := up_arr;
                                      dn_arr_asc  :Pass_key_int := dn_arr;
                                      f1_asc      :Pass_key_int := f1;
                                      f2_asc      :Pass_key_int := f2;
                                      f3_asc      :Pass_key_int := f3;
                                      f4_asc      :Pass_key_int := f4;
                                      f5_asc      :Pass_key_int := f5;
                                      f6_asc      :Pass_key_int := f6;
                                      f7_asc      :Pass_key_int := f7;
                                      f8_asc      :Pass_key_int := f8;
                                      f9_asc      :Pass_key_int := f9;
                                      f10_asc     :Pass_key_int := f10;
                                      ctl_lt_asc  :Pass_key_int := ctl_lt_arr;
                                      ctl_rt_asc  :Pass_key_int := ctl_rt_arr;
                                      ins_asc     :Pass_key_int := InsKey;
                                      del_asc     :Pass_key_int := DelKey;
                              end;
                        end;
               #8       :Pass_key_int := back_spc;
               #13      :Pass_key_int := carr_rtn;
               #27      :Pass_key_int := escape;
               #52      :Pass_key_int := sh_lt_arr;
               #54      :Pass_key_int := sh_rt_arr;
               #43      :Pass_key_int := plus_key;
               #45      :Pass_key_int := minus_key;
        end; {of case}
        if func_key_bool then ch := '*';
        pass_keycode := pass_key_int;
        case pass_key_int of
                f1      :begin
                              HelpMessage;
                              RtnOk := false;
                        end;
        end;
until RtnOk;
end;

procedure WaitEscape;
var
     t    :byte;
     ch   :char;
begin
     repeat
          t := pass_keycode(ch);
          if t<> escape then bad_beep;
     until t=escape;
end;

procedure InputString(InpStr:LineStrg; MaxCh:byte;
                      var OutStr:LineStrg; var RtnCode:byte);
var
        GetKey          :byte;
        Indx            :integer;
        RtnTime,TimeQuit:boolean;
        tx,ty           :integer;
        ch              :char;
        i,los           :byte;
begin
        tx := wherex;
        ty := wherey;
        for indx := 1 to MaxCh do write(' ');
        gotoxy(tx,ty);
        if length(InpStr) >= MaxCh
             then for indx := 1 to MaxCh do write(InpStr[indx])
             else write(InpStr);
        gotoxy(tx,ty);
        TimeQuit := False;
        OutStr := InpStr;
        Indx := 1;
        repeat
                los := Length(OutStr);
                GetKey := Pass_Keycode(ch);
                Case GetKey of
                        Back_Spc        :begin
                                                if indx > 1 then begin
                                                        dec(indx);
                                                        delete(OutStr,indx,1);
                                                        gotoxy(tx,ty);
                                                        for i := 0 to los do write(' ');
                                                        gotoxy(tx,ty);
                                                        write(OutStr);
                                                end
                                                else bad_beep;
                                        end;
                        Carr_Rtn        :begin
                                                RtnCode := InputOK;
                                                TimeQuit := True;
                                        end;
                        Rt_Arr          :begin
                                                if indx <= los then begin
                                                     inc(indx);
                                                end
                                                else bad_beep;
                                        end;
                        Lt_Arr          :begin
                                                if indx > 1 then begin
                                                     dec(indx);
                                                end
                                                else bad_beep;
                                        end;
                        Fn_End          :begin
                                                if los < MaxCh then begin
                                                      indx := los + 1;
                                                end
                                                else indx := los;
                                        end;
                        Fn_Home         :begin
                                                indx := 1;
                                        end;
                        InsKey          :begin
                                                if ((los < MaxCh) and (indx <= los)) then begin
                                                        Insert(' ',OutStr,indx);
                                                        gotoxy(tx,ty);
                                                        for i := 0 to los do write(' ');
                                                        gotoxy(tx,ty);
                                                        write(OutStr);
                                                end
                                                else bad_beep;
                                        end;
                        DelKey          :begin
                                                if los > 0 then begin
                                                        Delete(OutStr,indx,1);
                                                        gotoxy(tx,ty);
                                                        for i := 0 to los do write(' ');
                                                        gotoxy(tx,ty);
                                                        write(OutStr);
                                                end
                                                else bad_beep;
                                        end;
                        Escape          :begin
                                                RtnCode := NoInput;
                                                OutStr := '';
                                                TimeQuit := True;
                                        end;
                        else if ((indx <= MaxCh) and (not (Func_Key_Bool))) then begin
                                if indx=1 then begin
                                        gotoxy(tx,ty);
                                        for i := 1 to MaxCh do
                                                write(' ');
                                        gotoxy(tx,ty);
                                        OutStr := ch;
                                end
                                else if indx > Length(OutStr) then begin
                                        OutStr := OutStr + ch;
                                     end
                                     else OutStr[indx] := ch;
                                inc(indx);
                                write(ch);
                        end
                        else bad_beep;
                end; {of case get_key}
                if not(TimeQuit) then begin
                        gotoxy(tx+indx-1,ty);
                end;
        until TimeQuit;
end;

procedure ConvertString(var InpStr:LineStrg; MaxCh,VarCode:byte;
                      var RtnCode:byte; VarAddr:pointer);
const
     MaximumInt = 32767;
     MinimumInt = -32768;
var
     x         :integer;
     li        :longint;
     r         :real;
     i         :integer;
     ts        :linestrg;

begin
          case VarCode of
               LongIntCode    :val(InpStr,li,x);
               RealCode       :begin
                                    val(InpStr,r,x);
                                    if x <> 0 then begin
                                        insert('0',InpStr,1);
                                        val(InpStr,r,x);
                                    end;
                              end;
               IntCode        :begin
                                    x := 0;
                                    val(InpStr,li,x);
                                    if li > MaximumInt then x := 1;
                                    if li < MinimumInt then x := 1;
                                    if x=0 then i := li;
                              end;
               StringCode     :x := 0;
          end;
          if x <> 0 then begin
               RtnCode := InputError;
          end
          else begin
               if VarAddr <> nil then begin
                    RtnCode:= InputOK;
                    case VarCode of
                         LongIntCode    :begin
                                             longint(VarAddr^) := li;
                                             str(li,InpStr);
                                        end;
                         RealCode       :begin
                                             real(VarAddr^) := r;
                                             InpStr := Real2Str(r,MaxCh,2);
                                        end;
                         IntCode        :begin
                                             integer(VarAddr^) := i;
                                             str(i,InpStr);
                                        end;
                         StringCode     :begin
                                             linestrg(VarAddr^) := InpStr;
                                        end;
                    end;
               end
               else RtnCode := NoOutput;
          end;
end;

procedure PDSel(MenuList:MenuPtr;MenuSel:byte);
begin
        textcolor(MenuList^.SelFg);
        textbackground(MenuList^.SelBg);
        gotoxy(1,MenuSel);
        write(MenuList^.str[MenuSel]:MenuList^.TxtLen);
        gotoxy(1,MenuSel);
end;

procedure PDUnSel(MenuList:MenuPtr;MenuSel:byte);
var
     FC   :byte;
     i2   :byte;
     indx :byte;
     ch   :char;
begin
     textbackground(MenuList^.NoSelBg);
     ch := MenuList^.SelPattern[MenuSel];
     if ch = '*' then begin
         TextColor(MenuList^.Fg);
         gotoxy(1,MenuSel);
         write(MenuList^.str[MenuSel]:MenuList^.TxtLen);
         ch := MenuList^.PickKey[MenuSel];
         ch := upcase(ch);
         i2 := 0;
         indx := 0;
         while ((i2=0) and (indx < (length(MenuList^.str[MenuSel])))) do begin
               inc(indx);
               if ch = upcase(MenuList^.str[MenuSel][indx])
                    then i2 := indx;
         end;
         if (i2 <> 0) then begin
              fc := MenuList^.TxtLen - length(MenuList^.str[MenuSel]) + i2;
              gotoxy(fc,MenuSel);
              textcolor(PickKeyFg);
              write(upcase(MenuList^.str[MenuSel][i2]));
              gotoxy(1,MenuSel);
         end;
     end
     else begin
         TextColor(MenuList^.NoSelFg);
         gotoxy(1,MenuSel);
         write(MenuList^.str[MenuSel]:MenuList^.TxtLen);
     end;
end;

procedure OpenPullDownMenu(MenuList:MenuPtr);
var
        x1,y1,x2,y2,indx,l,x      :byte;
        MenuMax         :byte;
        pch             :char;
        MenuSel         :byte;
        ok              :boolean;
        fc              :byte;
begin
     if not(auto) then begin
        MenuList^.OldWindMin := WindMin;
        MenuList^.OldWindMax := WindMax;
        MenuMax := MenuList^.Max;
        x1 := MenuList^.x;
        y1 := MenuList^.y;
        x2 := x1 + MenuList^.Width + 1;
        y2 := y1 + MenuList^.Max + 1;
        sv_screen(x1,y1,x2,y2,MenuList^.ScreenBufPtr);
        window(1,1,80,25);
        border(x1,y1,x2,y2,MenuList^.BorderFg,MenuList^.BorderBg);
        l := length(MenuList^.Title);
        if l <> 0 then begin
                x := round((x2-x1-l)/2) + x1;
                gotoxy(x,y1);
                write(MenuList^.Title);
        end;
        window(succ(x1),succ(y1),pred(x2),pred(y2));
        TextBackground(MenuList^.VarBg);
        clrscr;
        window(succ(x1),succ(y1),x2,pred(y2));

        MenuList^.SelPattern[1] := '*';
        if MenuList^.SelPattern[MenuList^.Sel] <> '*' then
            MenuList^.Sel := 1;

        for indx := 1 to MenuList^.Max do PDunsel(MenuList,indx);

        MenuSel := MenuList^.Sel;
        PDSel(MenuList,MenuSel);
     end;
end;

function PullDownMenu(MenuList:MenuPtr):byte;
var
        x1,y1,x2,y2,indx      :byte;
        MenuMax         :byte;
        pch,ch          :char;
        MenuSel         :byte;
        ok              :boolean;
begin
        MenuMax := MenuList^.Max;
        TimeQuit := False;
        x1 := MenuList^.x;
        y1 := MenuList^.y;
        x2 := x1 + MenuList^.Width + 1;
        y2 := y1 + MenuList^.Max + 1;
        TextColor(MenuList^.Fg);
        MenuSel := MenuList^.Sel;
        PDSel(MenuList,MenuSel);
        MenuList^.SelPattern[1] := '*';
        if MenuList^.SelPattern[MenuList^.Sel] <> '*' then
            MenuList^.Sel := 1;
repeat
      textcolor(MenuList^.Fg);
      keycode := pass_keycode(ch);
      PDrtn := 0;
      case keycode of
           carr_rtn  :begin
                        PullDownMenu := MenuSel;
                        TimeQuit := true;
                     end;
           escape    :begin
                        PullDownMenu := 0;
                        TimeQuit := true;
                     end;
           F10       :begin
                        PullDownMenu := 0;
                        TimeQuit := true;
                        Rtn2Main := true;
                     end;
           up_arr    :begin
                           PDUnSel(MenuList,MenuSel);
                           repeat
                                if MenuSel = menu_min then
                                   MenuSel := MenuMax else
                                   MenuSel := MenuSel - 1;
                                pch := MenuList^.SelPattern[MenuSel];
                           until pch='*';
                           PDSel(MenuList,MenuSel);
                     end;
           rt_arr    :if MenuList^.EnLtRt then begin
                        PDrtn := rt_arr;
                        PullDownMenu := 0;
                        TimeQuit := true;
                     end;
           lt_arr    :if MenuList^.EnLtRt then begin
                        PDrtn := lt_arr;
                        PullDownMenu := 0;
                        TimeQuit := true;
                     end;
           dn_arr    :begin
                           PDUnSel(MenuList,MenuSel);
                           repeat
                                if MenuSel = MenuMax then
                                   MenuSel := menu_min else
                                   MenuSel := MenuSel + 1;
                                pch := MenuList^.SelPattern[MenuSel];
                           until pch='*';
                           PDSel(MenuList,MenuSel);
                     end;
      else begin
          indx := pos(ch,MenuList^.PickKey);
          if ((indx <> 0)
                and (MenuList^.SelPattern[indx] = '*'))
                then begin
                       PDUnSel(MenuList,MenuSel);
                       PullDownMenu := indx;
                       MenuSel := indx;
                       TimeQuit := true;
                       PDSel(MenuList,MenuSel);
                end;
          if not(TimeQuit) then bad_beep;
      end;
      end; {of case keycode}
until TimeQuit;

MenuList^.Sel := MenuSel;
end;

procedure ClosePullDownMenu(MenuList:MenuPtr);
var
        x1,y1,x2,y2,indx      :byte;
        wx1,wy1,wx2,wy2       :byte;
begin
     if not(auto) then begin
        x1 := MenuList^.x;
        y1 := MenuList^.y;
        x2 := x1 + MenuList^.Width + 1;
        y2 := y1 + MenuList^.Max + 1;
        restore_screen(x1,y1,x2,y2,MenuList^.ScreenBufPtr);
        wx1 := lo(MenuList^.OldWindMin) + 1;
        wy1 := hi(MenuList^.OldWindMin) + 1;
        wx2 := lo(MenuList^.OldWindMax) + 1;
        wy2 := hi(MenuList^.OldWindMax) + 1;
        window(wx1,wy1,wx2,wy2);
     end;
end;

procedure HLsel(num,y:byte;HdrList:HdrPtr);
begin
     TextColor(MenuSelFg);
     TextBackGround(MenuSelBg);
     gotoxy(((num-1)*HdrWidth)+1,y);
     write(HdrList^.str[num]);
end;

procedure HLunsel(num,y:byte;HdrList:HdrPtr);
begin
     TextBackGround(MenuNoSelBg);
     TextColor(MenuNoSelFg);
     gotoxy(((num-1)*HdrWidth)+1,y);
     write(HdrList^.str[num]);

     TextColor(PickKeyFg);
     gotoxy(((num-1)*HdrWidth)+1,y);
     write(HdrList^.str[num][1]);
end;

procedure OpenHeader(y:byte;HdrList:HdrPtr);
var
     ta        :byte;
     indx      :byte;
begin
        ta := TextAttr;
        TextColor(MenuNoSelFg);
        TextBackGround(MenuNoSelBg);
        gotoxy(1,y);
        clreol;

        for indx := 1 to HdrList^.Max do begin
               HLunsel(indx,y,HdrList);
        end;

        HLsel(HdrList^.Sel,y,HdrList);
        TextAttr := ta;
end;

function PickHeader(y:byte;HdrList:HdrPtr):byte;
var
        HdrSel          :byte;
        HdrMax          :byte;
        ta              :byte;
        TempSel         :byte;
begin

ta := textattr;
HdrSel := HdrList^.sel;
HdrMax := HdrList^.max;
repeat
      if (PDrtn=0) then keycode := pass_keycode(ch)
           else KeyCode := PDrtn;
      case keycode of
           carr_rtn  :begin
                        PDrtn := 0;
                        PickHeader := HdrSel;
                        TimeQuit := true;
                     end;
           lt_arr    :begin
                           if PDrtn <> 0 then PDrtn := Carr_rtn;
                           HLunsel(HdrSel,y,HdrList);

                           if HdrSel = 1 then
                              HdrSel := HdrMax else
                              HdrSel := HdrSel - 1;

                           HLsel(HdrSel,y,HdrList);
                     end;
           rt_arr    :begin
                           if PDrtn <> 0 then PDrtn := Carr_rtn;
                           HLunsel(HdrSel,y,HdrList);

                           if HdrSel = HdrMax then
                              HdrSel := 1 else
                              HdrSel := HdrSel + 1;

                           HLsel(HdrSel,y,HdrList);
                     end;
           up_arr    :begin
                     end;
           dn_arr    :begin
                     end;
           else begin
                 TempSel := pos(ch,HdrList^.PickKey);
                 if TempSel <> 0 then begin
                       HLunsel(HdrSel,y,HdrList);
                       HdrSel := TempSel;
                       HLsel(HdrSel,y,HdrList);
                       PickHeader := HdrSel;
                       TimeQuit := true;
                 end
                 else bad_beep;
           end;
      end; {of case keycode}
until TimeQuit;

HdrList^.Sel := HdrSel;
TextAttr := ta;
end;

procedure PLSel(InputList:PickListPtr);
begin
        PickListSelX := (PickListSel-1) mod PickListMaxX;
        PickListSelY := ((PickListSel-1) div PickListMaxX) +1;

        Xpos := (PickListSelX*PickListWidth)+1;
        Ypos := PickListSelY;
        gotoxy(Xpos,Ypos);

        textbackground(InputList^.SelBg);
        TextColor(InputList^.Fg);
        write(InputList^.str[PickListSel]:PickListWidth);
end;

procedure PLUnSel(InputList:PickListPtr);
begin
        Xpos := (PickListSelX*PickListWidth)+1;
        Ypos := PickListSelY;
        gotoxy(Xpos,Ypos);
        TextColor(InputList^.NoSelFg);
        textbackground(InputList^.NoSelBg);
        write(InputList^.str[PickListSel]:PickListWidth);
end;

Procedure OpenPickList(InputList:PickListPtr);
var
        l,x,w                :byte;
        x1,y1,x2,y2          :byte;
        indx1,indx2,indx3    :byte;
begin
     if not(auto) then begin
        if InputList^.sel > InputList^.max then Inputlist^.sel := 1;
        y := InputList^.y;
        PickListMax       := InputList^.Max;
        PickListMaxX      := InputList^.MaxX;
        PickListMaxY      := trunc((PickListMax-1)/PickListMaxX) + 1;
        x1 := InputList^.x;
        x2 := PickListMaxX * PickListWidth + 2 + x1;
        y1 := y;
        y2 := y + PickListMaxY + 1;
        sv_screen(x1,y1,x2,y2,InputList^.ScreenBufPtr);
        InputList^.OldWindMin := WindMin;
        InputList^.OldWindMax := WindMax;
        window(1,1,80,25);
        border(x1,y1,x2,y2,InputList^.BorderFg,InputList^.BorderBg);
        l := length(InputList^.Title);
        if l <> 0 then begin
                x := round((x2-x1-l)/2) + x1;
                gotoxy(x,y1);
                write(InputList^.Title);
        end;
        window(succ(x1),succ(y1),pred(x2),pred(y2));
        TextColor(InputList^.NoSelFg);
        TextBackground(InputList^.NoSelBg);
        clrscr;
        indx3 := 0;
        for indx2 := 1 to PickListMaxY do begin
            gotoxy(1,indx2);
            for indx1 := 1 to PickListMaxX do begin
                indx3 := indx3 + 1;
                if indx3 <= PickListMax then
                    write(InputList^.str[indx3]:PickListWidth);
            end;
        end;

        PickListSel  := InputList^.sel;
        PLSel(InputList);
     end;
end;

function PickList(InputList:PickListPtr):byte;
begin
        PickListMax   := InputList^.Max;
        PickListMaxX  := InputList^.MaxX;
        TimeQuit := False;
        SetTxtFg(InputList^.Fg);
        SetTxtBg(InputList^.NoSelBg);
        y := InputList^.y;

        MaxRows := (trunc(PickListMax/PickListMaxX)+1);

        PickListSel  := InputList^.sel;
        PLSel(InputList);

repeat
      PDrtn := 0;
      keycode := pass_keycode(ch);
      case keycode of
           carr_rtn  :begin
                        InputList^.sel := PickListSel;
                        PickList := PickListSel;
                        TimeQuit := true;
                     end;
           escape   :begin
                        InputList^.sel := PickListSel;
                        PickList := 0;
                        TimeQuit := true;
                     end;
           F10      :begin
                        InputList^.sel := PickListSel;
                        PickList := 0;
                        TimeQuit := true;
                        Rtn2Main := true;
                     end;
           lt_arr    :begin
                           PLUnSel(InputList);
                           if PickListSel = 1 then
                              PickListSel := PickListMax else
                              PickListSel := PickListSel - 1;
                           PLSel(InputList);
                     end;

           rt_arr    :begin
                           PLUnSel(InputList);
                           if PickListSel = PickListMax then
                              PickListSel := 1 else
                              PickListSel := PickListSel + 1;
                           PLSel(InputList);
                     end;
           up_arr    :begin
                           PLUnSel(InputList);
                           if PickListSelY <> 1 then begin
                                   PickListSel := PickListSel - PickListMaxX;
                                   PickListSelY := trunc((PickListSel-1)/PickListMaxX)+1;
                           end
                           else begin
                                   if ((MaxRows-1) * PickListMaxX) + (PickListSelX+1) > PickListMax then
                                      PickListSelY := MaxRows-1 else
                                      PickListSelY := MaxRows;
                                    PickListSel := ((PickListSelY-1)*PickListMaxX)+PickListSelX+1;
                           end;
                           PLSel(InputList);
                     end;
           dn_arr    :begin
                           PLUnSel(InputList);
                           if PickListSel <= PickListMax - PickListMaxX then
                              PickListSel := PickListSel + PickListMaxX else
                              PickListSel := PickListSelX + 1;
                           PLSel(InputList);
                     end;
           fn_home   :begin
                           PLUnSel(InputList);
                           PickListSel := 1;
                           PLSel(InputList);
                     end;
           fn_end    :begin
                           PLUnSel(InputList);
                           PickListSel := PickListMax;
                           PLSel(InputList);
                     end;
      else bad_beep;
      end; {of case keycode}
until TimeQuit;
end;

procedure ClosePickList(InputList:PickListPtr);
var
        x1,y1,x2,y2,indx,y    :byte;
        wx1,wy1,wx2,wy2       :byte;
        PickListMax          :byte;
begin
     if not(auto) then begin
        y := InputList^.y;
        PickListMax       := InputList^.Max;
        PickListMaxX      := InputList^.MaxX;
        PickListMaxY      := trunc((PickListMax-1)/PickListMaxX) +1;
        x1 := InputList^.x;
        x2 := PickListMaxX * PickListWidth + 2 + x1;
        y1 := y;
        y2 := y + PickListMaxY + 1;
        restore_screen(x1,y1,x2,y2,InputList^.ScreenBufPtr);
        wx1 := lo(InputList^.OldWindMin) + 1;
        wy1 := hi(InputList^.OldWindMin) + 1;
        wx2 := lo(InputList^.OldWindMax) + 1;
        wy2 := hi(InputList^.OldWindMax) + 1;
        window(wx1,wy1,wx2,wy2);
     end;
end;

procedure UpdateMenu(MenuName:MenuPtr);
var
     w         :integer;
     s         :string[1];
     pch       :char;
     indx      :integer;
     vp        :InpStrPtr;
     ok        :boolean;
     fc        :byte;
begin
     if not(auto) then begin
        ok := false;
        for indx := 1 to MenuName^.Max do begin
               pch := MenuName^.SelPattern[indx];
               if pch='*' then ok := true;
        end;
        if not ok then
              for indx := 1 to MenuName^.Max do
                     MenuName^.SelPattern[indx] := '*';

     w := MenuName^.Width - MenuName^.TxtLen - 2;
     TextColor(MenuName^.VarFg);
     TextBackground(MenuName^.VarBg);
     if MenuName^.VarPtr <> nil then begin
          vp := MenuName^.VarPtr;
          for indx := 1 to MenuName^.Max do begin
               gotoxy(MenuName^.TxtLen+1,indx);
               write(' ');
               if length(Vp^[indx].Str) > W then begin
                    Delete(Vp^[indx].Str,W+1,80);
                    Vp^[indx].Str[W-1] := ' ';
                    Vp^[indx].Str[W] := '>';
               end;
               write(vp^[indx].Str:w);
               write(' ');
          end;
     end;
        TextBackground(MenuName^.NoSelBg);
        for indx := 1 to MenuName^.Max do PDunsel(MenuName,indx);

        TextColor(MenuName^.Fg);
        PDSel(MenuName,MenuName^.Sel);
     end;
end;

procedure GetFile(var RtnFileName:FileString;FileMask:FileString;path:linestrg;var RtnCode:byte);
var
     MenuVal        :byte;
     i,indx         :integer;
     SearchFile     :linestrg;
     FilePath       :Linestrg;
     DirInfo        :searchrec;
begin
     if not(auto) then begin
     FilePath := path;
     if FilePath = '' then begin
          GetDir(0,FilePath);
     end;
     if FilePath[length(FilePath)] <> '\'
          then FilePath := FilePath + '\';
     SearchFile := FilePath + FileMask;
     findfirst(SearchFile,anyfile,dirinfo);
     DirList^.str[1] := '';
     i := 1;
     while ((doserror = 0) and (i < PickListMaxStr)) do begin
           i := i + 1;
           indx := length(dirinfo.name);
           DirList^.str[i] := dirinfo.name;
           findnext(dirinfo);
     end;
     if i > 1 then begin
          DirList^.Max := i;
          DirList^.Title := 'Directory of ' + SearchFile;
          OpenPickList(DirList);
          MenuVal := PickList(DirList);
          if MenuVal <> 0 then begin
               RtnFileName := DirList^.str[MenuVal];
               RtnCode := FilePicked;
          end
          else RtnCode := NoFilePicked;
          ClosePickList(DirList);
     end
     else begin
          RtnCode := NoFileFound;
     end;
     end;
end;

Function exist(FileName:linestrg):boolean;
begin
     FindFirst(FileName,AnyFile,DirInfo);
     if DosError=0 then exist := true
          else exist := false;
end;

Function LoadHelpFile(var HelpFilePath:LineStrg;HelpFileName:FileString):boolean;
const
     PathLength     = 30;
     FilePlusPath   = 42;
var
     KeepTrying     :boolean;
     Found          :boolean;
     rc,ta          :byte;
     HelpFileString :string[FilePlusPath];
begin
     found := false;
     if exist(HelpFileName) then begin
          HelpFilePath := '';
          HelpFileString := HelpFileName;
          Found := true
     end
     else begin
          HelpFileString := HelpFilePath + HelpFileName;
          if exist(HelpFileString) then
               Found := true;
     end;
     if not(Found) then begin
          KeepTrying := true;
          UnHideCurs;
          OpenIoWindow(HelpList);
          ta := TextAttr;
          repeat
               TextAttr := ta;
               if HelpFilePath[length(HelpFilePath)] <> '\'
                    then HelpFilePath := HelpFilePath + '\';
               HelpFileString := HelpFilePath + HelpFileName;
               if exist(HelpFileString) then begin
                    KeepTrying := false;
                    Found := true;
               end
               else begin
                    writeln('Help file NOT found...');
                    write('New path, (<esc> to stop trying):  ');
                    TextColor(VarInpFg);
                    TextBackground(VarInpBg);
                    InputString('',PathLength,HelpFilePath,rc);
                    if rc <> 0 then begin
                         KeepTrying := false;
                         Found := False;
                    end;
               end;
          until not KeepTrying;
          CloseIoWindow(HelpList);
          TextAttr := ta;
          HideCurs;
     end;
     if found then begin
          assign(HelpFile,HelpFileString);
          reset(HelpFile);
          MaxHelps := FileSize(HelpFile);
     end;
     LoadHelpFile := found;
end;

function Confirmed(InitVal,Auto: boolean):boolean;
var
     menu :byte;
begin
     if Auto then Confirmed := true
     else begin
          if InitVal then ConfirmMenu^.sel := 1
               Else ConfirmMenu^.sel := 2;
          OpenPullDownMenu(ConfirmMenu);
          Menu := PullDownMenu(ConfirmMenu);
          if Menu = 1 then Confirmed := true
               else Confirmed := False;
          ClosePullDownMenu(ConfirmMenu);
     end;
end;

procedure InitMenuCode;
begin
     PDrtn := Carr_Rtn;
     new(DirScreen);
     new(DirList);
        DirList^.sel      := 1;
        DirList^.y        := 13;
        DirList^.x        := 1;
        DirList^.MaxX     := 5;
        DirList^.BorderBg := MenuBorderBg;
        DirList^.BorderFg := MenuBorderFg;
        DirList^.Fg       := MenuSelFg;
        DirList^.SelBg    := MenuSelBg;
        DirList^.NoSelBg  := MenuNoSelBg;
        DirList^.NoSelFg  := MenuNoSelFg;
        DirList^.title    := 'Directory';
        DirList^.ScreenBufPtr := DirScreen;

     New(ConfirmScreen);
     New(ConfirmMenu);
        ConfirmMenu^.str[1]   := 'Yes ';
        ConfirmMenu^.str[2]   := 'No ';
        ConfirmMenu^.str[3]   := '';
        ConfirmMenu^.PickKey  := 'YN';
        ConfirmMenu^.EnLtRt   := false;
        ConfirmMenu^.max      := 3;
        ConfirmMenu^.SelPattern := '** *****';
        ConfirmMenu^.NoSelFg  := black;
        ConfirmMenu^.sel      := 1;
        ConfirmMenu^.x        := 57;
        ConfirmMenu^.y        := 5;
        ConfirmMenu^.TxtLen   := 14;
        ConfirmMenu^.Width    := 14;
        ConfirmMenu^.BorderBg := MenuBorderBg;
        ConfirmMenu^.BorderFg := MenuBorderFg + blink;
        ConfirmMenu^.Fg       := MenuHiFg;
        ConfirmMenu^.SelFg    := MenuSelFg;
        ConfirmMenu^.SelBg    := MenuSelBg;
        ConfirmMenu^.NoSelBg  := MenuNoSelBg;
        ConfirmMenu^.NoSelFg  := MenuLoFg;
        ConfirmMenu^.VarFg    := MenuVarFg;
        ConfirmMenu^.VarBg    := MenuVarBg;
        ConfirmMenu^.title    := 'Confirm?';
        ConfirmMenu^.ScreenBufPtr:= ConfirmScreen;
end;

begin
     PDrtn := 0;
end.