home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TP5MENU1.ZIP / PPS_INIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-22  |  14.9 KB  |  452 lines
  1. {
  2. Copyright (c) 1988 BittWare Computing, ALL RIGHTS RESERVED
  3. }
  4. unit pps_init;
  5. {$v-}
  6. interface
  7. uses
  8.         menuvars,
  9.         menucode,
  10.         crt,
  11.         pps_glob;
  12.  
  13. const
  14.      MaxMasks       = 5;
  15.      MaxPullDowns   = 4;
  16.  
  17.      ExeMenu        = 1;
  18.      VarMenu        = 2;
  19.      NumPtsMenu     = 3;
  20.      FileMenu       = 4;
  21.  
  22. var
  23.      MaskID         :array[1..MaxMasks] of string[MenuMax];
  24.      PullDowns      :array[1..MaxPullDowns] of MenuPtr;
  25.  
  26.      IOList         :MessagePtr;
  27.      ColorList      :PickListPtr;
  28.      MaskList       :PickListPtr;
  29.      HdrList        :HdrPtr;
  30.  
  31.      HelpScreen     :HalfScreenPtr;
  32.      HalfScreen1    :HalfScreenPtr;
  33.      HalfScreen2    :HalfScreenPtr;
  34.      QuarterScreen1 :QuarterScreenPtr;
  35.      EighthScreen1  :EighthScreenPtr;
  36.      EighthScreen2  :EighthScreenPtr;
  37.      TextScreen     :ScreenPtr;
  38.  
  39.      VarVars        :InpStrPtr;
  40.      FileVars       :InpStrPtr;
  41.      NumPtVars      :InpStrPtr;
  42.  
  43.      OnOffList       :VarListPtr;
  44.      VarTypeList     :VarListPtr;
  45.  
  46. procedure InitMenuVars;
  47. procedure InitMenus;
  48.  
  49. implementation
  50.  
  51. {
  52. procedure SaveMenus;
  53. var
  54.     indx         :integer;
  55.     FileVar      :file of MenuPtrType;
  56.     FileName     :FileString;
  57. begin
  58.     FileName := 'menuset.rec';
  59.     Assign(FileVar,FileName);
  60.     rewrite(FileVar);
  61.     for indx := 1 to MaxPullDowns do
  62.           write(filevar,MenuPtrType(PullDowns[indx]^));
  63.     Close(FileVar);
  64. end;
  65.  
  66. procedure RecallMenus;
  67. var
  68.     indx         :integer;
  69.     FileVar      :file of MenuPtrType;
  70.     FileName     :FileString;
  71. begin
  72.     FileName := 'menuset.rec';
  73.     Assign(FileVar,FileName);
  74.     reset(FileVar);
  75.     for indx := 1 to MaxPullDowns do
  76.           read(filevar,MenuPtrType(PullDowns[indx]^));
  77.     Close(FileVar);
  78. end;
  79. }
  80.  
  81. procedure InitMenuVars;
  82. var
  83.      vp   :InpStrPtr;
  84.      indx :integer;
  85.      w    :byte;
  86. begin
  87.      vp := PullDowns[NumPtsMenu]^.VarPtr;
  88.      w := PullDowns[NumPtsMenu]^.Width - PullDowns[NumPtsMenu]^.TxtLen - 2;
  89.      For indx := 1 to 8 do begin
  90.           vp^[indx].Str := '';
  91.           vp^[indx].Typ := StringCode;
  92.           vp^[indx].VarWidth := w;
  93.      end;
  94.      str(SpclNum,vp^[8].Str);
  95.      NumPtVars^[8].typ := LongIntCode;
  96.  
  97.      vp := PullDowns[FileMenu]^.VarPtr;
  98.      w := PullDowns[FileMenu]^.Width - PullDowns[FileMenu]^.TxtLen - 2;
  99.      for indx := 1 to 5 do begin
  100.              vp^[indx].Typ := StringCode;
  101.              vp^[indx].VarWidth := w;
  102.      end;
  103.      vp^[1].Str := DirSearchPath;
  104.      vp^[1].VarWidth := MaxPathLength;
  105.      vp^[2].Str := DirSearchMask;
  106.      vp^[3].Str := FlName;
  107.      vp^[4].Str := ColorList^.str[FgColorSel+1];
  108.      vp^[5].Str := ColorList^.str[BgColorSel+1];
  109.  
  110.      vp := PullDowns[VarMenu]^.VarPtr;
  111.      w := PullDowns[VarMenu]^.Width - PullDowns[VarMenu]^.TxtLen - 2;
  112.      for indx := 1 to 9 do begin
  113.              vp^[indx].VarWidth := w;
  114.      end;
  115.      vp^[1].Str := MaskList^.str[MaskVar];
  116.      vp^[1].Typ := StringCode;
  117.      vp^[2].Str := StringVar;
  118.      vp^[2].Typ := StringCode;
  119.      vp^[3].str := Real2Str(RealVar1,w,2);
  120.      vp^[3].Typ := RealCode;
  121.      vp^[4].str := Real2Str(RealVar2,w,2);
  122.      vp^[4].Typ := RealCode;
  123.      str(IntVar,vp^[5].Str);
  124.      vp^[5].Typ := IntCode;
  125.      vp^[5].VarWidth := 6;
  126.      str(LongIntVar,vp^[6].Str);
  127.      vp^[6].Typ := LongIntCode;
  128.      vp^[7].Str := OnOffList^.str[BoolVar];
  129.      vp^[7].Typ := IntCode;
  130.      str(MenuNum,vp^[8].Str);
  131.      vp^[8].Typ := LongIntCode;
  132.      vp^[9].Str := VarTypeList^.str[FrChgVar];
  133.      vp^[9].Typ := IntCode;
  134. end;
  135.  
  136. procedure InitMenus;
  137. var
  138.      indx, i2       :byte;
  139. begin
  140.      crt_mode := mem[$0040:$0049];
  141.      if crt_mode = 7 then begin
  142.           screen := ptr($b000,$0000);
  143.           MenuBorderBg    := MonoLo;
  144.           MenuBorderFg    := black;
  145.           MenuSelFg       := black;
  146.           MenuHiFg        := MonoHi;
  147.           MenuLoFg        := MonoLo;
  148.           MenuSelBg       := MonoLo;
  149.           MenuNoSelFg     := MonoLo;
  150.           MenuNoSelBg     := black;
  151.           MenuVarBg       := black;
  152.           PickKeyFg       := MonoHi;
  153.           MenuVarFg       := MonoHi;
  154.           VarInpFg        := black;
  155.           VarInpBg        := MonoLo;
  156.           MainFg          := MonoHi;
  157.           MainBg          := black;
  158.           BottomFg        := black;
  159.           BottomBg        := MonoLo;
  160.           CursStart       := 12;
  161.           CursEnd         := 13;
  162.      end
  163.      else begin
  164.           screen := ptr($b800,$0000);
  165.           MenuBorderBg    := magenta;
  166.           MenuBorderFg    := yellow;
  167.           MenuSelFg       := white;
  168.           MenuHiFg        := white;
  169.           MenuLoFg        := black;
  170.           PickKeyFg       := yellow;
  171.           MenuSelBg       := red;
  172.           MenuNoSelFg     := white;
  173.           MenuNoSelBg     := cyan;
  174.           MenuVarBg       := black;
  175.           MenuVarFg       := yellow;
  176.           VarInpFg        := yellow;
  177.           VarInpBg        := blue;
  178.           MainFg          := white;
  179.           MainBg          := blue;
  180.           BottomFg        := black;
  181.           BottomBg        := lightgray;
  182.           CursStart       := 7;
  183.           CursEnd         := 8;
  184.      end;
  185.  
  186.      for indx := 1 to MaxPullDowns do begin
  187.           new(PullDowns[indx]);
  188.           for i2 := 1 to MenuMax do
  189.                PullDowns[indx]^.SelPattern[i2] := '*';
  190.           PullDowns[indx]^.BorderBg := MenuBorderBg;
  191.           PullDowns[indx]^.BorderFg := MenuBorderFg;
  192.           PullDowns[indx]^.Fg       := MenuHiFg;
  193.           PullDowns[indx]^.SelFg    := MenuSelFg;
  194.           PullDowns[indx]^.SelBg    := MenuSelBg;
  195.           PullDowns[indx]^.NoSelBg  := MenuNoSelBg;
  196.           PullDowns[indx]^.NoSelFg  := MenuLoFg;
  197.           PullDowns[indx]^.VarFg    := MenuVarFg;
  198.           PullDowns[indx]^.VarBg    := MenuVarBg;
  199.           PullDowns[indx]^.VarPtr   := nil;
  200.           PullDowns[indx]^.PickKey  := '';
  201.           PullDowns[indx]^.EnLtRt   := false;
  202.      end;
  203.  
  204.      new(HdrList);
  205.      New(OnOffList);
  206.      New(VarTypeList);
  207.      new(ColorList);
  208.      new(HelpList);
  209.      new(SkinnyIO);
  210.      new(MaskList);
  211.      new(ErrorList);
  212.      new(IOList);
  213.  
  214.      New(VarVars);
  215.      New(FileVars);
  216.      New(NumPtVars);
  217.  
  218.      new(SkinnySave);
  219.      new(HelpScreen);
  220.      new(HalfScreen1);
  221.      new(HalfScreen2);
  222.      new(QuarterScreen1);
  223.      new(EighthScreen1);
  224.      new(EighthScreen2);
  225.      new(TextScreen);
  226.  
  227.         HdrList^.str[1]   := 'Execute';
  228.         HdrList^.str[2]   := 'File Select';
  229.         HdrList^.str[3]   := 'Data Entry';
  230.         HdrList^.str[4]   := 'Quit';
  231.         HdrList^.PickKey  := 'EFDQ';
  232.         HdrList^.max      := 4;
  233.         HdrList^.sel      := 1;
  234.  
  235.         OnOffList^.str[1]   := 'On'; 
  236.         OnOffList^.str[2]   := 'Off';
  237.         OnOffList^.max      := 2;
  238.  
  239.         VarTypeList^.str[1]   := 'Real'; 
  240.         VarTypeList^.str[2]   := 'Integer';
  241.         VarTypeList^.str[3]   := 'String';
  242.         VarTypeList^.max      := 3;
  243.  
  244.         MaskID[1] := '* * * * * *';
  245.         MaskID[2] := '***********';
  246.         MaskID[3] := ' * * * * * ';
  247.         MaskID[4] := '*****      ';
  248.         MaskID[5] := '     ******';
  249.         MaskList^.str[1]  := 'Only Odd';
  250.         MaskList^.str[2]  := 'Full Mask';
  251.         MaskList^.str[3]  := 'Only Even';
  252.         MaskList^.str[4]  := 'First Half';
  253.         MaskList^.str[5]  := 'Last Half';
  254.         MaskList^.max     := 5;
  255.         MaskList^.maxX    := 4;
  256.         MaskList^.sel     := 1;
  257.         MaskList^.y       := 13;
  258.         MaskList^.x       := 13;
  259.         MaskList^.BorderBg := MenuBorderBg;
  260.         MaskList^.BorderFg := MenuBorderFg;
  261.         MaskList^.Fg       := MenuSelFg;
  262.         MaskList^.SelBg    := MenuSelBg;
  263.         MaskList^.NoSelBg  := MenuNoSelBg;
  264.         MaskList^.NoSelFg  := MenuNoSelFg;
  265.         MaskList^.title   := 'Set Menu Mask';
  266.         MaskList^.ScreenBufPtr := HalfScreen1;
  267.  
  268. {If using save/restore menus, begin here}
  269.  
  270.         PullDowns[ExeMenu]^.str[1]   := 'User 1 ';
  271.         PullDowns[ExeMenu]^.str[2]   := 'User 2 ';
  272.         PullDowns[ExeMenu]^.str[3]   := 'Good Beep ';
  273.         PullDowns[ExeMenu]^.str[4]   := 'Bad Beep ';
  274.         PullDowns[ExeMenu]^.PickKey  := 'USGB';
  275.         PullDowns[ExeMenu]^.EnLtRt   := true;
  276.         PullDowns[ExeMenu]^.max      := 4;
  277.         PullDowns[ExeMenu]^.sel      := 1;
  278.         PullDowns[ExeMenu]^.x        := 1;
  279.         PullDowns[ExeMenu]^.y        := 2;
  280.         PullDowns[ExeMenu]^.TxtLen   := 14;
  281.         PullDowns[ExeMenu]^.Width    := 14;
  282.         PullDowns[ExeMenu]^.title    := '';
  283.  
  284.         PullDowns[VarMenu]^.str[1]   := 'Set Mask';
  285.         PullDowns[VarMenu]^.str[2]   := 'String Var';
  286.         PullDowns[VarMenu]^.str[3]   := 'Real Var #1';
  287.         PullDowns[VarMenu]^.str[4]   := 'Real Var #2';
  288.         PullDowns[VarMenu]^.str[5]   := 'Int Var';
  289.         PullDowns[VarMenu]^.str[6]   := 'LongInt';
  290.         PullDowns[VarMenu]^.str[7]   := 'Auto Mode';
  291.         PullDowns[VarMenu]^.str[8]   := 'Pick Num';
  292.         PullDowns[VarMenu]^.str[9]   := 'Switch Var';
  293.         PullDowns[VarMenu]^.PickKey  := 'STRVILAPW';
  294.         PullDowns[VarMenu]^.EnLtRt   := true;
  295.         PullDowns[VarMenu]^.max      := 9;
  296.         PullDowns[VarMenu]^.sel      := 1;
  297.         PullDowns[VarMenu]^.x        := 1;
  298.         PullDowns[VarMenu]^.y        := 2;
  299.         PullDowns[VarMenu]^.TxtLen   := 14;
  300.         PullDowns[VarMenu]^.Width    := 28;
  301.         PullDowns[VarMenu]^.title    := 'Bullet-Proof Entry';
  302.         PullDowns[VarMenu]^.SelPattern := MaskId[MaskVar];
  303.  
  304.         PullDowns[NumPtsMenu]^.str[1]   := '64';
  305.         PullDowns[NumPtsMenu]^.str[2]   := '128';
  306.         PullDowns[NumPtsMenu]^.str[3]   := '256';
  307.         PullDowns[NumPtsMenu]^.str[4]   := '512';
  308.         PullDowns[NumPtsMenu]^.str[5]   := '1024';
  309.         PullDowns[NumPtsMenu]^.str[6]   := '2048';
  310.         PullDowns[NumPtsMenu]^.str[7]   := '4096';
  311.         PullDowns[NumPtsMenu]^.str[8]   := 'Set Special';
  312.         PullDowns[NumPtsMenu]^.PickKey  := '@@@@@@@S';
  313.         PullDowns[NumPtsMenu]^.EnLtRt   := false;
  314.         PullDowns[NumPtsMenu]^.max      := 8;
  315.         PullDowns[NumPtsMenu]^.title    := '';
  316.         PullDowns[NumPtsMenu]^.sel      := 1;
  317.         PullDowns[NumPtsMenu]^.x        := 1;
  318.         PullDowns[NumPtsMenu]^.y        := 13;
  319.         PullDowns[NumPtsMenu]^.width    := 20;
  320.         PullDowns[NumPtsMenu]^.TxtLen   := 12;
  321.  
  322.         PullDowns[FileMenu]^.str[1]   := 'File Path';
  323.         PullDowns[FileMenu]^.str[2]   := 'Search Mask';
  324.         PullDowns[FileMenu]^.str[3]   := 'Get File';
  325.         PullDowns[FileMenu]^.str[4]   := 'Fg Color';
  326.         PullDowns[FileMenu]^.str[5]   := 'Bg Color';
  327.         PullDowns[FileMenu]^.PickKey  := 'PSGFB';
  328.         PullDowns[FileMenu]^.EnLtRt   := true;
  329.         PullDowns[FileMenu]^.max      := 5;
  330.         PullDowns[FileMenu]^.sel      := 1;
  331.         PullDowns[FileMenu]^.x        := 1;
  332.         PullDowns[FileMenu]^.y        := 2;
  333.         PullDowns[FileMenu]^.width    := 28;
  334.         PullDowns[FileMenu]^.TxtLen   := 14;
  335.         PullDowns[FileMenu]^.title    := 'File Pick-List Example';
  336.  
  337. {If using save/restore menus, end here}
  338. {
  339.         RecallMenus;
  340. }
  341.  
  342. {Pointer Values must be restored after recalling menus}
  343.  
  344.         PullDowns[ExeMenu]^.ScreenBufPtr:= EighthScreen1;
  345.         PullDowns[VarMenu]^.VarPtr   := VarVars;
  346.         PullDowns[VarMenu]^.ScreenBufPtr:= EighthScreen1;
  347.         PullDowns[NumPtsMenu]^.VarPtr   := NumPtVars;
  348.         PullDowns[NumPtsMenu]^.ScreenBufPtr:= EighthScreen2;
  349.         PullDowns[FileMenu]^.VarPtr   := FileVars;
  350.         PullDowns[FileMenu]^.ScreenBufPtr:= QuarterScreen1;
  351.  
  352.         ColorList^.str[1]  := 'Black';
  353.         ColorList^.str[2]  := 'Blue';
  354.         ColorList^.str[3]  := 'Green';
  355.         ColorList^.str[4]  := 'Cyan';
  356.         ColorList^.str[5]  := 'Red';
  357.         ColorList^.str[6]  := 'Magenta';
  358.         ColorList^.str[7]  := 'Brown';
  359.         ColorList^.str[8]  := 'LightGray';
  360.         ColorList^.str[9]  := 'DarkGray';
  361.         ColorList^.str[10]  := 'LightBlue';
  362.         ColorList^.str[11]  := 'LightGreen';
  363.         ColorList^.str[12]  := 'LightCyan';
  364.         ColorList^.str[13]  := 'LightRed';
  365.         ColorList^.str[14]  := 'LightMagenta';
  366.         ColorList^.str[15]  := 'Yellow';
  367.         ColorList^.str[16]  := 'White';
  368.         ColorList^.max     := 16;
  369.         ColorList^.maxX    := 4;
  370.         ColorList^.sel     := 1;
  371.         ColorList^.y       := 13;
  372.         ColorList^.x       := 1;
  373.         ColorList^.BorderBg := MenuBorderBg;
  374.         ColorList^.BorderFg := MenuBorderFg;
  375.         ColorList^.Fg       := MenuSelFg;
  376.         ColorList^.SelBg    := MenuSelBg;
  377.         ColorList^.NoSelBg  := MenuNoSelBg;
  378.         ColorList^.NoSelFg  := MenuNoSelFg;
  379.         ColorList^.title   := 'Choose Color';
  380.         ColorList^.ScreenBufPtr := QuarterScreen1;
  381.  
  382.         HelpList^.x       := 5;
  383.         HelpList^.y       := 5;
  384.         HelpList^.dx      := 70;
  385.         HelpList^.dy      := MaxHelpLines + 2;
  386.         HelpList^.BorderBg := magenta;
  387.         HelpList^.BorderFg := yellow;
  388.         HelpList^.Fg       := white;
  389.         HelpList^.Bg       := red;
  390.         HelpList^.title   := 'Help on Current Choices';
  391.         HelpList^.ScreenBufPtr := HelpScreen;
  392.  
  393.         ErrorList^.x       := 5;
  394.         ErrorList^.y       := 10;
  395.         ErrorList^.dx      := 70;
  396.         ErrorList^.dy      := 5;
  397.         ErrorList^.BorderBg := black;
  398.         ErrorList^.BorderFg := yellow;
  399.         ErrorList^.Fg       := white;
  400.         ErrorList^.Bg       := red;
  401.         ErrorList^.title   := 'Error!  <esc> to resume';
  402.         ErrorList^.ScreenBufPtr := HelpScreen;
  403.  
  404.         IOList^.x       := 5;
  405.         IOList^.y       := 6;
  406.         IOList^.dx      := 70;
  407.         IOList^.dy      := 13;
  408.         IOList^.BorderBg := MenuBorderBg;
  409.         IOList^.BorderFg := MenuBorderFg;
  410.         IOList^.Fg       := MenuHiFg;
  411.         IOList^.Bg       := MenuSelBg;
  412.         IOList^.VarFg   := MenuVarFg;
  413.         IOList^.VarBg   := MenuVarBg;
  414.         IOList^.title   := 'User Input';
  415.         IOList^.ScreenBufPtr := HalfScreen1;
  416.  
  417.         SkinnyIO^.x        := 5;
  418.         SkinnyIO^.y        := 13;
  419.         SkinnyIO^.dx       := 70;
  420.         SkinnyIO^.dy       := 1;
  421.         SkinnyIO^.BorderBg := MenuBorderBg;
  422.         SkinnyIO^.BorderFg := MenuBorderFg;
  423.         SkinnyIO^.Fg       := MenuNoSelFg;
  424.         SkinnyIO^.Bg       := MenuNoSelBg;
  425.         SkinnyIO^.VarFg    := VarInpFg;
  426.         SkinnyIO^.VarBg    := VarInpBg;
  427.         SkinnyIO^.title    := 'User Input';
  428.         SkinnyIO^.ScreenBufPtr := SkinnySave;
  429.  
  430.         New(DirList);
  431.         DirList^.sel      := 1;
  432.         DirList^.y        := 13;
  433.         DirList^.x        := 1;
  434.         DirList^.MaxX     := 5;
  435.         DirList^.BorderBg := MenuBorderBg;
  436.         DirList^.BorderFg := MenuBorderFg;
  437.         DirList^.Fg       := MenuSelFg;
  438.         DirList^.SelBg    := MenuSelBg;
  439.         DirList^.NoSelBg  := MenuNoSelBg;
  440.         DirList^.NoSelFg  := MenuNoSelFg;
  441.         DirList^.title    := 'Directory';
  442.         DirList^.ScreenBufPtr := HalfScreen1;
  443.  
  444. {
  445.         SaveMenus;
  446. }
  447. end;
  448.  
  449.  
  450. end.
  451.  
  452.