Power-Programmierung/CD1.mdf/pascal/library/dos/mailpro/sm.pas

Pascal/Delphi Source File | 1988-08-23 | 51.7 KB | 1,359 lines

unit SM;  { System Menu }

interface
uses Crt,      Def,      FT,       ColorIU,  Str2InU,  MO,       DrawSqar,
     ColorDef, FastWr,   CPaU,     GetForU,  StrnU,    Real2StU, GetKeU,
     SetAttU,  LPaU,     StriU,    BeeU,     CursorOU, FR,       ShadoU,
     PR,       RE,       SetBU,    UCasU,    Colors,   GenMenus, RenFile,
     DelFile;
procedure SetTopOfFile;
procedure ModeMenu;

implementation

procedure SetTopOfFile;
var Err,
    AllowControl,
    Num1,
    Num2:                          integer;
    TempStr:                       s10;
    AllowInput:                    boolean;
begin
clrscr;
AllowControl := -1;
AllowInput := true;
GetFileTop;
{$i-}   assign(TempMainFile,DataDrive+'maillist');
{$i+}   Err := ioresult;
{$i-}   reset(TempMainFile);
{$i+}   Err := ioresult;
DrawSquare( 1, 1, 80, 7, Msgs.Attr, true);
str(FileTop:5,TempStr);
FastWrite( CPad('The program has a recorded end at record number '+TempStr,78),
           2, 2, Msgs.Attr);
str(filesize(TempMainFile):5,TempStr);
FastWrite( CPad('The actual file size ends with record number    '+TempStr,78),
           3, 2, Msgs.Attr);
str(SortTop:5,TempStr);
FastWrite( CPad('The recorded end of sorted records is located @ '+TempStr,78),
           4, 2, Msgs.Attr);
FastWrite( CPad('You may use any of these or pick your own.',78),
           6, 2, Msgs.Attr);

FastWrite( CPad('What is the new last record for the file ?',60),
           10, 10, Inputs.Attr);
FastWrite( CPad('(0 = Use current program top).',60), 11, 10, Inputs.Attr);
Num1 := 0;
Err := 0;
Num1 := Str2Int( GetForm( 38, 12, 6, Strng(6,#32), Strip(Real2Str(Num1,6,0)),
                          AllowControl, AllowInput, Inputs.Attr, ['0'..'9']),
                 Err);
if (Err = 0) and (Num1 <> 0) then
   begin
   FileTop := Num1;
   if SortTop > FileTop then SortTop := FileTop;
   PutFileTop;
   end;
 FastWrite( CPad('What is the new last sorted record for the file ?',60), 14, 10, Inputs.Attr);
 FastWrite( CPad('(0 = Use current sort top).',60), 15, 10, Inputs.Attr);
Num2 := 0;
Err := 0;
Num2 := Str2Int( GetForm( 38, 16, 6, Strng(6,#32), Strip(Real2Str(Num2,6,0)),
                          AllowControl, AllowInput, Inputs.Attr, ['0'..'9']),
                 Err);
if (Err = 0) and (Num2 <> 0) then
   begin
   SortTop := Num2;
   if SortTop > FileTop then SortTop := FileTop;
   PutFileTop;
   end;
{$i-}   close(TempMainFile);
{$i+}   Err := ioresult;
end;

procedure ModeMenu;
var Col,
    Row:                     integer;
    FunctionKey:             boolean;
    Ch:                      char;
    Show:                    LineArray;

    (* ------------------------------- *)

    procedure DisplayMode;
    var FunctionKey:        boolean;
        Ch:                 char;
        TempStr:            s10;
        Show:               LineArray;
        X:                  integer;
    begin
    str(ShowMode, TempStr);
    Show[0] := 'Current mode for screen = '+TempStr;
    Show[1] := '1. Phone number';
    Show[2] := '2. Locale';
    Show[3] := '3. Street address';
    Show[4] := '4. Company and Title';
    Ch := RetMenu( Show, 4, FunctionKey);
    val(Ch,I,X);
    if (I > 0) and (I < 5) then
       begin
       clrscr;
       ShowMode := I;
       PutMode(ShowMode,PrinterMode);
       end;
    end;

    (* ------------------------------- *)

    procedure PrintMenu;
    var FunctionKey:             boolean;
        Ch:                      char;
        Show:                    LineArray;

       (* ---------------- *)

       procedure SetPrinterMode;
       var FunctionKey:        boolean;
           Ch:                 char;
           TempStr:            s10;
           Show:               LineArray;
           X:                  integer;
       begin
       str(PrinterMode, TempStr);
       Show[0] := 'Current mode for Printer = '+TempStr;
       Show[1] := '1. Address list';
       Show[2] := '2. Phone list';
       Show[3] := '3. Both lists';
       Show[4] := '4. All fields';
       Ch := RetMenu( Show, 4, FunctionKey);
       clrscr;
       val(Ch,I,X);
       if (I > 0) and (I < 5) then PrinterMode := I;
       end;

       (* ---------------- *)

       procedure SetForms;
       var Choice,
           I,
           OCh,
           Temp,
           Err:                integer;
           FunctionKey:        boolean;
           Ch:                 char;
           A:                  array [1..LastDescription] of S5;
           AltAttr:            byte;

           procedure SetHeadings;
           begin
           I := 0;
           inc(I);   A[I] := 'ADDRS';
           inc(I);   A[I] := 'TITLE';
           inc(I);   A[I] := 'COMP.';
           inc(I);   A[I] := 'AUX. ';
           inc(I);   A[I] := 'MAIL.';
           inc(I);   A[I] := 'CITY ';
           inc(I);   A[I] := 'STATE';
           inc(I);   A[I] := 'ZIP  ';
           inc(I);   A[I] := 'PH 1 ';
           inc(I);   A[I] := 'PH 2 ';
           inc(I);   A[I] := 'CMNT.';
           end;

           procedure SetXY(var I,X,Y: integer);
           begin
           X := succ(pred(I) div 20);        (* 1 or 2 *)
           Y := succ(I - pred(X) * 20);      (* 2 - 21 *)
           X := pred(X) * 40 + 3;            (* 3 or 43 *)
              (* X is now 1 or 41 *)

              (* Y is now 2 - 21 *)
              (*  2 =  1 or 21 *)
              (*  .            *)
              (*  .            *)
              (*  .            *)
              (* 21 = 20 or 40 *)
           end;

           procedure FormsDisplay;
           var X,
               Y,
               I:                   integer;
               Show:                s2;
               Temp:                s80;
           begin
           DrawSquare(1, 1, 80, 22, Menus.Attr, true);
           for I := 1 to MaxForms do
               begin
               str(I, Show);
               SetXY(I,X,Y);
               FastWrite( Show, Y, X, (Menus.Attr or $0008) );
               FastWrite( Form[I].Description, Y, X+3, (Menus.Attr or $0008) );
               end;
           DrawSquare(1, 23, 80, 25, Msgs.Attr, true);
           Temp := '[ESC] = default selection   F2 = Select Form   F4 = Edit Form';
           FastWrite( CPad(Temp,78), 24, 2, Msgs.Attr);
           end;

           (* -------------------------------------------------------------------- *)

           procedure HighLightForm(I: integer);
           var Show:                s2;
               X,
               Y:                  integer;
           begin
           str(I, Show);
           SetXY(I,X,Y);
           FastWrite( Show, Y, X, AltAttr );
           FastWrite( Form[I].Description, Y, X+3, AltAttr );
           end;

           (* -------------------------------------------------------------------- *)

           procedure NormalForm(I: integer);
           var Show:                s2;
               X,
               Y:                  integer;
           begin
           str(I, Show);
           SetXY(I,X,Y);
           FastWrite( Show, Y, X, (Menus.Attr or $0008) );
           FastWrite( Form[I].Description, Y, X+3, (Menus.Attr or $0008) );
           end;

           (* -------------------------------------------------------------------- *)

          procedure ShowPlacement(UseForm: FormRecord);
          var Show:                            S5;
              J,
              I:                               integer;
          begin
          ColorIn( 1, 1, 80, LastDescription, Inputs.Attr);
          for I := 1 to LastDescription do
              begin
              FastWrite( BlankLine, I, 1, (Inputs.Attr or $0008) );
              str(I,Show);
              FastWrite( Show, I, 1, (Inputs.Attr or $0008) );
              for J := 1 to MaxFieldLine do
                  if UseForm.PlaceArray[I,J] <> 0 then
                     FastWrite( A[UseForm.PlaceArray[I,J]], I, J*6,
                               SetAttr(false,false,Inputs.BG,Inputs.FG));
              end;
          end;

          procedure EditForm(Choice: integer);
          var Continue,
              FunctionKey:                    boolean;
              Ch:                             char;
              OCh:                            integer;

             procedure ShowForm(UseForm: FormRecord);
             var Show:                           S5;
             begin
             clrscr;
             ShowPlacement(UseForm);
             with UseForm do
                begin
                DrawSquare( 1, LastDescription+1, 80, 25, Msgs.Attr, true);
                FastWrite( LPad('F1 '+Description,33),
                           LastDescription+3, 5, Msgs.Attr);
                str(ReturnColOffset,Show);
                FastWrite( 'F2 Return Column               '+Show,
                          LastDescription+4, 5, Msgs.Attr);
                str(ReturnRowOffset,Show);
                FastWrite( 'F3 Return Row                  '+Show,
                          LastDescription+5, 5, Msgs.Attr);
                str(ColOffset,Show);
                FastWrite( 'F4 Address Column              '+Show,
                          LastDescription+6, 5, Msgs.Attr);
                str(RowOffset,Show);
                FastWrite( 'F5 Address Row                 '+Show,
                          LastDescription+7, 5, Msgs.Attr);
                str(FormLen,Show);
                FastWrite( 'F6 Form length (top-to-bottom) '+Show,
                          LastDescription+8, 5, Msgs.Attr);
                str(FormWidth,Show);
                FastWrite( 'F7 Form width (side-to-side)   '+Show,
                          LastDescription+9, 5, Msgs.Attr);
                FastWrite( 'F8 Field Placement             ',
                          LastDescription+10, 5, Msgs.Attr);
                FastWrite( '[ESC]',
                          LastDescription+11, 5, Msgs.Attr);

                FastWrite( 'Warning !', LastDescription+5, 45,
                           (Msgs.Attr or $0008));
                FastWrite( 'Both Row and Column must be', LastDescription+6,
                           45, Msgs.Attr);
                FastWrite( 'greater than zero to print.', LastDescription+7,
                           45, Msgs.Attr);
                end;
             end;

             procedure EnterFormField( var UseForm: FormRecord;
                                           Field:   integer);
             var Err,
                 Num,
                 X,
                 AllowControl,
                 Y:                                integer;
                 Entry:                            string;
                 Temp:                             s40;
                 AllowInput:                       boolean;
             begin
             X := 5;   Y := 24;
             AllowControl := -1;
             AllowInput := true;
             with UseForm do
                begin
                case Field of
                   1:  begin
                       Entry := '';
                       Temp := 'Enter new description.';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Entry := GetForm( X+35, Y, 30, Strng(30,#32),
                                         Description, AllowControl,
                                         AllowInput, Inputs.Attr,
                                         [#31..#126]);
                       FastWrite( Strng(65,#32), Y, X, Displays.Attr);
                       if Strip(Entry) <> '' then Description := Entry;
                       end;
                   2:  begin
                       Num := 0;
                       Temp := 'Return Column position';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Num := Str2Int( GetForm( X+35, Y, 3, '   ',
                                                Real2Str(ReturnColOffset,3,0),
                                                AllowControl, AllowInput,
                                                Inputs.Attr,['0'..'9']),
                                        Err);
                       FastWrite( Strng(50,#32), Y, X, Displays.Attr);
                       if Err = 0 then ReturnColOffset := Num;
                       end;
                   3:  begin
                       Num := 0;
                       Temp := 'Return Row position';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Num := Str2Int( GetForm( X+35, Y, 3, '   ',
                                                Real2Str(ReturnRowOffset,3,0),
                                                AllowControl, AllowInput,
                                                Inputs.Attr,['0'..'9']),
                                        Err);
                       FastWrite( Strng(50,#32), Y, X, Displays.Attr);
                       if Err = 0 then ReturnRowOffset := Num;
                       end;
                   4:  begin
                       Num := 0;
                       Temp := 'Address Column position';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Num := Str2Int( GetForm( X+35, Y, 3, '   ',
                                                Real2Str(ColOffset,3,0),
                                                AllowControl, AllowInput,
                                                Inputs.Attr,['0'..'9']),
                                        Err);
                       FastWrite( Strng(50,#32), Y, X, Displays.Attr);
                       if Err = 0 then ColOffset := Num;
                       end;
                   5:  begin
                       Num := 0;
                       Temp := 'Address Row position';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Num := Str2Int( GetForm( X+35, Y, 3, '   ',
                                                Real2Str(RowOffset,3,0),
                                                AllowControl, AllowInput,
                                                Inputs.Attr,['0'..'9']),
                                        Err);
                       FastWrite( Strng(50,#32), Y, X, Displays.Attr);
                       if Err = 0 then RowOffset := Num;
                       end;
                   6:  begin
                       Num := 0;
                       Temp := 'Form length (top to bottom)';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Num := Str2Int( GetForm( X+35, Y, 3, '   ',
                                                Real2Str(FormLen,3,0),
                                                AllowControl, AllowInput,
                                                Inputs.Attr,['0'..'9']),
                                        Err);
                       FastWrite( Strng(50,#32), Y, X, Displays.Attr);
                       if Err = 0 then FormLen := Num;
                       end;
                   7:  begin
                       Num := 0;
                       Temp := 'Form width (side to side)';
                       FastWrite( Temp, Y, X, Inputs.Attr);
                       Num := Str2Int( GetForm( X+35, Y, 3, '   ',
                                                Real2Str(FormWidth,3,0),
                                                AllowControl, AllowInput,
                                                Inputs.Attr,['0'..'9']),
                                        Err);
                       FastWrite( Strng(50,#32), Y, X, Displays.Attr);
                       if Err = 0 then FormWidth := Num;
                       end;
                   end;
                end;
             end;

             procedure FieldPlacement( var UseForm: FormRecord);
             var Continue:                      boolean;
                 Place,
                 Num,
                 I,
                 J,
                 Row:                           integer;

                procedure Choices(UseForm: FormRecord);
                var I:                           integer;
                    TempStr:                     S80;
                begin
                ShowPlacement(UseForm);
                for I := LastDescription+3 to (LastDescription + (LastDescription div 2) + 4) do
                    FastWrite( BlankLine, I, 1, Msgs.Attr);
                DrawSquare( 1, 22, 80, 25, Menus.Attr, true);
                TempStr := 'INS (front)    + (insert end)    DEL (front)    BKSPC (end)';
                FastWrite( CPad(TempStr,78), 23, 2, Menus.Attr);
                TempStr := 'F5 (insert line)    F9 (delete line)    [ESC]';
                FastWrite( CPad(TempStr,78), 24, 2, Menus.Attr);
                end;

                function FindLastField( Row:     integer;
                                        UseForm: FormRecord): integer;
                var Temp:                        integer;
                begin
                Temp := 1;
                if UseForm.PlaceArray[Row,MaxFieldLine] <> 0 then
                   FindLastField := MaxFieldLine
                  else
                   if UseForm.PlaceArray[Row,1] = 0 then
                      FindLastField := 0
                     else
                      begin
                      while UseForm.PlaceArray[Row,Temp] <> 0 do inc(Temp);
                      FindLastField := pred(Temp);
                      end;
                end;

                procedure InsertWhich(var X:integer);
                var OCh,
                    I:                     integer;
                    FunctionKey,
                    Continue:              boolean;
                    Ch:                    char;
                begin
                Continue := true;
                for I := 22 to 25 do
                    FastWrite(BlankLine, I, 1, Displays.Attr);
                while Continue do
                   begin
                   for I := 1 to LastDescription div 2 do
                       FastWrite( chr(I+64)+' '+Description[I],
                                 LastDescription+2+I, 1, Menus.Attr);
                   for I := LastDescription div 2 + 1 to LastDescription do
                       FastWrite( chr(I+64)+' '+Description[I],
                                 LastDescription+2+I-(LastDescription div 2),
                                 41, Menus.Attr);
                   FastWrite( 'Letter or [ESC] to exit',
                             LastDescription+2+(LastDescription div 2) + 2,
                             1, Menus.Attr);
                   GetKey(Ch,FunctionKey);
                   Ch := upcase(Ch);
                   OCh := ord(Ch);
                   if OCh = 27 then
                      begin
                      X := 0;
                      Continue := false;
                      end
                     else
                      begin
                      if (OCh-64>0) and (OCh-64<=LastDescription) then
                         begin
                         X := OCh-64;
                         Continue := false;
                         end
                        else
                         begin
                         Beep(1);
                         end;
                      end;
                   end;
                end;

             begin          (* FieldPlacement(UseForm) *)
             clrscr;
             CursorOn(false);
             Choices(UseForm);
             Continue := true;
             Row := 1;
             while Continue do
                begin
                FastWrite( chr(16), Row, 4, Headings.Attr);
                GetKey(Ch,FunctionKey);
                OCh := ord(Ch);
                if OCh = 27 then Continue := false;
                FunctionKey := true;
                if FunctionKey then
                   begin
                   case OCh of
                      72:  begin
                           FastWrite( ' ', Row, 4, Inputs.Attr);
                           if Row > 1 then dec(Row);
                           end;
                      80:  begin
                           FastWrite( ' ', Row, 4, Inputs.Attr);
                           if Row < LastDescription then inc(Row);
                           end;
                      63:  begin               (* f5 = insert line *)
                           if Row <> LastDescription then
                              for I := LastDescription downto succ(Row) do
                                  for J := 1 to MaxFieldLine do
                                      UseForm.PlaceArray[I,J] := UseForm.PlaceArray[pred(I),J];
                           for J := 1 to MaxFieldLine do
                               UseForm.PlaceArray[Row,J] := 0;
                           Choices(UseForm);
                           end;
                      67:  begin               (* f9 = delete S80 *)
                           for I := Row to pred(LastDescription)  do
                               for J := 1 to MaxFieldLine do
                                   UseForm.PlaceArray[I,J] := UseForm.PlaceArray[succ(I),J];
                           for J := 1 to MaxFieldLine do
                               UseForm.PlaceArray[LastDescription,J] := 0;
                           Choices(UseForm);
                           end;
                      48,
                      43:  begin          (* ins @ end *)
                           Place := FindLastField(Row,UseForm);
                           if Place <> MaxFieldLine then
                              begin
                              gotoxy(1,23);   clreol;
                              InsertWhich(Num);
                              if Num <> 0 then
                                 begin
                                 UseForm.PlaceArray[Row,succ(Place)] := Num;
                                 end;
                              end;
                           Choices(UseForm);
                           end;
                      82:  begin          (* ins @ front *)
                           Place := FindLastField(Row,UseForm);
                           if Place <> MaxFieldLine then
                              begin
                              gotoxy(1,23);   clreol;
                              InsertWhich(Num);
                              if Num <> 0 then
                                 begin
                                 for I := MaxFieldLine downto 2 do
                                     UseForm.PlaceArray[Row,I] := UseForm.PlaceArray[Row,pred(I)];
                                 UseForm.PlaceArray[Row,1] := Num;
                                 end;
                              end;
                           Choices(UseForm);
                           end;
                      83,
                      32:  begin       (* del @ front; also <alt d> *)
                           for I := 1 to pred(MaxFieldLine) do
                               UseForm.PlaceArray[Row,I] := UseForm.PlaceArray[Row,succ(I)];
                           UseForm.PlaceArray[Row,MaxFieldLine] := 0;
                           Choices(UseForm);
                           end;
                      8:   begin          (* bkspc @ end *)
                           Place := FindLastField(Row,UseForm);
                           UseForm.PlaceArray[Row,Place] := 0;
                           Choices(UseForm);
                           end;
                      end;   (* case *)
                   end;  (* if..then *)
                end;
             end;

          begin   (* EditForm(Choice) *)
          ShowForm(Form[Choice]);
          Continue := true;
          while Continue do
             begin
             CursorOn(false);
             GetKey(Ch,FunctionKey);
             OCh := ord(Ch);
             if OCh = 27 then Continue := false;
             if FunctionKey then
                begin
                case OCh of
                   59..65: begin
                        EnterFormField(Form[Choice],OCh-58);
                        ShowForm(Form[Choice]);
                        end;
                   66:  begin
                        FieldPlacement(Form[Choice]);
                        ShowForm(Form[Choice]);
                        end;
                   end;
                end;  (* if..then *)
             end;
          clrscr;
          end;

       begin         (* SetForms *)
       ReadForms;
       FormsDisplay;
       Temp := ActiveForm;
       SetHeadings;
       AltAttr := SetAttr(false, false, Menus.BG, Menus.FG);
       if ProgramUse = 2 then
          begin
          A[1] := 'COMP.';
          A[3] := 'NAME ';
          end;
       Choice := 1;
       if Temp <> 0 then Choice := Temp;
       ActiveForm := 0;
       Continue := true;
       while Continue do
          begin
          HighLightForm(Choice);
          GetKey(Ch,FunctionKey);
          NormalForm(Choice);
          OCh := ord(Ch);
          if FunctionKey then
             begin
             case OCh of
                 60: begin                             (* f2 = choose *)
                     ActiveForm := Choice;
                     PutMode(ShowMode,PrinterMode);
                     Continue := false;
                     end;
                 62: begin
                     EditForm(Choice);                (* f4 = edit *)
                     FormsDisplay;
                     end;
                 77: if (Choice+20) < 41 then
                        Choice := Choice + 20;         (* rarr *)
                 75: if (Choice-20) > 0 then
                        Choice := Choice - 20;         (* larr *)
                 80: if ((Choice-1) mod 20)+1 < 20 then
                        inc(Choice);                   (* darr *)
                 72: if ((Choice-1) mod 20)+1 > 1 then
                        dec(Choice);                   (* uarr *)
                 end;    (* end of case statement *)
             end
            else
             if OCh = 27 then Continue := false;
          end;     (* end while loop *)
       clrscr;
       WriteForms;
       end;

       (* ---------------- *)

       procedure WhichPrinter(var ActivePrinter: integer);
       var OCh,
           Which,
           Choice,
           I:            integer;
           FunctionKey,
           Continue:     boolean;
           Ch:           char;
           TempStr:      S80;
           AltAttr:          byte;

           (* ---------------- *)

           procedure PrinterCodes(TempPrinter: integer);
           var AllowInput,
               Continue:      boolean;
               Show:          s10;
               Err,
               AllowControl:  integer;
           begin
           clrscr;
           Continue := true;
           AllowControl := -1;
           AllowInput := true;
           FastWrite( CPad(Printers[TempPrinter],72), 15, 5,
                     (Menus.Attr or $0008));
           while Continue do
              begin
              DrawSquare(1,1,80,10,Inputs.Attr,true);

              str(Compress1[TempPrinter],Show);
              FastWrite( 'First Compression code     '+Show, 3, 5, Inputs.Attr);
              Compress1[TempPrinter] :=
                        Str2Int( GetForm( 35, 3, 3, '   ', Show, AllowControl,
                                          AllowInput, Inputs.Attr, ['0'..'9']),
                                 Err);

              str(Compress2[TempPrinter],Show);
              FastWrite( 'Second Compression code    '+Show, 4, 5, Inputs.Attr);
              Compress2[TempPrinter] :=
                        Str2Int( GetForm( 35, 4, 3, '   ', Show, AllowControl,
                                          AllowInput, Inputs.Attr, ['0'..'9']),
                                 Err);

              str(DeCompress1[TempPrinter],Show);
              FastWrite( 'First De-Compression code  '+Show, 5, 5, Inputs.Attr);
              DeCompress1[TempPrinter] :=
                        Str2Int( GetForm( 35, 5, 3, '   ', Show, AllowControl,
                                          AllowInput, Inputs.Attr, ['0'..'9']),
                                 Err);

              str(DeCompress2[TempPrinter],Show);
              FastWrite( 'Second De-Compression code '+Show, 6, 5, Inputs.Attr);
              DeCompress2[TempPrinter] :=
                        Str2Int( GetForm( 35, 6, 3, '   ', Show, AllowControl,
                                          AllowInput, Inputs.Attr, ['0'..'9']),
                                 Err);

              FastWrite( CPad('Correct ?   (Y/N)',78), 8, 2, Inputs.Attr);
              GetKey(Ch,FunctionKey);
              clrscr;
              Ch := upcase(Ch);
              if Ch='Y' then Continue := false;
              end;
           end;

           (* ---------------- *)

           procedure ShowPrinters;
           var I:                  integer;
               Show:                S80;
           begin
           clrscr;
           DrawSquare( 1, 1, 80, 22, Displays.Attr, true);
           Shadow( 3, 3, 76, MostPrinters+8, Menus.Attr, true);
           for I := 1 to MostPrinters do
               FastWrite( CPad((Printers[I]),72),
                         I+6, 4, (Menus.Attr or $0008) );
           DrawSquare( 1, 23, 80, 25, Msgs.Attr, true);
           Show := 'F2 = Edit type   F4 = Edit codes  F10 = Select Printer';
           FastWrite( CPad(Show,78), 24, 2, Msgs.Attr);
           end;

           (* ---------------- *)

       begin
       GetPrinters;
       AltAttr := SetAttr(false, false, Menus.BG, Menus.FG);
       Choice := ActivePrinter;
       if (Choice < 1) or (Choice > MostPrinters) then Choice := 1;
       Continue := true;
       ShowPrinters;
       while Continue do
          begin
          TempStr := 'Active Printer = ' + Printers[ActivePrinter];
          FastWrite( CPad(TempStr,72), 5, 4, (Menus.Attr or $0008));
          FastWrite( CPad((Printers[Choice]),72),
                    Choice+6, 4, AltAttr );
          GetKey(Ch,FunctionKey);
          Ch := upcase(Ch);
          OCh := ord(Ch);
          FastWrite( CPad((Printers[Choice]),72),
                    Choice+6, 4, (Menus.Attr or $0008) );
          if FunctionKey then
             begin
             case OCh of
                80: if Choice < MostPrinters then
                       inc(Choice);           (* darr *)
                72: if Choice > 1 then
                       dec(Choice);           (* uarr *)
                68: begin
                    ActivePrinter := Choice;
                    clrscr;
                    PutMode(ShowMode,PrinterMode);
                    Continue := false;
                    end;
                62: begin
                    PrinterCodes(Choice);
                    ShowPrinters;
                    end;
                60: begin
                    FastWrite( CPad((Printers[Choice]),72),
                              Choice+6, 5, AltAttr );
                    FastWrite( ' Printer description ?                     ',
                              MostPrinters+10, 5, Inputs.Attr );
                    gotoxy(30,MostPrinters+10);
                    read(Printers[Choice]);
                    ShowPrinters;
                    end;
                end;   (* end case *)
             end;
          end;
       PutPrinters;
       end;

       (* ---------------- *)

    begin
    Show[0] := 'SET PRINTER VALUES';
    Show[1] := '1. Set single line Print Mode';
    Show[2] := '2. Design and Select Printer Forms';
    Show[3] := '3. Assign and Select Active Printer';
    Show[4] := '9. Exit to Operations Menu';
    while Ch <> #27 do
      begin
      Ch := RetMenu( Show, 4, FunctionKey);
      case Ch of
         '1': SetPrinterMode;
         '2': SetForms;
         '3': WhichPrinter(ActivePrinter);
         '9': Ch := #27;
         end;   (* case *)
      end;        (* while *)
    end;

    (* ------------------------------- *)

    procedure SystemValueSet;
    var Col,
        Row:                     integer;
        FunctionKey:             boolean;
        Ch:                      char;
        Show:                    LineArray;


           procedure UsageType;
           var FunctionKey:        boolean;
               Ch:                 char;
               Show:               LineArray;
           begin
           clrscr;
           Show[1] := CPad(
           'You may select either the Commercial or Personal version',
           60);
           Show[2] := CPad(
           'of MailPro. The only difference between the two versions',
           60);
           Show[3] := CPad(
           'are the headings used.',
           60);
           for I := 1 to 3 do FastWrite( Show[I], I, 10, Msgs.Attr);

           Shadow( 10, 5, 70, 11, Headings.Attr, true);
           Show[1]:=CPad('Personal                        Commercial    ',50);
           Show[2]:=CPad('--------                        ----------    ',50);
           Show[3]:=CPad('Addressee      (Field 1)        Company       ',50);
           Show[4]:=CPad('Title          (Field 2)        Title         ',50);
           Show[5]:=CPad('Company        (Field 3)        Contact person',50);
           for I := 1 to 5 do FastWrite( Show[I], I+5, 15, Headings.Attr);

           Show[1] := CPad(
           'When reading the instruction manual, if you have chosen',60);
           Show[2] := CPad(
           'the commercial version, substitute the appropriate headings.',60);
           for I := 1 to 2 do FastWrite( Show[I], I+12, 10, Msgs.Attr);

           Show[1] := CPad('P = personal    or    C = commercial ? ',50);
           FastWrite( Show[1], 16, 15, Inputs.Attr);
           GetKey(Ch,FunctionKey);
           Ch := upcase(Ch);
           FastWrite( Ch, 17, 40, Inputs.Attr);
           ProgramUse := 1;   (* defaults to personal mode *)
           if Ch='C' then ProgramUse := 2;
           PutMode(ShowMode,PrinterMode);
           end;

           procedure BackupMenu;
           var TempStr,
               Response:           s30;
               AllowControl:       integer;
               AllowInput:         boolean;

                   procedure GetBackupFileTop;
                   var Err:  integer;
                       fial: string;
                   begin
                   fial := concat(DataDrive,'mailtop.bck');
                   {$I-}
                   assign(IntFile,fial);
                   reset(IntFile);
                   read(IntFile,BackupFileTop);
                   read(IntFile,BackupSortTop);
                   close(IntFile);
                   {$I+}
                   Err := ioresult;
                   end;

                   procedure PutBackupFileTop;
                   var Fial:                  string;
                   begin
                   fial := concat(DataDrive,'mailtop.bck');
                   assign(IntFile,fial);
                   rewrite(IntFile);
                   write(IntFile,BackupFileTop);
                   write(IntFile,BackupSortTop);
                   close(IntFile);
                   end;

                   procedure OpenBackupFile;
                   var Err:  integer;
                       Fial: string;
                   begin
                   Fial := concat(DataDrive,'maillist.bck');  {$I-}
                   assign(TempMainFile,fial);
                   reset(TempMainFile);                {$I+}
                   Err := ioresult;
                   if Err <> 0 then rewrite(TempMainFile);
                   end;

                   procedure GetBackupRec(var Entry: MainRecordType;
                                              Rec:   integer);
                   var Err:  integer;
                   begin                  {$I-}
                   seek(TempMainFile,pred(Rec));
                   read(TempMainFile,Entry);                {$I+}
                   Err := ioresult;
                   end;

                   procedure PutBackupRec( Entry: MainRecordType;
                                           Rec:   integer);
                   begin
                   seek(TempMainFile,pred(Rec));
                   write(TempMainFile,Entry);
                   end;

               procedure Backup;
               var I:            integer;
                   TempStr:      s10;
               begin
               clrscr;
               OpenBackupFile;
               Shadow( 30, 10, 50, 15, Headings.Attr, true);
               FastWrite('Backing up', 12, 35, Headings.Attr);
               for I := 1 to FileTop do
                   begin
                   if (I mod 10) = 0 then
                      begin
                      str(I,TempStr);
                      FastWrite( CPad(TempStr,10), 13, 35, Msgs.Attr);
                      end;
                   GetRec(Entry,I);
                   PutBackupRec(Entry,I);
                   end;
               BackupFileTop := FileTop;
               BackupSortTop := SortTop;
               PutBackupFileTop;
               seek(TempMainFile,FileTop);
               truncate(TempMainFile);
               close(TempMainFile);
               end;

               procedure Restore;
               var I:            integer;
                   TempStr:      s30;
               begin
               clrscr;
               OpenBackupFile;
               Shadow( 30, 10, 50, 15, Headings.Attr,true);
               FastWrite('Restoring ', 12, 35, Headings.Attr);
               for I := 1 to FileTop do
                   begin
                   if (I mod 5) = 0 then
                      begin
                      str(I,TempStr);
                      FastWrite( CPad(TempStr,10), 13, 35, Msgs.Attr);
                      end;
                   GetBackupRec(Entry,I);
                   PutRec(Entry,I);
                   end;
               FileTop := BackupFileTop;
               SortTop := BackupSortTop;
               PutFileTop;
               seek(AddressFile,FileTop);
               truncate(AddressFile);
               close(TempMainFile);
               end;

           begin
           clrscr;
           AllowControl := -1;
           AllowInput := true;
           GetFileTop;
           GetBackupFileTop;
           DrawSquare( 1, 1, 80, 4, Msgs.Attr, true);

           str(FileTop:5, TempStr);
           FastWrite( 'Main file top   '+TempStr, 2, 5, Msgs.Attr);
           str(SortTop:5, TempStr);
           FastWrite( 'Sorted '+ TempStr, 2, 41, Msgs.Attr);

           str(BackupFileTop:5, TempStr);
           FastWrite( 'Backup file top '+TempStr, 3, 5, Msgs.Attr);
           str(BackupSortTop:5, TempStr);
           FastWrite( 'Sorted '+ TempStr, 3, 41, Msgs.Attr);

           FastWrite( CPad('Type "Restore", "Backup" or strike [ENTER]',50),
                      6, 15, Inputs.Attr);
           Response := GetForm( 35, 7, 10, Strng(10,#32), '', AllowControl,
                                AllowInput, (Inputs.Attr or $0008),
                                [#31..#126]);
           if UCase(Response) = 'RESTORE' then
              begin
              Restore;
              end
             else
              if UCase(Response) = 'BACKUP' then
                 begin
                 Backup;
                 end;
           end;

    begin
    Show[0] := 'SYSTEM HANDLING';
    Show[1] := '1. Backup and Restore';
    Show[2] := '2. Set program type';
    Show[3] := '3. Set program colors';
    Show[4] := '4. Set top of file';
    while Ch <> #27 do
       begin
       Ch := RetMenu( Show, 4, FunctionKey);
       case Ch of
          '1':   BackupMenu;
          '2':   UsageType;
          '3':   ColorSet;
          '4':   SetTopOfFile;
          '9':   Ch := #27;
          end;
       end;
    end;

    (* ------------------------------- *)

    procedure Import;
    var  Fial,
         FileName:                        s80;
         OutPutFile,
         ImportFile:               file of MainRecordType;
         ImportTop,
         GetImport,
         AllowControl,
         GetActive,
         PutPoint,
         I,
         D,
         SD,
         Err:                       integer;
         TempStr:                   s10;
         AllowInput,
         NewCode:                  boolean;
         ImportEntry,
         ActiveEntry:                 MainRecordType;

          (* ------------------- *)

          procedure WriteNumbers( GetActive, GetImport, PutPoint: integer);
          var Num:                                             integer;
              TempStr:                                         s10;
          begin
          Num := 10;
          if (GetActive mod Num) = 0 then
             begin
             str(GetActive:5,TempStr);
             FastWrite( TempStr, 12, 41, Msgs.Attr);
             end;
          if (GetImport mod Num) = 0 then
             begin
             str(GetImport:5,TempStr);
             FastWrite( TempStr, 13, 41, Msgs.Attr);
             end;
          if (PutPoint mod Num) = 0 then
             begin
             str(PutPoint:5,TempStr);
             FastWrite( TempStr, 14, 41, Msgs.Attr);
             end;
          end;

          (* ------------------- *)

          procedure ChooseDivision(var Division, SubDivision: integer);
          var Continue,
              ChangeMade:            boolean;
              TempNum:                integer;
              Temp:              s30;

             (* ------------------- *)

             procedure ChooseSubDivision( Division: integer;
                                          var SubDivision: integer);
             var FunctionKey,
                 Continue:                 boolean;
                 Ch:                       char;
                 TempNum:                       integer;
                 Temp:                     s30;

                (* ----- *)

                procedure LocalPrintSubDivision(Division: integer);
                var I:integer;
                begin
                clrscr;
                FastWrite(CPad('Division '+AlphaCode[Division,0],50), 1, 15, Headings.Attr);
                for I := 1 to (SubDivisionTop div 2) do
                    begin
                    FastWrite( chr(I+64)+'  '+AlphaCode[Division,I], I+2, 1, Inputs.Attr);
                    FastWrite( chr(I+64+13)+'  '+AlphaCode[Division,I+13], I+2, 41, Inputs.Attr);
                    end;
                DrawSquare( 1, 23, 80, 25, Menus.Attr, true);
                FastWrite( CPad('Letter to assign',78), 24, 2, Menus.Attr);
                end;


                (* ----- *)

             begin
             Continue := true;
             while Continue do
                begin
                LocalPrintSubDivision(Division);
                GetKey(Ch,FunctionKey);
                Ch := upcase(Ch);
                if (Ch > #64) and (Ch < #91) then TempNum := ord(ch) - 64;
                case TempNum of
                    1..SubDivisionTop: begin
                                   SubDivision := TempNum;
                                   Continue := false;
                                   end;
                    end;        (* case *)
                end;            (* while *)
             end;

             (* ------------------- *)

              procedure LocalPrintDivision;
              var I:integer;
              begin
              clrscr;
              FastWrite( CPad('Main Division Menu',80), 1, 1, Headings.Attr);
              for I := 1 to (DivisionTop div 2) do
                  begin
                  FastWrite( chr(64+I)+'  '+AlphaCode[I,0], I+2, 1, Inputs.Attr);
                  FastWrite( chr(64+I+13)+'  '+AlphaCode[I+13,0], I+2, 41, Inputs.Attr);
                  end;
              DrawSquare( 1, 23, 80, 25, Menus.Attr, true);
              FastWrite( CPad('Letter to assign',78), 24, 2, Menus.Attr);
              end;


             (* ------------------- *)

          begin
          Continue := true;
          ChangeMade := false;
          while Continue do
             begin
             LocalPrintDivision;
             GetKey(Ch,FunctionKey);
             Ch := upcase(Ch);
             TempNum := ord(Ch);
             if TempNum = 27 then
                TempNum := 0
               else
                if (Ch > #64) and (Ch < #91) then TempNum := TempNum - 64;
             case TempNum of
                0:          Continue := false;
                1..DivisionTop: begin
                            Division := TempNum;
                            ChooseSubDivision(TempNum,SubDivision);
                            Continue := false;
                            end;
                end;         (* case *)
             end;            (* while *)
          end;

       (* ------------------------------------ *)

    begin
    AllowControl := -1;
    AllowInput := true;
    FastWrite( 'Enter merge file drive and/or directory  or "END".', 1, 1, Inputs.Attr);
    FileName := GetForm( 1, 2, 80, Strng(80,#32), '', AllowControl,
                         AllowInput, (Inputs.Attr or $0008),
                         ['A'..'Z','a'..'z','0'..'9','_','.','\',':']);
    if (UCase(Strip(FileName)) <> 'END') and (SortTop = FileTop)
                                         and (AllowControl <> -27) then
       begin
       fial := FileName + '\maillist';
       assign(ImportFile,fial);
       {$I-}   reset(ImportFile);
       {$I+}   Err := ioresult;
       if Err <> 0 then
          begin
          FastWrite( 'Invalid name !!!', 4, 1, Msgs.Attr);
          beep(1);
          {$I-}   close(ImportFile);
          {$I+}   Err := ioresult;
          Import;
          end
         else
          begin
          SetBG;
          clrscr;
          Ch := ' ';
          FastWrite( CPad(
          'Do you wish to set all incoming records to a specific code ?',80),
          1, 1, Inputs.Attr);
          while not (Ch in ['Y','N']) do
             begin
             Ch := upcase(ReturnKey(FunctionKey));
             end;
          if Ch = 'Y' then NewCode := true else NewCode := false;
          D := 0;     SD := 0;
          if NewCode then ChooseDivision(D,SD);
          SetBG;
          clrscr;
          CursorOn(false);
          assign(OutPutFile,DataDrive+'templist');
          rewrite(OutPutFile);
          ImportTop := filesize(ImportFile);
          Shadow( 15, 10, 65, 16, Headings.Attr, true);

          FastWrite( 'From Active list', 12, 21, Headings.Attr);
          str(FileTop:5,TempStr);
          FastWrite( 'of '+TempStr, 12, 51, Headings.Attr);

          FastWrite( 'From Import list', 13, 21, Headings.Attr);
          str(ImportTop:5,TempStr);
          FastWrite( 'of '+TempStr, 13, 51, Headings.Attr);

          FastWrite('Writing to record', 14, 21, Headings.Attr);

          GetActive := 1;   GetImport := 1;   PutPoint := 0;
          seek(ImportFile,pred(GetImport));
          read(ImportFile,ImportEntry);
          if NewCode then
             begin
             ImportEntry.Division := chr(D);
             ImportEntry.SubDivision := chr(SD);
             end;
          GetRec(ActiveEntry,GetActive);
          WriteNumbers(GetActive,GetImport,PutPoint);
          while (GetActive <= FileTop) or (GetImport <= ImportTop) do
             begin
             if GetActive > FileTop then
                begin
                inc(PutPoint);
                seek(OutPutFile, pred(PutPoint));
                write(OutPutFile,ImportEntry);
                inc(GetImport);
                if GetImport <= ImportTop then
                   begin
                   seek(ImportFile,pred(GetImport));
                   read(ImportFile,ImportEntry);
                   if NewCode then
                      begin
                      ImportEntry.Division := chr(D);
                      ImportEntry.SubDivision := chr(SD);
                      end;
                   end;
                WriteNumbers(GetActive,GetImport,PutPoint);
                end
               else               (* GetActive <= FileTop *)
                begin
                if GetImport > ImportTop then
                   begin
                   inc(PutPoint);
                   seek(OutPutFile,pred(PutPoint));
                   write(OutPutFile,ActiveEntry);
                   inc(GetActive);
                   if GetActive <= FileTop then
                      GetRec(ActiveEntry,GetActive);
                   WriteNumbers(GetActive,GetImport,PutPoint);
                   end
                  else
                   begin                          (* both still available *)
                   if UCase(Strip(ActiveEntry.Addressee))
                   <= UCase(Strip(ImportEntry.Addressee)) then
                      begin
                      inc(PutPoint);
                      seek(OutPutFile,pred(PutPoint));
                      write(OutPutFile,ActiveEntry);
                      inc(GetActive);
                      if GetActive <= FileTop then
                         GetRec(ActiveEntry,GetActive);
                      WriteNumbers(GetActive,GetImport,PutPoint);
                      end
                     else
                      begin
                      inc(PutPoint);
                      seek(OutPutFile,pred(PutPoint));
                      write(OutPutFile,ImportEntry);
                      inc(GetImport);
                      if GetImport <= ImportTop then
                         begin
                         seek(ImportFile,pred(GetImport));
                         read(ImportFile,ImportEntry);
                         if NewCode then
                            begin
                            ImportEntry.Division := chr(D);
                            ImportEntry.SubDivision := chr(SD);
                            end;
                         end;
                      WriteNumbers(GetActive,GetImport,PutPoint);
                      end;
                   end;
                end;
             end;

          {$I-} close(ImportFile);    {$I+} Err := ioresult;
          {$I-} close(OutPutFile);    {$I+} Err := ioresult;
          {$I-} close(AddressFile);   {$I+} Err := ioresult;

          ReNameFile( DataDrive+'MailList', DataDrive+'OldList');
          ReNameFile( DataDrive+'TempList', DataDrive+'MailList');
          ReNameFile( DataDrive+'MailTop', DataDrive+'OldTop');

          FileTop := PutPoint;
          SortTop := FileTop;
          PutFileTop;

          DeleteFile(DataDrive+'OldList');
          DeleteFile(DataDrive+'OldTop');

          fial := DataDrive + 'maillist';
          assign(AddressFile,fial);
          reset(AddressFile);
          CursorOn(false);

          end;
       end
       else
       begin
       if FileTop <> SortTop then
          begin
          SetBG;
          clrscr;
          Shadow( 15, 10, 65, 15, Msgs.Attr, true);
          FastWrite( CPad('Main file must be sorted before   ',40), 12, 20, Msgs.Attr);
          FastWrite( CPad('additional files may be imported !',40), 13, 20, Msgs.Attr);
          FastWrite( 'Hit any key to continue.', 17, 28, Inputs.Attr);
          beep(1);
          while not keypressed do begin end;
          end;
       end;
    end;

    (* ------------------------------- *)

begin
Continue := true;
Show[0] := 'SYSTEM PARAMETER MENU';
Show[1] := '1. Set display mode';
Show[2] := '2. Set printer values';
Show[3] := '3. System handling';
Show[4] := '4. Import maillist';
Show[5] := '9. EXIT system menu';
while Ch <> #27 do
   begin
   Ch := RetMenu( Show, 5, FunctionKey);
   case Ch of
      '1': DisplayMode;
      '2': PrintMenu;
      '3': SystemValueSet;
      '4': begin
           clrscr;
           Import;
           end;
      '9': Ch := #27;
      end;
   end;
clrscr;
end;

end.