home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TP5MENU1.ZIP / TP5MENU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-01-22  |  9.3 KB  |  248 lines
  1. {
  2. Copyright (c) 1988 BittWare Computing, ALL RIGHTS RESERVED
  3. }
  4. program tp5menu;
  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 := ConfirmMenu^.title;
  28.      ConfirmMenu^.title := 'Quit?';
  29.      if Confirmed(InitNo,AutoOff) 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 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('                                Version 1.00');
  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.           InitMenuCode;
  86.      writeln('Done');
  87.      HelpFilePath := InitHelpFilePath;
  88.      HelpFileName := InitHelpFileName;
  89.      HelpFileFound := LoadHelpFile(HelpFilePath,HelpFileName);
  90.      if HelpFileFound then writeln('Help File Found')
  91.           else writeln('Help File NOT Found');
  92.      writeln('Post Init Memory = ',memavail);
  93.  
  94. HideCurs;
  95. TextColor(MainFg);
  96. TextBackground(MainBg);
  97. write('Hit <Enter> to begin...');
  98. in_carr_rtn;
  99. clrscr;
  100. LogOnMessage;
  101.  
  102. OpenHeader(1,HdrList);
  103. gotoxy(1,MaxTextRow);
  104. TextColor(BottomFg);
  105. TextBackground(BottomBg);
  106. write('<Arrows>-Move  <Enter>-Select/Change  <Esc>-Cancel  F1-Help  F10-Main Menu');
  107. clreol;
  108. TextColor(MainFg);
  109. TextBackground(MainBg);
  110.  
  111. repeat
  112. Rtn2Main := False;
  113. HelpNum := MainHeader;
  114. menu1 := PickHeader(1,HdrList);
  115. case menu1 of
  116.         1:  begin
  117.                OpenPullDownMenu(PullDowns[ExeMenu]);
  118.                repeat
  119.                   HelpNum := ExeMainHelp;
  120.                   menu2 := PullDownMenu(PullDowns[ExeMenu]);
  121.                   case menu2 of
  122.                           1:      begin
  123.                                         HelpNum := UserProc1Help;
  124.                                         if Confirmed(InitYes,CommandMode) then user1;
  125.                                   end;
  126.                           2:      begin
  127.                                         HelpNum := UserProc2Help;
  128.                                         if Confirmed(InitYes,CommandMode) then user2;
  129.                                   end;
  130.                           3:      begin
  131.                                         HelpNum := UserProc3Help;
  132.                                         if Confirmed(InitYes,CommandMode) then user3;
  133.                                   end;
  134.                           4:      begin
  135.                                         HelpNum := UserProc4Help;
  136.                                         if Confirmed(InitYes,CommandMode) then user4;
  137.                                   end;
  138.                   end;
  139.                until ((menu2=0) or Rtn2Main);
  140.                ClosePullDownMenu(PullDowns[ExeMenu]);
  141.             end;
  142.         2:begin
  143.                OpenPullDownMenu(PullDowns[FileMenu]);
  144.                repeat
  145.                     if ErrorNum <> 0 then ErrorMessage;
  146.                     HelpNum := FileMenuHelp;
  147.                     UpdateMenu(PullDowns[FileMenu]);
  148.                     menu2 := PullDownMenu(PullDowns[FileMenu]);
  149.                     mvp := PullDowns[FileMenu]^.VarPtr;
  150.                     Case menu2 of
  151.                          1    :begin
  152.                                    ts := DirSearchPath;
  153.                                    ts2 := mvp^[menu2].str;
  154.                                    InpVars(PullDowns[FileMenu],x,@DirSearchPath);
  155. {$i-}
  156.                                    ChDir(DirSearchPath);
  157.                                    if IOResult <> 0 then begin
  158.                                           ErrorNum := PathNotFound;
  159.                                           DirSearchPath := ts;
  160.                                           mvp^[menu2].str := ts2;
  161.                                    end;
  162.                                    ChDir(HomeDir);
  163. {$i+}
  164.                               end;
  165.                          2    :InpVars(PullDowns[FileMenu],x,@DirSearchMask);
  166.                          3    :begin
  167.                                    GetFile(flname,DirSearchMask,DirSearchPath,RtnByte);
  168.                                    mvp^[menu2].str := flname;
  169.                               end;
  170.                          4    :begin
  171.                                    OpenPickList(ColorList);
  172.                                    Menu3 := PickList(ColorList);
  173.                                    if menu3 <> 0 then begin
  174.                                         PullDowns[FileMenu]^.VarFg := Menu3-1;
  175.                                         mvp^[menu2].str := ColorList^.str[menu3];
  176.                                    end;
  177.                                    ClosePickList(ColorList);
  178.                               end;
  179.                          5    :begin
  180.                                    ColorList^.Max := 8;
  181.                                    OpenPickList(ColorList); 
  182.                                    Menu3 := PickList(ColorList);
  183.                                    if menu3 <> 0 then begin
  184.                                         PullDowns[FileMenu]^.VarBg := Menu3-1;
  185.                                         mvp^[menu2].str := ColorList^.str[menu3];
  186.                                    end;
  187.                                    ClosePickList(ColorList); 
  188.                                    ColorList^.Max := 16;
  189.                               end;
  190.                     end;
  191.                until ((menu2=0) or Rtn2Main);
  192.                ClosePullDownMenu(PullDowns[FileMenu]);
  193.           end;
  194.           3:begin      
  195.                OpenPullDownMenu(PullDowns[VarMenu]);
  196.                repeat
  197.                     HelpNum := DataEntryHelp;
  198.                     UpdateMenu(PullDowns[VarMenu]);
  199.                     menu2 := PullDownMenu(PullDowns[VarMenu]);
  200.                     mvp := PullDowns[VarMenu]^.VarPtr;
  201.                     case menu2 of
  202.                          1    :begin
  203.                                    HelpNum := MaskListHelp;
  204.                                    OpenPickList(MaskList);
  205.                                    menu3 := PickList(MaskList);
  206.                                    if menu3 <> 0 then begin
  207.                                         mvp^[menu2].str := MaskList^.str[menu3];
  208.                                         PullDowns[VarMenu]^.SelPattern := MaskId[menu3];
  209.                                    end;
  210.                                    ClosePickList(MaskList);
  211.                               end;
  212.                          2    :InpVars(PullDowns[VarMenu],x,@StringVar);
  213.                          3    :InpVars(PullDowns[VarMenu],x,@RealVar1);
  214.                          4    :InpVars(PullDowns[VarMenu],x,@RealVar2);
  215.                          5    :InpVars(PullDowns[VarMenu],x,@IntVar);
  216.                          6    :InpVars(PullDowns[VarMenu],x,@LongIntVar);
  217.                          7    :begin
  218.                                    HelpNum := ChgVarHelp;
  219.                                    ChgVar(OnOffList,BoolVar);
  220.                                    Mvp^[Menu2].str := OnOffList^.str[BoolVar];
  221.                                    if BoolVar = 1 then CommandMode := true
  222.                                    else CommandMode := false;
  223.                               end;
  224.                          8    :begin
  225.                                    HelpNum := MenuNumHelp;
  226.                                    GetMenuNum(MenuNum,SpclNum,Pulldowns[NumPtsMenu]);
  227.                                    str(MenuNum,Mvp^[Menu2].str);
  228.                               end;
  229.                          9    :begin
  230.                                    HelpNum := ChgVarHelp;
  231.                                    ChgVar(VarTypeList,FrChgVar);
  232.                                    Mvp^[Menu2].str := VarTypeList^.str[FrChgVar];
  233.                               end;
  234.                     end;
  235.                until ((menu2=0) or Rtn2Main);
  236.                ClosePullDownMenu(PullDowns[VarMenu]);
  237.           end;{case menu1 = 3 }
  238.  
  239.         4:  begin
  240.                 QuitProc;
  241.             end;
  242.  
  243.         end;{case menu1}
  244. until NeverEnd;
  245.  
  246. end.
  247.  
  248.