home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / turbopas / tp4menu1.arc / TP4MENU.PAS < prev    next >
Pascal/Delphi Source File  |  1988-11-10  |  10KB  |  246 lines
  1. {
  2. Copyright (c) 1988 BittWare Computing, ALL RIGHTS RESERVED
  3. }
  4. program tp4menu;
  5. {$v-}
  6. uses
  7.         dos,
  8.         crt,
  9.         beepkey4,
  10.         menuvars,
  11.         menucode,
  12.         inp_var,
  13.         pps_glob,
  14.         pps_init,
  15.         pps_usr;
  16. {const}
  17. var
  18.      NeverEnd  :boolean;
  19.      RtnByte   :byte;
  20.  
  21. procedure QuitProc;
  22. var
  23.         ta      :byte;
  24.         ts      :string[30];
  25. begin
  26.      Bad_Beep;
  27.      ts := PullDowns[ConfirmMenu]^.title;
  28.      PullDowns[ConfirmMenu]^.title := 'Quit?';
  29.      if Confirmed(pulldowns[ConfirmMenu],False) then begin
  30.           if HelpFileFound then Close(helpfile);
  31.           ChDir(HomeDir);
  32.           TextAttr := OldTextAttr;
  33.           window(1,1,80,25);
  34.           clrscr;
  35.           halt;
  36.      end
  37.      else PullDowns[ConfirmMenu]^.title := ts;
  38. end;
  39.  
  40. procedure LogOnMessage;
  41. var
  42.         ta      :byte;
  43.         ts      :string[30];
  44. begin
  45.         ta := textattr;
  46.         ts := IoList^.title;
  47.         IoList^.title := 'Welcome!';
  48.         OpenIoWindow(IoList);
  49.         writeln;
  50.         writeln('                            BittWare Computing      ');
  51.         writeln;
  52.         writeln('                                 presents  ');
  53.         writeln;
  54.         writeln('                        The Professional Program Shell');
  55.         writeln;
  56.         writeln;
  57.         writeln('  See readme.doc for general information');
  58.         writeln('  See tp4menu.doc for programming information');
  59.         writeln;
  60.         writeln('  Hit <enter> to use demo Shell');
  61.         In_Carr_Rtn;
  62.         CloseIoWindow(IoList);
  63.         IoList^.title := ts;
  64.         textattr := ta;
  65. end;
  66.  
  67. begin
  68.      GetDir(0,HomeDir);
  69.      OldTextAttr := TextAttr;
  70.      NeverEnd := false;
  71.  
  72.      clrscr;
  73.      writeln;
  74.      writeln;
  75.      writeln;
  76.      writeln('Copyright (c) BittWare Computing, ALL RIGHTS RESERVED');
  77.      writeln;
  78.      writeln('Initial Memory Available = ',memavail);
  79.      write('Initializing Globals...');
  80.           InitVars;
  81.      writeln('Done');
  82.      write('Initializing Menus...');
  83.           InitMenus;
  84.           InitMenuVars;
  85.      writeln('Done');
  86.      HelpFilePath := InitHelpFilePath;
  87.      HelpFileName := InitHelpFileName;
  88.      HelpFileFound := LoadHelpFile(HelpFilePath,HelpFileName);
  89.      if HelpFileFound then writeln('Help File Found')
  90.           else writeln('Help File NOT Found');
  91.      writeln('Post Init Memory = ',memavail);
  92.  
  93. HideCurs;
  94. TextColor(MainFg);
  95. TextBackground(MainBg);
  96. write('Hit <Enter> to begin...');
  97. in_carr_rtn;
  98. clrscr;
  99. LogOnMessage;
  100.  
  101. gotoxy(1,MaxTextRow);
  102. TextColor(BottomFg);
  103. TextBackground(BottomBg);
  104. write('<Arrows>-Move  <Enter>-Select/Change  <Esc>-Cancel  F1-Help  F10-Main Menu');
  105. clreol;
  106. TextColor(MainFg);
  107. TextBackground(MainBg);
  108.  
  109. repeat
  110. Rtn2Main := False;
  111. HelpNum := MainHeader;
  112. menu1 := PickHeader(1,HdrList);
  113. case menu1 of
  114.         1:  begin
  115.                OpenPullDownMenu(PullDowns[ExeMenu]);
  116.                repeat
  117.                   HelpNum := ExeMainHelp;
  118.                   menu2 := PullDownMenu(PullDowns[ExeMenu]);
  119.                   case menu2 of
  120.                           1:      begin
  121.                                         HelpNum := UserProc1Help;
  122.                                         if Confirmed(pulldowns[ConfirmMenu],CommandMode) then user1;
  123.                                   end;
  124.                           2:      begin
  125.                                         HelpNum := UserProc2Help;
  126.                                         if Confirmed(pulldowns[ConfirmMenu],CommandMode) then user2;
  127.                                   end;
  128.                           3:      begin
  129.                                         HelpNum := UserProc3Help;
  130.                                         if Confirmed(pulldowns[ConfirmMenu],CommandMode) then user3;
  131.                                   end;
  132.                           4:      begin
  133.                                         HelpNum := UserProc4Help;
  134.                                         if Confirmed(pulldowns[ConfirmMenu],CommandMode) then user4;
  135.                                   end;
  136.                   end;
  137.                until ((menu2=0) or Rtn2Main);
  138.                ClosePullDownMenu(PullDowns[ExeMenu]);
  139.             end;
  140.         2:begin
  141.                OpenPullDownMenu(PullDowns[FileMenu]);
  142.                repeat
  143.                     if ErrorNum <> 0 then ErrorMessage;
  144.                     HelpNum := FileMenuHelp;
  145.                     UpdateMenu(PullDowns[FileMenu]);
  146.                     menu2 := PullDownMenu(PullDowns[FileMenu]);
  147.                     mvp := PullDowns[FileMenu]^.VarPtr;
  148.                     Case menu2 of
  149.                          1    :begin
  150.                                    ts := DirSearchPath;
  151.                                    ts2 := mvp^[menu2].str;
  152.                                    InpVars(PullDowns[FileMenu],x,@DirSearchPath);
  153. {$i-}
  154.                                    ChDir(DirSearchPath);
  155.                                    if IOResult <> 0 then begin
  156.                                           ErrorNum := PathNotFound;
  157.                                           DirSearchPath := ts;
  158.                                           mvp^[menu2].str := ts2;
  159.                                    end;
  160.                                    ChDir(HomeDir);
  161. {$i+}
  162.                               end;
  163.                          2    :InpVars(PullDowns[FileMenu],x,@DirSearchMask);
  164.                          3    :begin
  165.                                    GetFile(flname,DirSearchMask,DirSearchPath,RtnByte);
  166.                                    mvp^[menu2].str := flname;
  167.                               end;
  168.                          4    :begin
  169.                                    OpenPickList(ColorList);
  170.                                    Menu3 := PickList(ColorList);
  171.                                    if menu3 <> 0 then begin
  172.                                         PullDowns[FileMenu]^.VarFg := Menu3-1;
  173.                                         mvp^[menu2].str := ColorList^.str[menu3];
  174.                                    end;
  175.                                    ClosePickList(ColorList);
  176.                               end;
  177.                          5    :begin
  178.                                    ColorList^.Max := 8;
  179.                                    OpenPickList(ColorList); 
  180.                                    Menu3 := PickList(ColorList);
  181.                                    if menu3 <> 0 then begin
  182.                                         PullDowns[FileMenu]^.VarBg := Menu3-1;
  183.                                         mvp^[menu2].str := ColorList^.str[menu3];
  184.                                    end;
  185.                                    ClosePickList(ColorList); 
  186.                                    ColorList^.Max := 16;
  187.                               end;
  188.                     end;
  189.                until ((menu2=0) or Rtn2Main);
  190.                ClosePullDownMenu(PullDowns[FileMenu]);
  191.           end;
  192.           3:begin      
  193.                OpenPullDownMenu(PullDowns[VarMenu]);
  194.                repeat
  195.                     HelpNum := DataEntryHelp;
  196.                     UpdateMenu(PullDowns[VarMenu]);
  197.                     menu2 := PullDownMenu(PullDowns[VarMenu]);
  198.                     mvp := PullDowns[VarMenu]^.VarPtr;
  199.                     case menu2 of
  200.                          1    :begin
  201.                                    HelpNum := MaskListHelp;
  202.                                    OpenPickList(MaskList);
  203.                                    menu3 := PickList(MaskList);
  204.                                    if menu3 <> 0 then begin
  205.                                         mvp^[menu2].str := MaskList^.str[menu3];
  206.                                         PullDowns[VarMenu]^.SelPattern := MaskId[menu3];
  207.                                    end;
  208.                                    ClosePickList(MaskList);
  209.                               end;
  210.                          2    :InpVars(PullDowns[VarMenu],x,@StringVar);
  211.                          3    :InpVars(PullDowns[VarMenu],x,@RealVar1);
  212.                          4    :InpVars(PullDowns[VarMenu],x,@RealVar2);
  213.                          5    :InpVars(PullDowns[VarMenu],x,@IntVar);
  214.                          6    :InpVars(PullDowns[VarMenu],x,@LongIntVar);
  215.                          7    :begin
  216.                                    HelpNum := ChgVarHelp;
  217.                                    ChgVar(OnOffList,BoolVar);
  218.                                    Mvp^[Menu2].str := OnOffList^.str[BoolVar];
  219.                                    if BoolVar = 1 then CommandMode := true
  220.                                    else CommandMode := false;
  221.                               end;
  222.                          8    :begin
  223.                                    HelpNum := MenuNumHelp;
  224.                                    GetMenuNum(MenuNum,SpclNum,Pulldowns[NumPtsMenu]);
  225.                                    str(MenuNum,Mvp^[Menu2].str);
  226.                               end;
  227.                          9    :begin
  228.                                    HelpNum := ChgVarHelp;
  229.                                    ChgVar(VarTypeList,FrChgVar);
  230.                                    Mvp^[Menu2].str := VarTypeList^.str[FrChgVar];
  231.                               end;
  232.                     end;
  233.                until ((menu2=0) or Rtn2Main);
  234.                ClosePullDownMenu(PullDowns[VarMenu]);
  235.           end;{case menu1 = 3 }
  236.  
  237.         4:  begin
  238.                 QuitProc;
  239.             end;
  240.  
  241.         end;{case menu1}
  242. until NeverEnd;
  243.  
  244. end.
  245.  
  246.