home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / bl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  46.6 KB  |  1,421 lines
  1. unit BL;
  2.  
  3. interface
  4. uses Crt,     Def,      ColorDef, FastWr,   DivEdit,  PrtDiv,   PrtSDiv,
  5.      GetForU, StrnU,    Str2InU,  RE,       CursorOU, CPaU,     DrawSqar,
  6.      GetKeU,  SetBU,    ShadoU,   LPaU,     StriU,    BeeU,     DL,
  7.      UCasU,   PG,       SortLisU, SumPrint, FT,       Swap,     DQ,
  8.      ER,      SM,       Printer;
  9. procedure BuildList;
  10.  
  11. implementation
  12.  
  13. procedure BuildList;
  14. var Pause,
  15.     StackSort:              boolean;
  16.     StackNumber,
  17.     Choice,
  18.     BeginRec,
  19.     ZipBegin,
  20.     ListDisplay,
  21.     FirstSort,
  22.     StackTop:               integer;
  23.     X,
  24.     X1,
  25.     X2:                      S40;
  26.     Stack:                   BlockArray;
  27.  
  28.     (* ------------------------------------ *)
  29.  
  30.     function CopyQuery: integer;
  31.     var AllowControl,
  32.         Err,
  33.         Copies:              integer;
  34.         AllowInput,
  35.         Continue:            boolean;
  36.     begin
  37.     Copies := 1;
  38.     AllowControl := -1;
  39.     AllowInput := true;
  40.     Continue := true;
  41.     (* DrawSquare *)
  42.     FastWrite( 'Enter number of copies for each form :   ',
  43.                23, 1, Inputs.Attr);
  44.     Copies := Str2Int( GetForm( 40, 23, 5, Strng(5,#32), '1', AllowControl,
  45.                                 AllowInput, Inputs.Attr, ['0'..'9']),
  46.                        Err);
  47.     FastWrite( BlankLine, 24, 1, Displays.Attr);
  48.     CopyQuery := Copies;
  49.     end;
  50.  
  51.     (* ------------------------------------ *)
  52.  
  53.     procedure SetCodes;
  54.     var I,
  55.         TempDivision,
  56.         TempSubDivision:                integer;
  57.         TempStr:           Line;
  58.     begin
  59.     TempDivision := 0;     TempSubDivision := 0;
  60.     DivisionEdit(TempDivision,TempSubDivision);
  61.     clrscr;
  62.     if (TempDivision <> 0) and (TempSubDivision <> 0) then
  63.        begin
  64.        str(StackTop:5, TempStr);
  65.        FastWrite( 'Encoding', 1, 1, Msgs.Attr);
  66.        FastWrite( 'of '+TempStr, 1, 25, Msgs.Attr);
  67.        for I := 1 to StackTop do
  68.            begin
  69.            if (I mod 10) = 0 then
  70.               begin
  71.               str(I,TempStr);
  72.               FastWrite( TempStr, 1, 15, Msgs.Attr);
  73.               end;
  74.            GetRec(Entry,Stack[I]);
  75.            Entry.Division := chr(TempDivision);
  76.            Entry.SubDivision := chr(TempSubDivision);
  77.            PutRec(Entry,Stack[I]);
  78.            end;
  79.        end;
  80.     end;
  81.  
  82.     (* ------------------------------------ *)
  83.  
  84.     procedure StackChoice(var Choice, ZipBegin: integer);
  85.     var AllowControl,
  86.         Err,
  87.         I:              integer;
  88.         Ch:             char;
  89.         Search,
  90.         AllowInput,
  91.         FunctionKey:    boolean;
  92.         Temp:           array [1..11] of S40;
  93.  
  94.         function SearchQuery( X: integer): boolean;
  95.         var TempStr:              Line;
  96.             Ch:                   char;
  97.             FunctionKey:          boolean;
  98.         begin
  99.         TempStr := CPad('Do you wish to search on: ' +
  100.                    Temp[X] + ' ?  (Y/N)  ',78);
  101.         DrawSquare(1, 23, 80, 25, Inputs.Attr, true);
  102.         FastWrite( TempStr, 24, 2, Inputs.Attr);
  103.         Ch := ' ';
  104.         while (Ch <> 'Y') and (Ch <> 'N') and (Ch <> #27) do
  105.             begin
  106.             GetKey(Ch,FunctionKey);
  107.             Ch := upcase(Ch);
  108.             end;
  109.         if Ch = 'Y' then
  110.            SearchQuery := true
  111.           else
  112.            SearchQuery := false;
  113.         end;
  114.  
  115.     begin
  116.     SetBG;
  117.     clrscr;
  118.     AllowControl := -1;
  119.     AllowInput := true;
  120.     Temp[1] :=    Description[1];
  121.     Temp[2] :=    Description[2];
  122.     Temp[3] :=    Description[3];
  123.     Temp[4] :=    Description[4];
  124.     Temp[5] :=    Description[5];
  125.     Temp[6] :=    Description[6];
  126.     Temp[7] :=    Description[7];
  127.     Temp[8] :=    Description[8];
  128.     Temp[9] :=    'Phone number     ';
  129.     Temp[10] :=   Description[11];
  130.     Temp[11] :=   'Division         ';
  131.     Shadow( 25, 4, 55, 18, Menus.Attr, true);
  132.     for I := 1 to 11 do
  133.         begin
  134.         FastWrite(LPad(chr(I+64)+'  '+Temp[I],26), 5+I, 29, Menus.Attr);
  135.         end;
  136.     CursorOn(false);
  137.     DrawSquare( 1, 23, 80, 25, Inputs.Attr, true);
  138.     FastWrite( CPad('Choice ?   (A-K)',78), 24, 2, Inputs.Attr);
  139.     Ch := ' ';
  140.     while ((Ch < 'A') or (Ch > 'K')) and (Ch <> #27) do
  141.         begin
  142.         Ch := upcase(ReturnKey(FunctionKey));
  143.         end;
  144.     Choice := ord(Ch)-64;
  145.     if ProgramUse = 2 then
  146.        if Choice = 3 then
  147.           Choice := 1
  148.          else
  149.           if Choice = 1 then
  150.              Choice := 3;
  151.     if Choice > 0 then
  152.        Search := SearchQuery(Choice)
  153.       else
  154.        Search := false;
  155.     if Search then
  156.        begin
  157.        if Choice = 8 then
  158.           begin
  159.           FastWrite( LPad('Enter search position for zip-code. (0 = anywhere)',
  160.                     78), 24, 2, Inputs.Attr);
  161.           ZipBegin := Str2Int( GetForm( 65, 24, 2, '  ', '0', AllowControl,
  162.                                         AllowInput, Inputs.Attr, ['0'..'9']),
  163.                                Err);
  164.           end;
  165.        X := Strip(Temp[Choice]);
  166.        end
  167.       else
  168.        begin
  169.        Choice := 0;
  170.        X := '';
  171.        end;
  172.     SetBG;
  173.     clrscr;
  174.     CursorOn(false);
  175.     if keypressed then Beep(1);
  176.     end;
  177.  
  178.     (* ------------------------------------ *)
  179.  
  180.     procedure ClearStack;
  181.     begin
  182.     StackSort := false;
  183.     ListDisplay := 0;
  184.     StackTop := 0;
  185.     BeginRec := 0;
  186.     end;
  187.  
  188.     (* ------------------------------------ *)
  189.  
  190.     procedure ViewList(var FunctionKey: boolean; Ch: char);
  191.     var EndRec,
  192.         I,
  193.         RecordNum,
  194.         J:                               integer;
  195.         TempStr:                         Line;
  196.     begin
  197.     if BeginRec < 1 then BeginRec := 1;
  198.     if FunctionKey then
  199.        begin
  200.        if Ch = #73 then BeginRec := BeginRec + succ(DisplayLines);
  201.        if Ch = #81 then BeginRec := BeginRec - succ(DisplayLines);
  202.        if BeginRec < 1 then BeginRec := 1;
  203.        if BeginRec > StackTop then BeginRec := StackTop;
  204.        end;
  205.     EndRec := BeginRec + DisplayLines;
  206.     if EndRec > StackTop then EndRec := StackTop;
  207.     SetBG;
  208.     clrscr;
  209.     str(StackTop,TempStr);
  210.     FastWrite( 'Elements '+TempStr, 1, 1, Headings.Attr);
  211.     J  := 1;
  212.     if StackTop > 0 then
  213.        begin
  214.        for I := BeginRec to EndRec do
  215.            begin
  216.            inc(J);
  217.            gotoxy(2,J);
  218.            RecordNum := Stack[I];
  219.            GetRec(Entry,RecordNum);
  220.            DisplayLine(Entry,J,Displays.Attr);
  221.            str(I:4,TempStr);
  222.            FastWrite( TempStr, J, 1, Menus.Attr);
  223.            end;                (* for..next loop *)
  224.        end;                    (* if..then *)
  225.     if StackTop > succ(DisplayLines) then
  226.        begin
  227.        DrawSquare( 5, 18, 75, 20, Msgs.Attr, true);
  228.        FastWrite( CPad('List contains more than 15 elements !',50),
  229.                  19, 15, Msgs.Attr);
  230.        end;
  231.     end;
  232.  
  233.     (* ------------------------------------ *)
  234.  
  235.     function RecTestInteger( RecordNum, Division, ArrayTop: integer;
  236.                              A:                             IntArray;
  237.                              AcceptAll:                     boolean): boolean;
  238.     var Temp:                                               S40;
  239.         Continue:                                           boolean;
  240.         I,
  241.         J,
  242.         K,
  243.         X:                                                  integer;
  244.     begin
  245.     RecTestInteger := false;
  246.     Continue := true;
  247.     GetRec(Entry,RecordNum);
  248.     I := ord(Entry.Division);
  249.     J := ord(Entry.SubDivision);
  250.     if Division = I then                               (* if..1 *)
  251.        begin
  252.        if AcceptAll then                                (* if..2 *)
  253.           RecTestInteger := true
  254.        else
  255.           begin
  256.           K := 1;
  257.           while (K <= ArrayTop) and Continue do
  258.              begin
  259.              if J = A[K] then                     (* if..3 *)
  260.                 begin
  261.                 RecTestInteger := true;
  262.                 Continue := false;
  263.                 end
  264.              else
  265.                 inc(K);       (* if..then..else..3 *)
  266.              end;             (* while..loop *)
  267.           end;                (* if..then..else..2 *)
  268.        end;                   (* if..then..else..1 *)
  269.     end;
  270.  
  271.     (* ------------------------------------ *)
  272.  
  273.     function RecTestChar( RecordNum, Choice: integer;
  274.                           SearchFor:         S40;
  275.                           ZipBegin:          integer): boolean;
  276.     var LookIn:                              S40;
  277.         FoundAt:                             integer;
  278.     begin
  279.     RecTestChar := false;
  280.     GetRec(Entry,RecordNum);
  281.     case Choice of
  282.        1:  begin
  283.            if ProgramUse = 2 then
  284.               LookIn := UCase(Entry.Company)
  285.              else
  286.               LookIn := UCase(Entry.Addressee);
  287.            FoundAt := pos(SearchFor,LookIn);
  288.            if FoundAt <> 0 then RecTestChar := true;
  289.            end;
  290.        2:  begin
  291.            LookIn := UCase(Entry.Title);
  292.            FoundAt := pos(SearchFor,LookIn);
  293.            if FoundAt <> 0 then RecTestChar := true;
  294.            end;
  295.        3:  begin
  296.            if ProgramUse = 2 then
  297.               LookIn := UCase(Entry.Addressee)
  298.              else
  299.               LookIn := UCase(Entry.Company);
  300.            FoundAt := pos(SearchFor,LookIn);
  301.            if FoundAt <> 0 then RecTestChar := true;
  302.            end;
  303.        4:  begin
  304.            LookIn := UCase(Entry.AuxAddress);
  305.            FoundAt := pos(SearchFor,LookIn);
  306.            if FoundAt <> 0 then RecTestChar := true;
  307.            end;
  308.        5:  begin
  309.            LookIn := UCase(Entry.MailAddress);
  310.            FoundAt := pos(SearchFor,LookIn);
  311.            if FoundAt <> 0 then RecTestChar := true;
  312.            end;
  313.        6:  begin
  314.            LookIn := UCase(Entry.City);
  315.            FoundAt := pos(SearchFor,LookIn);
  316.            if FoundAt <> 0 then RecTestChar := true;
  317.            end;
  318.        7:  begin
  319.            LookIn := UCase(Entry.State);
  320.            FoundAt := pos(SearchFor,LookIn);
  321.            if FoundAt <> 0 then RecTestChar := true;
  322.            end;
  323.        8:  begin
  324.            LookIn := UCase(Entry.ZipCode);
  325.            FoundAt := pos(SearchFor,LookIn);
  326.            if ZipBegin = 0 then
  327.               begin
  328.               if FoundAt <> 0 then
  329.                  RecTestChar := true
  330.                 else
  331.                  RecTestChar := false;
  332.               end
  333.              else
  334.               begin
  335.               if FoundAt = ZipBegin then
  336.                  begin
  337.                  RecTestChar := true;
  338.                  end
  339.                 else
  340.                  RecTestChar := false;
  341.               end;
  342.            end;
  343.        9:  begin
  344.            LookIn := UCase(Entry.Phone1);
  345.            FoundAt := pos(SearchFor,LookIn);
  346.            if FoundAt <> 0 then RecTestChar := true;
  347.            LookIn := UCase(Entry.Phone2);
  348.            FoundAt := pos(SearchFor,LookIn);
  349.            if FoundAt <> 0 then RecTestChar := true;
  350.            end;
  351.        10: begin
  352.            LookIn := UCase(Entry.Comments);
  353.            FoundAt := pos(SearchFor,LookIn);
  354.            if FoundAt <> 0 then RecTestChar := true;
  355.            end;
  356.        end;
  357.     if Choice <> 8 then
  358.        begin
  359.        FoundAt := pos(SearchFor,LookIn);
  360.        if FoundAt <> 0 then RecTestChar := true;
  361.        end;
  362.     end;
  363.  
  364.     (* ------------------------------------ *)
  365.  
  366.     procedure StackHeading( SearchFor: S40);
  367.     var TempStr:                       Line;
  368.     begin
  369.     SetBG;
  370.     clrscr;
  371.     X := Strip(X);
  372.     Shadow( 23, 7, 57, 12, Headings.Attr, true);
  373.     FastWrite( CPad('Searching under:',30), 8, 25, Headings.Attr);
  374.     FastWrite( CPad(X,30), 9, 25, Headings.Attr);
  375.     FastWrite( CPad(' for ',30), 10, 25, Headings.Attr);
  376.     FastWrite( CPad(SearchFor,30), 11, 25, Msgs.Attr);
  377.  
  378.     Shadow( 23, 16, 57, 21, Headings.Attr, true);
  379.     str(FileTop,TempStr);
  380.     FastWrite( CPad('Searching',30), 17, 25, Headings.Attr);
  381.     FastWrite( CPad('from',30), 19, 25, Headings.Attr);
  382.     FastWrite( CPad(TempStr,30), 20, 25, Headings.Attr);
  383.     end;
  384.  
  385.     (* ------------------------------------ *)
  386.  
  387.     function GetSearchFor( Choice: integer): S40;
  388.     var AllowControl,
  389.         Y:                         integer;
  390.         SearchFor:                 S40;
  391.         AllowInput:                boolean;
  392.     begin
  393.     AllowInput := true;
  394.     AllowControl := -1;
  395.     Y := 1;
  396.     FastWrite( CPad('Search parameter = '+X, 80), Y, 1, Headings.Attr);
  397.     inc( Y, 3);
  398.     FastWrite( 'Search for ', Y, 1, Inputs.Attr);
  399.     gotoxy(15,Y);
  400.     SearchFor := Strip( GetForm( 15, Y, FieldLen[Choice],
  401.                                  Strng(FieldLen[Choice],#32), '', AllowControl,
  402.                                  AllowInput, Inputs.Attr, [#31..#126]));
  403.     GetSearchFor := UCase(SearchFor);
  404.     SetBG;
  405.     end;
  406.  
  407.     (* ------------------------------------ *)
  408.  
  409.     procedure PrintCount(RecordNum:integer);
  410.     var TempStr:                       Line;
  411.     begin
  412.     str(RecordNum,TempStr);
  413.     FastWrite( CPad(TempStr,30), 18, 25, Msgs.Attr);
  414.     end;
  415.  
  416.     (* ------------------------------------ *)
  417.  
  418.     procedure AlphaTest( Choice, ZipBegin: integer);
  419.     var SearchFor,
  420.         Temp:                              S40;
  421.         RecordNum:                         integer;
  422.         Found:                             boolean;
  423.     begin
  424.     SearchFor := GetSearchFor(Choice);
  425.     StackHeading(SearchFor);
  426.     for RecordNum := 1 to FileTop do
  427.        begin
  428.        if (RecordNum mod 10) = 0 then PrintCount(RecordNum);
  429.        Found := RecTestChar(RecordNum,Choice,SearchFor,ZipBegin);
  430.        if Found then
  431.           begin
  432.           inc(StackTop);
  433.           Stack[StackTop] := RecordNum;
  434.           end;
  435.        end;       (* next RecordNum *)
  436.     end;          (* procedure *)
  437.  
  438.     (* ------------------------------------ *)
  439.  
  440.     procedure DivisionTest;
  441.     var HoldTop,
  442.         Division,
  443.         HoldLen,
  444.         SubCode,
  445.         I,
  446.         J:                    integer;
  447.         Found,
  448.         AcceptAll:                  boolean;
  449.         HoldSubDivisions:           Line;
  450.         SubCodeStack:            IntArray;
  451.     begin
  452.     Division := 0;
  453.     AcceptAll := false;
  454.     PrintDivision;
  455.     FastWrite( CPad('Search which division ? (A-Z)',78), 24, 2, Menus.Attr);
  456.     Ch := upcase(ReturnKey(FunctionKey));
  457.     Division := ord(Ch)-64;
  458.     if (Division > 0) and (Division <= DivisionTop) then
  459.        begin
  460.        HoldSubDivisions := '';
  461.        HoldTop := 0;
  462.        PrintSubDivision(Division);
  463.        FastWrite( CPad('Letter or F1 for ALL division',78), 24, 2, Menus.Attr);
  464.        Ch := upcase(ReturnKey(FunctionKey));
  465.        if Ch = #59 then SubCode := -1 else SubCode := ord(Ch)-64;
  466.        if SubCode = -1 then
  467.           AcceptAll := true
  468.          else
  469.           begin
  470.           repeat
  471.             if (SubCode >= 1) and (SubCode <= SubDivisionTop) then
  472.                begin
  473.                HoldSubDivisions := HoldSubDivisions + ' ' + Ch;
  474.                inc(HoldTop);
  475.                SubCodeStack[HoldTop] := SubCode;
  476.                end;
  477.             HoldLen := (80 - ord(HoldSubDivisions[0])) div 2 ;
  478.             FastWrite( '  '+HoldSubDivisions+'  ', 21, HoldLen, Msgs.Attr);
  479.             FastWrite( CPad('Letter, [BACKSPACE], or F1 to search',78),
  480.                        24, 2, Menus.Attr);
  481.             Ch := upcase(ReturnKey(FunctionKey));
  482.             if Ch = #59 then
  483.                SubCode := 41
  484.               else
  485.                if Ch = #8 then
  486.                   begin
  487.                   dec(HoldTop);
  488.                   dec( HoldSubDivisions[0], 2);
  489.                   HoldLen := (80 - ord(HoldSubDivisions[0])) div 2 ;
  490.                   FastWrite( '  '+HoldSubDivisions+'  ', 21, HoldLen, Msgs.Attr);
  491.                   SubCode := 0;
  492.                   end
  493.                  else
  494.                   SubCode := ord(Ch)-64;
  495.             until SubCode = 41;
  496.           end;
  497.        end;
  498.     StackHeading(AlphaCode[Division,0]);
  499.     for RecordNum := 1 to FileTop do
  500.        begin
  501.        if (RecordNum mod 10) = 0 then PrintCount(RecordNum);
  502.        Found := RecTestInteger( RecordNum, Division, HoldTop,
  503.                                 SubCodeStack, AcceptAll);
  504.        if Found then
  505.           begin
  506.           inc(StackTop);
  507.           Stack[StackTop] := RecordNum;
  508.           end;
  509.        end;   (* next RecordNum *)
  510.     end;
  511.  
  512.     (* ------------------------------------ *)
  513.  
  514.     procedure PrintStack;
  515.     var RecordNum,
  516.         LineCount,
  517.         I:                           integer;
  518.         FunctionKey:                 boolean;
  519.         Ch:                          char;
  520.  
  521.         procedure PrintOutStack( Stack: BlockArray; StackTop: integer);
  522.         var I,
  523.             LineCount:         integer;
  524.             FunctionKey:       boolean;
  525.             Ch:                char;
  526.         begin
  527.         SetBG;
  528.         DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
  529.         FastWrite( CPad('Hit any key to print, or [ESC] to quit.',78),
  530.                    24, 2, Msgs.Attr);
  531.         GetKey(Ch,FunctionKey);
  532.         if Ch <> #27 then
  533.            begin
  534.            clrscr;
  535.            LineCount := 0;
  536.            DrawSquare( 1, 11, 80, 13, Msgs.Attr, true);
  537.            if Pause then
  538.               FastWrite( CPad('Any key for next item, or [A] for ALL',70),
  539.                          12, 5, Inputs.Attr)
  540.              else
  541.               FastWrite( CPad('Standby: Printing',70),
  542.                          12, 5, (Msgs.Attr or $0080));
  543.            for I := 1 to StackTop do
  544.                begin
  545.                if LineCount > LinesOnPage then
  546.                   begin
  547.                   writeln(OutPutDevice,#12);
  548.                   LineCount := 0;
  549.                   end;
  550.  
  551.                PrintRecord(1,Stack[I]);
  552.                inc(LineCount);
  553.  
  554.                if PrinterMode = 4 then inc(LineCount, 3);
  555.                if Pause then
  556.                   begin
  557.                   Ch := upcase(ReturnKey(FunctionKey));
  558.                   if Ch = 'A' then
  559.                      begin
  560.                      Pause := false;
  561.                      FastWrite( CPad('Standby: Printing',70), 12, 5,
  562.                                (Msgs.Attr or $0080));
  563.                      end
  564.                     else
  565.                      begin
  566.                      if Ch = #27 then I := succ(StackTop);
  567.                      end;
  568.                   end
  569.                  else
  570.                   begin
  571.                   if keypressed then
  572.                      begin
  573.                      GetKey(Ch,FunctionKey);
  574.                      if Ch = #27 then I := succ(StackTop);
  575.                      end;
  576.                   end;
  577.                end;
  578.            writeln(OutPutDevice,#12);
  579.            end;
  580.         end;
  581.  
  582.         (* ------------------------------------ *)
  583.  
  584.         procedure SortPrintStack( PrintStack:    BlockArray;
  585.                                   PrintStackTop: integer);
  586.         var I,
  587.             LineCount:            integer;
  588.             FunctionKey:          boolean;
  589.             Ch:                   char;
  590.         begin
  591.         SortList( PrintStack, PrintStackTop, FirstSort);
  592.         SetBG;
  593.         DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
  594.         FastWrite( CPad('Hit any key to print, or [ESC] to quit.',78), 24, 2, Msgs.Attr);
  595.         GetKey(Ch,FunctionKey);
  596.         if Ch <> #27 then
  597.            begin
  598.            clrscr;
  599.            LineCount := 0;
  600.            DrawSquare( 1, 11, 80, 13, Msgs.Attr, true);
  601.            if Pause then
  602.               FastWrite( CPad('Any key for next item, or [A] for ALL',70),
  603.                          12, 5, Inputs.Attr)
  604.              else
  605.               FastWrite( CPad('Standby: Printing',70), 12, 5,
  606.                         (Msgs.Attr or $0080));
  607.            for I := 1 to PrintStackTop do
  608.                begin
  609.                if LineCount > LinesOnPage then
  610.                   begin
  611.                   writeln(OutPutDevice,#12);
  612.                   LineCount := 0;
  613.                   end;
  614.                PrintRecord(1,PrintStack[I]);
  615.                inc(LineCount);
  616.                if PrinterMode = 4 then inc(LineCount,3);
  617.                if Pause then
  618.                   begin
  619.                   Ch := upcase(ReturnKey(FunctionKey));
  620.                   if Ch = 'A' then
  621.                      begin
  622.                      Pause := false;
  623.                      FastWrite( CPad('Standby: Printing',70), 12, 5,
  624.                                 (Msgs.Attr or $0080));
  625.                      end
  626.                     else
  627.                      begin
  628.                      if Ch = #27 then I := succ(PrintStackTop);
  629.                      end;
  630.                   end
  631.                  else
  632.                   begin
  633.                   if keypressed then
  634.                      begin
  635.                      GetKey(Ch,FunctionKey);
  636.                      if Ch = #27 then I := succ(PrintStackTop);
  637.                      end;
  638.                   end;
  639.                end;
  640.            writeln(OutPutDevice,#12);
  641.            end;
  642.         end;
  643.  
  644.         (* ------------------------------------ *)
  645.  
  646.     begin
  647.     LineCount := 0;
  648.     SetBG;
  649.     clrscr;
  650.     PrintDevice;    (* uses lines 1 and 2 *)
  651.     Ch := ' ';
  652.     while not (Ch in ['Y','N']) do
  653.        begin
  654.        FastWrite( 'Pause after each Form ?  (Y/N) ', 4, 1, Inputs.Attr);
  655.        Ch := upcase(ReturnKey(FunctionKey));
  656.        end;
  657.     if Ch = 'Y' then Pause := true else Pause := false;
  658.     Ch := ' ';
  659.     while not (Ch in ['Y','N']) do
  660.        begin
  661.        FastWrite( 'Would you like to sort by other than '+Description[1]+' ?  (Y/N) ',
  662.                   6, 1, Inputs.Attr);
  663.        Ch := upcase(ReturnKey(FunctionKey));
  664.        end;
  665.     CursorOn(false);
  666.     assign(OutPutDevice,Device);
  667.     rewrite(OutPutDevice);
  668. (*    if UCase(Device) <> LstDevice then
  669.        begin
  670.        writeln(Device,' ',LstDevice);
  671.        end; *)
  672.     if Ch = 'Y' then
  673.        SortPrintStack(Stack,StackTop)
  674.       else
  675.        PrintOutStack(Stack,StackTop);
  676.     close(OutPutDevice);
  677.     end;
  678.  
  679.      (* ------------------------------------ *)
  680.  
  681.     procedure MailMergeStack;
  682.     var RecordNum,
  683.         LineCount,
  684.         I:                           integer;
  685.         FunctionKey:                 boolean;
  686.         Ch:                          char;
  687.  
  688.         procedure MailMergeDump( Stack: BlockArray; StackTop: integer);
  689.         var I,
  690.             LineCount:         integer;
  691.             FunctionKey:       boolean;
  692.             Ch:                char;
  693.         begin
  694.         SetBG;
  695.         DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
  696.         FastWrite( CPad('Hit any key to print, or [ESC] to quit.',78),
  697.                    24, 2, Msgs.Attr);
  698.         GetKey(Ch,FunctionKey);
  699.         if Ch <> #27 then
  700.            begin
  701.            clrscr;
  702.            LineCount := 0;
  703.            DrawSquare( 1, 11, 80, 13, Msgs.Attr, true);
  704.            FastWrite( CPad('Standby: Writing',70), 12, 5, (Msgs.Attr or $0080));
  705.            for I := 1 to StackTop do
  706.                begin
  707.                MailMergeRecord(Stack[I]);
  708.                if keypressed then
  709.                   begin
  710.                   GetKey(Ch,FunctionKey);
  711.                   if Ch = #27 then I := succ(StackTop);
  712.                   end;
  713.                end;
  714.            end;
  715.         end;
  716.  
  717.         (* ------------------------------------ *)
  718.  
  719.         procedure SortMailMergeStack( PrintStack: BlockArray;
  720.                                       PrintStackTop: integer);
  721.         var I,
  722.             LineCount:          integer;
  723.             FunctionKey:        boolean;
  724.             Ch:                 char;
  725.         begin
  726.         SortList( PrintStack, PrintStackTop, FirstSort);
  727.         SetBG;
  728.         DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
  729.         FastWrite( CPad('Hit any key to print, or [ESC] to quit.',78),
  730.                    24, 2, Msgs.Attr);
  731.         GetKey(Ch,FunctionKey);
  732.         if Ch <> #27 then
  733.            begin
  734.            clrscr;
  735.            DrawSquare( 1, 11, 80, 13, Msgs.Attr, true);
  736.            FastWrite( CPad('Standby: Writing',70), 12, 5,
  737.                      (Msgs.Attr or $0080));
  738.            for I := 1 to PrintStackTop do
  739.                begin
  740.                MailMergeRecord(PrintStack[I]);
  741.                if keypressed then
  742.                   begin
  743.                   GetKey(Ch,FunctionKey);
  744.                   if Ch = #27 then I := succ(PrintStackTop);
  745.                   end;
  746.                end;
  747.            end;
  748.         end;
  749.  
  750.         (* ------------------------------------ *)
  751.  
  752.     begin
  753.     SetBG;
  754.     clrscr;
  755.     Device := 'PRN';
  756.     while Device = 'PRN' do
  757.         begin
  758.         PrintDevice;    (* uses lines 1 and 2 *)
  759.         if Device = 'PRN' then
  760.            begin
  761.            FastWrite( CPad('MailMerge requires a file name !', 40),
  762.                       1, 20, Msgs.Attr);
  763.            Beep(1);
  764.            delay(4000);
  765.            FastWrite( Strng(40,#32), 1, 20, Displays.Attr);  (* was CPad *)
  766.            end;
  767.         end;
  768.     Pause := false;
  769.     Ch := ' ';
  770.     while not (Ch in ['Y','N']) do
  771.        begin
  772.        FastWrite( 'Would you like to sort by other than '+Description[1]+' ?  (Y/N) ',
  773.                   6, 1, Inputs.Attr);
  774.        Ch := upcase(ReturnKey(FunctionKey));
  775.        end;
  776.     CursorOn(false);
  777.     assign(OutPutDevice,Device);
  778.     rewrite(OutPutDevice);
  779.     if Ch = 'Y' then
  780.        SortMailMergeStack(Stack,StackTop)
  781.       else
  782.        MailMergeDump(Stack,StackTop);
  783.     close(OutPutDevice);
  784.     end;
  785.  
  786.      (* ------------------------------------ *)
  787.  
  788.     procedure LabelStack;
  789.     var RecordNum,
  790.         Copies,
  791.         LineCount,
  792.         I:                           integer;
  793.         FunctionKey:                     boolean;
  794.         Ch:                          char;
  795.  
  796.         procedure LabelOutStack( Stack:     BlockArray;
  797.                                  StackTop,
  798.                                  Copies:    integer);
  799.         var J,
  800.             I:                              integer;
  801.             FunctionKey:                    boolean;
  802.             Ch:                             char;
  803.         begin
  804.         SetBG;
  805.         DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
  806.         FastWrite( CPad('Hit any key to print, or [ESC] to quit.',78),
  807.                    24, 2, Msgs.Attr);
  808.         GetKey(Ch,FunctionKey);
  809.         if Ch <> #27 then
  810.            begin
  811.            clrscr;
  812.            DrawSquare( 1, 11, 80, 13, Msgs.Attr, true);
  813.            if Pause then
  814.               FastWrite( CPad('Any key for next item, or [A] for ALL',70),
  815.                          12, 5, Inputs.Attr)
  816.              else
  817.               FastWrite( CPad('Standby: Printing',70),
  818.                          12, 5, (Msgs.Attr or $0080));
  819.            for I := 1 to StackTop do
  820.                begin
  821.                for J := 1 to Copies do
  822.                    begin
  823.                    PrintLabel(1,Stack[I]);
  824.                    if Pause then
  825.                       begin
  826.                       GetKey(Ch,FunctionKey);
  827.                       Ch := upcase(Ch);
  828.                       if Ch = 'A' then
  829.                          begin
  830.                          Pause := false;
  831.                          FastWrite( CPad('Standby: Printing',70),
  832.                                     12, 5, (Msgs.Attr or $0080));
  833.                          end
  834.                         else
  835.                          begin
  836.                          if Ch = #27 then
  837.                             begin
  838.                             I := succ(StackTop);
  839.                             J := succ(Copies);
  840.                             end;
  841.                          end;
  842.                       end
  843.                      else
  844.                       begin
  845.                       if keypressed then
  846.                          begin
  847.                          GetKey(Ch,FunctionKey);
  848.                          if Ch = #27 then
  849.                             begin
  850.                             I := succ(StackTop);
  851.                             J := succ(Copies);
  852.                             end;
  853.                          end;
  854.                       end;
  855.                    end;
  856.                end;
  857.            end;
  858.         end;
  859.  
  860.         (* ------------------------------------ *)
  861.  
  862.         procedure SortLabelStack( PrintStack:    BlockArray;
  863.                                   PrintStackTop,
  864.                                   Copies:        integer);
  865.         var Ch:                                  char;
  866.             FunctionKey:                         boolean;
  867.             J,
  868.             I:                                   integer;
  869.         begin
  870.         SortList(PrintStack,PrintStackTop,FirstSort);
  871.         SetBG;
  872.         DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
  873.         FastWrite( CPad('Hit any key to print, or [ESC] to quit.',78),
  874.                    24, 2, Msgs.Attr);
  875.         GetKey(Ch,FunctionKey);
  876.         if Ch <> #27 then
  877.            begin
  878.            clrscr;
  879.            DrawSquare( 1, 11, 80, 13, Msgs.Attr, true);
  880.            if Pause then
  881.               FastWrite( CPad('Any key for next item, or [A] for ALL',70),
  882.                          12, 5, Inputs.Attr)
  883.              else
  884.               FastWrite( CPad('Standby: Printing',70), 12, 5,
  885.                         (Msgs.Attr or $0080));
  886.            for I := 1 to PrintStackTop do
  887.                begin
  888.                for J := 1 to Copies do
  889.                    begin
  890.                    PrintLabel(1,PrintStack[I]);
  891.                    if Pause then
  892.                       begin
  893.                       Ch := upcase(ReturnKey(FunctionKey));
  894.                       if Ch = 'A' then
  895.                          begin
  896.                          Pause := false;
  897.                          FastWrite( CPad('Standby: Printing',70), 12, 5,
  898.                                    (Msgs.Attr or $0080));
  899.                          end
  900.                         else
  901.                          begin
  902.                          if Ch = #27 then
  903.                             begin
  904.                             I := succ(PrintStackTop);
  905.                             J := succ(Copies);
  906.                             end;
  907.                          end;
  908.                       end
  909.                      else
  910.                       begin
  911.                       if keypressed then
  912.                          begin
  913.                          GetKey(Ch,FunctionKey);
  914.                          if Ch = #27 then
  915.                             begin
  916.                             I := succ(PrintStackTop);
  917.                             J := succ(Copies);
  918.                             end;
  919.                          end;
  920.                       end;
  921.                    end;
  922.                end;
  923.            if FirstSort = 8 then
  924.               begin
  925.               SetBG;
  926.               clrscr;
  927.               FastWrite( 'You have sorted by zip-AlphaCode.          ', 1, 1, Msgs.Attr);
  928.               FastWrite( 'Do you wish a summary sheet ?  (Y/N)  ', 2, 1, Inputs.Attr);
  929.               Ch := ' ';
  930.               while not (Ch in ['Y','N']) do
  931.                  begin
  932.                  Ch := upcase(ReturnKey(FunctionKey));
  933.                  end;
  934.               if Ch = 'Y' then PrintSummary( PrintStack, PrintStackTop);
  935.               end;
  936.            end;
  937.         end;
  938.  
  939.         (* ------------------------------------ *)
  940.  
  941.     begin
  942.     SetBG;
  943.     clrscr;
  944.     PrintDevice;
  945.     Copies := CopyQuery;
  946.     LineCount := 0;
  947.     Ch := ' ';
  948.     while not (Ch in ['Y','N']) do
  949.        begin
  950.        FastWrite( 'Pause after each Form ?  (Y/N) ', 4, 1, Inputs.Attr);
  951.        Ch := upcase(ReturnKey(FunctionKey));
  952.        end;
  953.     if Ch = 'Y' then Pause := true else Pause := false;
  954.     Ch := ' ';
  955.     while not (Ch in ['Y','N']) do
  956.        begin
  957.        FastWrite( 'Insert a comma after City & period after State ? (Y/N) ',
  958.                   5, 1, Inputs.Attr);
  959.        Ch := upcase(ReturnKey(FunctionKey));
  960.        end;
  961.     if Ch = 'Y' then Komma := true else Komma := false;
  962.     Ch := ' ';
  963.     while not (Ch in ['Y','N']) do
  964.        begin
  965.        FastWrite( 'Would you like to sort by other than '+Description[1]+' ?  (Y/N) ',
  966.                   6, 1, Inputs.Attr);
  967.        Ch := upcase(ReturnKey(FunctionKey));
  968.        end;
  969.     CursorOn(false);
  970.     assign(OutPutDevice,Device);
  971.     rewrite(OutPutDevice);
  972.     if Ch = 'Y' then
  973.        SortLabelStack(Stack,StackTop,Copies)
  974.       else
  975.        LabelOutStack(Stack,StackTop,Copies);
  976.     close(OutPutDevice);
  977.     end;
  978.  
  979.     (* ------------------------------------ *)
  980.  
  981.     procedure CancelStack(var ActionTaken: boolean);
  982.     var Marker,
  983.         TempStr,
  984.         A:                               s25;
  985.         GetPoint,
  986.         PutPoint,
  987.         AllowControl,
  988.         I:                               integer;
  989.         AllowInput:                      boolean;
  990.     begin
  991.     SetBG;
  992.     clrscr;
  993.     ActionTaken := false;
  994.     DrawSquare( 1, 1, 80, 5, Msgs.Attr, true);
  995.     FastWrite( CPad('You are about to delete ALL marked items from the FILE.',78),
  996.                2, 2, Msgs.Attr);
  997.     FastWrite( CPad('If that is what you want to do, type "DELETE" and hit [ENTER].', 78), 3, 2, Msgs.Attr);
  998.     FastWrite( CPad('Strike [ENTER], alone, to exit.',78), 4, 2, Msgs.Attr);
  999.     AllowControl := -1;
  1000.     AllowInput := true;
  1001.     A := Strip( GetForm( 35, 6, 10, Strng(10,#32), '', AllowControl,
  1002.                          AllowInput, (Inputs.Attr or $0008), [#31..#126]));
  1003.     CursorOn(false);
  1004.     if UCase(A) = 'DELETE' then
  1005.        begin
  1006.        SetBG;
  1007.        clrscr;
  1008.        DrawSquare( 1, 1, 80, 6, Headings.Attr, true);
  1009.        ActionTaken := true;
  1010.        Marker := '* DELETE *';
  1011.        FastWrite( CPad('Re-writing record',70), 2, 5, Headings.Attr);
  1012.        for I := 1 to StackTop do
  1013.            begin
  1014.            str(Stack[I],TempStr);
  1015.            FastWrite( CPad(TempStr,10), 3, 35, Msgs.Attr);
  1016.            GetRec(Entry,Stack[I]);
  1017.            Entry.Addressee := Marker;
  1018.            PutRec(Entry,Stack[I]);
  1019.            end;
  1020.        str(FileTop,TempStr);
  1021.        FastWrite( CPad(TempStr,10), 3, 35, Msgs.Attr);
  1022.        FastWrite( CPad('Updating record',70), 4, 5, Headings.Attr);
  1023.        PutPoint := 1;
  1024.        for GetPoint := 1 to FileTop do
  1025.            begin
  1026.            if (GetPoint mod 10) = 0 then
  1027.               begin
  1028.               str(GetPoint,TempStr);
  1029.               FastWrite( CPad(TempStr,10), 5, 35, Msgs.Attr);
  1030.               end;
  1031.            GetRec(Entry,GetPoint);
  1032.            if Entry.Addressee <> Marker then
  1033.               begin
  1034.               PutRec(Entry,PutPoint);
  1035.               inc(PutPoint);
  1036.               end;
  1037.            end;            (* for..next *)
  1038.         SortTop := SortTop - ((FileTop - PutPoint) + 1);
  1039.         FileTop := pred(PutPoint);
  1040.         PutFileTop;
  1041.         end;         (* if..then *)
  1042.     end;
  1043.  
  1044.     (* ------------------------------------ *)
  1045.  
  1046.     procedure SortStack;
  1047.     var I,
  1048.         J,
  1049.         PutPoint:                integer;
  1050.         TempStr:                  Line;
  1051.     begin
  1052.     if StackTop > 0 then
  1053.        begin
  1054.        clrscr;
  1055.        DrawSquare( 25, 10, 55, 15, Headings.Attr, true);
  1056.        FastWrite( CPad('Eliminating Duplicates',24), 12, 28, Headings.Attr);
  1057.        for I := StackTop downto 2 do
  1058.            begin
  1059.            if (I mod 10) = 0 then
  1060.               begin
  1061.               str(I,TempStr);
  1062.               FastWrite( CPad(TempStr,24), 13, 28, Msgs.Attr);
  1063.               end;
  1064.            for J := 1 to pred(I) do
  1065.                begin
  1066.                if Stack[I] < Stack[J] then SwapI( Stack[I], Stack[J]);
  1067.                end;        (* for..next loop (J) *)
  1068.            end;            (* for..next loop (I) *)
  1069.        clrscr;
  1070.        FastWrite( CPad('Standby:',70), 12, 5, (Msgs.Attr or $0080));
  1071.        PutPoint := 1;
  1072.        for I := 1 to pred(StackTop) do
  1073.            begin
  1074.            if Stack[I] <> Stack[succ(I)] then
  1075.               begin
  1076.               Stack[PutPoint] := Stack[I];
  1077.               inc(PutPoint);
  1078.               end;      (* if..then *)
  1079.            end;         (* for..next *)
  1080.        Stack[PutPoint] := Stack[StackTop];
  1081.        StackTop := PutPoint;
  1082.        end;
  1083.     end;
  1084.  
  1085.     (* ------------------------------------ *)
  1086.  
  1087.     procedure WhichNumber(var X: integer);
  1088.     var AllowControl,
  1089.         Err:                     integer;
  1090.         AllowInput:              boolean;
  1091.     begin
  1092.     FastWrite( CPad('Which Entry from the list above ?   (or [ENTER])  ',70),
  1093.                23, 5, Inputs.Attr);
  1094.     Err := 0;
  1095.     AllowControl := -1;
  1096.     AllowInput := true;
  1097.     X := Str2Int( GetForm( 68, 23, 5, Strng(5,#32), '1', AllowControl,
  1098.                            AllowInput, Inputs.Attr, ['0'..'9']),
  1099.                   Err);
  1100.     if ((X < 1) or (X > StackTop)) or (Err <> 0) then X := 0;
  1101.     end;
  1102.  
  1103.     (* ------------------------------------ *)
  1104.  
  1105.     procedure StackAnd;
  1106.     var RecordNum,
  1107.         StackTop2,
  1108.         HoldTop,
  1109.         Division,
  1110.         SubCode,
  1111.         I,
  1112.         HoldLen,
  1113.         J:                               integer;
  1114.         Stack2:                          BlockArray;
  1115.         SearchFor:                          S40;
  1116.         AcceptAll,
  1117.         Found:                           boolean;
  1118.         HoldSubDivisions:                      Line;
  1119.         SubCodeStack:                       IntArray;
  1120.     begin
  1121.     StackTop2 := StackTop;
  1122.                  (* for I := 1 to StackTop do Stack2[I] := Stack[I]; *)
  1123.     move( Stack, Stack2, sizeof(Stack));
  1124.     ClearStack;
  1125.     StackChoice( Choice, ZipBegin);
  1126.     if (Choice > 0) and (Choice <= 11) then
  1127.        begin
  1128.        if Choice = 11 then
  1129.           begin
  1130.           CursorOn(false);
  1131.           Division := 0;
  1132.           AcceptAll := false;
  1133.           PrintDivision;
  1134.           FastWrite( CPad('Which division ? (A-Z)',78), 24, 2, Menus.Attr);
  1135.           Ch := upcase(ReturnKey(FunctionKey));
  1136.           Division := ord(Ch)-64;
  1137.           if (Division > 0) and (Division <= DivisionTop) then
  1138.              begin
  1139.              HoldSubDivisions := '';
  1140.              HoldTop := 0;
  1141.              PrintSubDivision(Division);
  1142.              FastWrite( CPad('Letter or F1 for ALL division',78),
  1143.                         24, 2, Menus.Attr);
  1144.              Ch := upcase(ReturnKey(FunctionKey));
  1145.              if Ch = #59 then SubCode := -1 else SubCode := ord(Ch)-64;
  1146.              if SubCode = -1 then
  1147.                 AcceptAll := true
  1148.                else
  1149.                 begin
  1150.                 repeat
  1151.                    if (SubCode >= 1) and (SubCode <= SubDivisionTop) then
  1152.                       begin
  1153.                       HoldSubDivisions := HoldSubDivisions + ' ' + Ch;
  1154.                       inc(HoldTop);
  1155.                       SubCodeStack[HoldTop] := SubCode;
  1156.                       end;
  1157.                    HoldLen := (80 - ord(HoldSubDivisions[0])) div 2 ;
  1158.                    FastWrite( HoldSubDivisions, 21, HoldLen, Msgs.Attr);
  1159.                    FastWrite( CPad('Letter or F1 to search',78),
  1160.                               24, 2, Menus.Attr);
  1161.                    Ch := upcase(ReturnKey(FunctionKey));
  1162.                    if Ch = #59 then SubCode := 41 else SubCode := ord(Ch)-64;
  1163.                 until SubCode = 41;
  1164.                 SearchFor := HoldSubDivisions;
  1165.                 end;   (* get choices *)
  1166.              end;      (* Division section *)
  1167.           end
  1168.          else
  1169.           begin        (* Division not in range *)
  1170.           clrscr;
  1171.           SearchFor := GetSearchFor(Choice);
  1172.           X := Description[Choice];
  1173.           end;
  1174.        clrscr;
  1175.        StackHeading(SearchFor);
  1176.        for I := 1 to StackTop2 do
  1177.           begin
  1178.           RecordNum := Stack2[I];
  1179.           PrintCount(RecordNum);
  1180.           if Choice = 11 then
  1181.              Found := RecTestInteger( RecordNum, Division, HoldTop,
  1182.                                       SubCodeStack, AcceptAll)
  1183.             else
  1184.              Found := RecTestChar( RecordNum, Choice, SearchFor, ZipBegin);
  1185.           if Found then
  1186.              begin
  1187.              inc(StackTop);
  1188.              Stack[StackTop] := RecordNum;
  1189.              end;
  1190.           end;   (* next I *)
  1191.        end
  1192.       else
  1193.        begin
  1194.        move( Stack2, Stack, sizeof(Stack2));
  1195.        (* for I := 1 to StackTop2 do Stack[I] := Stack2[I]; *)
  1196.        StackTop := StackTop2;
  1197.        end;       (* if..then..else *)
  1198.     end;
  1199.  
  1200.     (* ------------------------------------ *)
  1201.  
  1202.     procedure StackNot;
  1203.     var RecordNum,
  1204.         StackTop2,
  1205.         HoldTop,
  1206.         HoldLen,
  1207.         Division,
  1208.         SubCode,
  1209.         I,
  1210.         J:                               integer;
  1211.         Stack2:                          BlockArray;
  1212.         SearchFor:                       S40;
  1213.         AcceptAll,Found :                boolean;
  1214.         HoldSubDivisions:                Line;
  1215.         SubCodeStack:                    IntArray;
  1216.     begin
  1217.     StackTop2 := StackTop;
  1218.     move( Stack, Stack2, sizeof(Stack));
  1219.     ClearStack;
  1220.     StackChoice( Choice, ZipBegin);
  1221.     if (Choice > 0) and (Choice <= succ(LastDescription)) then
  1222.        begin
  1223.        if Choice = 11 then
  1224.           begin
  1225.           Division := 0;
  1226.           AcceptAll := false;
  1227.           PrintDivision;
  1228.           FastWrite( CPad('Which division ? (A-Z)',78), 24, 2, Menus.Attr);
  1229.           Ch := upcase(ReturnKey(FunctionKey));
  1230.           Division := ord(Ch)-64;
  1231.           if (Division > 0) and (Division <= DivisionTop) then
  1232.              begin
  1233.              HoldSubDivisions := '';
  1234.              HoldTop := 0;
  1235.              PrintSubDivision(Division);
  1236.              FastWrite( CPad('Letter or F1 for ALL division',78),
  1237.                         24, 2, Menus.Attr);
  1238.              Ch := upcase(ReturnKey(FunctionKey));
  1239.              if Ch = #59 then SubCode := -1 else SubCode := ord(Ch)-64;
  1240.              if SubCode = -1 then
  1241.                 AcceptAll := true
  1242.                else
  1243.                 begin
  1244.                 repeat
  1245.                    if (SubCode >= 1) and (SubCode <= SubDivisionTop) then
  1246.                       begin
  1247.                       HoldSubDivisions := HoldSubDivisions + ' ' + Ch;
  1248.                       inc(HoldTop);
  1249.                       SubCodeStack[HoldTop] := SubCode;
  1250.                       end;
  1251.                    HoldLen := (80 - ord(HoldSubDivisions[0])) div 2 ;
  1252.                    FastWrite( HoldSubDivisions, 21, HoldLen, Msgs.Attr);
  1253.                    FastWrite( CPad('Letter or F1 to search',78),
  1254.                               24, 2, Menus.Attr);
  1255.                    Ch := upcase(ReturnKey(FunctionKey));
  1256.                    if Ch = #59 then SubCode := 41 else SubCode := ord(Ch)-64;
  1257.                 until SubCode = 41;
  1258.                 SearchFor := HoldSubDivisions;
  1259.                 end;   (* get choices *)
  1260.              end;      (* Division section *)
  1261.           end
  1262.          else
  1263.           begin
  1264.           clrscr;
  1265.           SearchFor := GetSearchFor(Choice);
  1266.           X := Description[Choice];
  1267.           end;
  1268.        clrscr;
  1269.        StackHeading(SearchFor);
  1270.        for I := 1 to StackTop2 do
  1271.            begin
  1272.            RecordNum := Stack2[I];
  1273.            PrintCount(RecordNum);
  1274.            if Choice = 11 then
  1275.               Found := RecTestInteger( RecordNum, Division, HoldTop,
  1276.                                        SubCodeStack, AcceptAll)
  1277.              else
  1278.               Found := RecTestChar( RecordNum, Choice, SearchFor, ZipBegin);
  1279.            if not Found then
  1280.               begin
  1281.               inc(StackTop);
  1282.               Stack[StackTop] := RecordNum;
  1283.               end;
  1284.            end;   (* next I *)
  1285.         end
  1286.        else
  1287.         begin
  1288.         move( Stack2, Stack, sizeof(Stack2));
  1289.         StackTop := StackTop2;
  1290.         end;       (* if..then..else *)
  1291.     end;
  1292.  
  1293.     (* ------------------------------------ *)
  1294.  
  1295.   procedure RepeatStack;
  1296.  
  1297.     procedure StackList;
  1298.     var ActionTaken,
  1299.         FunctionKey,
  1300.         Continue:          boolean;
  1301.         Ch:                char;
  1302.         OCh,
  1303.         StackNumber,
  1304.         TempNumber:          integer;
  1305.     begin
  1306.     Ch := ' ';
  1307.     Continue := true;
  1308.     if StackSort then SortStack;
  1309.     while Continue do
  1310.        begin
  1311.        ViewList(FunctionKey,Ch);
  1312.        DrawSquare( 1, 22, 80, 25, Menus.Attr, true);
  1313.        FastWrite( '                            CTL-F'+
  1314.                   '5 MailMerge                               ',
  1315.                   23, 3, Menus.Attr);
  1316.        FastWrite( ' Function keys: F1 - F10 ', 23, 3, Msgs.Attr);
  1317.        FastWrite( '1 Del  2 Cancel  3 Code  4 Edit  '+
  1318.                   '5 Sys  6 Form  7 Line  8 And  9 Or  10 Not',
  1319.                   24, 3, Menus.Attr);
  1320.        CursorOn(false);
  1321.        GetKey(Ch,FunctionKey);
  1322.        OCh := ord(Ch);
  1323.        if (OCh = 27) then
  1324.           Continue := false
  1325.          else
  1326.           begin
  1327.           Continue := true;
  1328.           case OCh of
  1329.              59: begin
  1330.                  WhichNumber(StackNumber);
  1331.                  if (StackNumber) <> 0 then
  1332.                     begin
  1333.                     TempNumber := Stack[StackNumber];
  1334.                     DeleteQuery( ActionTaken, TempNumber);
  1335.                     if ActionTaken then Continue := false;
  1336.                     end;
  1337.                  end;
  1338.              60: begin
  1339.                  CancelStack(ActionTaken);
  1340.                  if ActionTaken then Continue := false;
  1341.                  end;
  1342.              61: begin
  1343.                  clrscr;
  1344.                  SetCodes;
  1345.                  Continue := true;
  1346.                  end;
  1347.              62: begin
  1348.                  WhichNumber(StackNumber);
  1349.                  if (StackNumber) <> 0 then
  1350.                     begin
  1351.                     TempNumber := Stack[StackNumber];
  1352.                     GetRec(HoldEntry,TempNumber);
  1353.                     EditRecord(TempNumber);
  1354.                     GetRec(Entry,TempNumber);
  1355.                     if (UCase(Entry.Addressee) <> UCase(HoldEntry.Addressee)) then
  1356.                        Continue := false;
  1357.                     end;
  1358.                  end;
  1359.              63: begin
  1360.                  ModeMenu;
  1361.                  Continue := true;
  1362.                  end;
  1363.              64: begin
  1364.                  clrscr;
  1365.                  LabelStack;
  1366.                  end;
  1367.              65: begin
  1368.                  clrscr;
  1369.                  PrintStack;
  1370.                  end;
  1371.              66: begin
  1372.                  StackAnd;
  1373.                  end;
  1374.              67: begin
  1375.                  StackSort := true;
  1376.                  RepeatStack;
  1377.                  Continue := false;
  1378.                  end;
  1379.              68: begin
  1380.                  StackNot;
  1381.                  end;
  1382.              98: begin    (* ctl - f5 *)
  1383.                  clrscr;
  1384.                  MailMergeStack;
  1385.                  end;
  1386.              end;            (* case *)
  1387.           end;               (* if..then..else *)
  1388.        end;                  (* while loop *)
  1389.     end;
  1390.  
  1391.   begin
  1392.   StackChoice(Choice,ZipBegin);
  1393.   (* if Choice = 0 then RepeatStack; allow quiting *)
  1394.   if (Choice > 0) and (Choice <= 10) then
  1395.      begin
  1396.      clrscr;
  1397.      AlphaTest(Choice,ZipBegin);
  1398.      StackList;
  1399.      end
  1400.     else
  1401.      begin
  1402.      if Choice = 11 then
  1403.         begin
  1404.         clrscr;
  1405.         DivisionTest;
  1406.         StackList;
  1407.         end;
  1408.      end;
  1409.   end;
  1410.  
  1411. begin
  1412. ZipBegin := 0;
  1413. X1 := '';  X2 := '';
  1414. ClearStack;
  1415. RepeatStack;
  1416. SetBG;
  1417. end;
  1418.  
  1419. end.
  1420. 
  1421.