home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / ed.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  12.0 KB  |  435 lines
  1. unit ED;
  2.  
  3. interface
  4. uses Crt,      Def,    ColorDef, FastWr, DrawSqar, SubEdit,  DivEdit,
  5.      CursorOU, State,  BeeU,     GetKeU, RE,       FT,       CPaU;
  6. procedure SetConstants;
  7. procedure EmptyFrame;
  8. procedure PrintFrame;
  9. procedure PageHeadingDisplay;
  10. procedure EmptyPageDisplay;
  11. procedure FullPageDisplay;
  12. procedure CheckCursor(var Row, Col: integer; I: integer);
  13. procedure PageEditor;
  14. procedure FieldSet(var X:s40;Row:integer);
  15. procedure RecordSet;
  16. procedure Query(var X:boolean);
  17. procedure NewDataInput;
  18.  
  19. implementation
  20.  
  21. procedure SetConstants;
  22. begin
  23. Frame[6,ZipLine] := '-';
  24. Frame[4,Phone1Line] := '/';
  25. Frame[8,Phone1Line] := '-';
  26. Frame[4,Phone2Line] := '/';
  27. Frame[8,Phone2Line] := '-';
  28. end;
  29.  
  30. (* -------------------------------------------------------------------- *)
  31.  
  32. procedure EmptyFrame;
  33. var I,
  34.     J:    integer;
  35. begin
  36. for I := 1 to LastDescription do
  37.     for J := 1 to FieldLen[I] do
  38.         Frame[J,I] := chr(PrintBlock);
  39. SetConstants;
  40. end;
  41.  
  42. (* -------------------------------------------------------------------- *)
  43.  
  44. procedure PrintFrame;
  45. var I,
  46.     J:                  integer;
  47. begin
  48. for I := 1 to LastDescription do
  49.     for J := 1 to FieldLen[I] do
  50.         FastWrite( Frame[J,I], I, BeginBlock+J-1, Inputs.Attr);
  51. FastWrite( chr(PrintBlock), FinalLine, BeginBlock, Inputs.Attr);
  52. for I := 22 to 24 do FastWrite( BlankLine, I, 1, Displays.Attr);
  53. DrawSquare( 1, 23, 80, 25, Menus.Attr, true);
  54. FastWrite( 'F1', 24, 6, (Menus.Attr or $0008));
  55. FastWrite( 'F2', 24, 27, (Menus.Attr or $0008));
  56. FastWrite( 'F3', 24, 53, (Menus.Attr or $0008));
  57. FastWrite( '= Enter codes !', 24, 9, (Menus.Attr or $0008));
  58. FastWrite( '= Go to mail address', 24, 30, (Menus.Attr or $0008));
  59. FastWrite( '= Display states', 24, 56, (Menus.Attr or $0008));
  60. end;
  61.  
  62. (* -------------------------------------------------------------------- *)
  63.  
  64. procedure PageHeadingDisplay;
  65. var I,
  66.     J,
  67.     Col,
  68.     X:           integer;
  69.     Temp1,
  70.     Temp2:       s30;
  71.     Ch:          char;
  72. begin
  73. Col := 43;
  74. for I := 1 to 11 do
  75.     FastWrite( Description[I], I, Col, Headings.Attr);
  76. FastWrite( 'Hit  [ESC]', 12, Col, Headings.Attr);
  77. FastWrite( 'division', 14, Col, Headings.Attr);
  78. FastWrite( 'sub-division', 15, Col, Headings.Attr);
  79. Ch := Entry.Division;          I := ord(Ch);
  80. Ch := Entry.SubDivision;       J := ord(Ch);
  81. if (I < 1) or (I > DivisionTop) then
  82.    begin
  83.    Temp1 := 'NULL CODE';
  84.    I := -16;
  85.    end
  86.   else
  87.    Temp1 := AlphaCode[I,0];
  88. if (J < 1) or (J > SubDivisionTop) then
  89.    begin
  90.    Temp2 := 'NULL CODE';
  91.    J := -16;
  92.    end
  93.   else
  94.    Temp2 := AlphaCode[I,J];
  95.  
  96. FastWrite( chr(I+64)+' '+Temp1, 14, BeginBlock, Inputs.Attr);
  97. FastWrite( chr(J+64)+' '+Temp2, 15, BeginBlock, Inputs.Attr);
  98. end;
  99.  
  100. (* -------------------------------------------------------------------- *)
  101.  
  102. procedure EmptyPageDisplay;
  103. begin
  104. TextAttr := Displays.Attr;
  105. clrscr;
  106. PageHeadingDisplay;
  107. EmptyFrame;
  108. PrintFrame;
  109. end;
  110.  
  111. (* -------------------------------------------------------------------- *)
  112.  
  113. procedure FullPageDisplay;
  114. var I,J,X:integer;
  115.     Temp1,Temp2:s30;
  116. begin
  117. clrscr;
  118. PageHeadingDisplay;
  119. PrintFrame;
  120. end;
  121.  
  122. (* -------------------------------------------------------------------- *)
  123.  
  124. procedure CheckCursor;
  125. begin
  126. if Row < 1 then
  127.    begin
  128.    Row := 1;
  129.    Col := BeginBlock;
  130.    end;
  131. if Row > FinalLine then
  132.    begin
  133.    Row := FinalLine;
  134.    Col := BeginBlock;
  135.    end;
  136. if Col < BeginBlock then
  137.    begin
  138.    dec(Row);
  139.    Col := BeginBlock + pred(FieldLen[Row]);
  140.    if Row < 1 then Row := 1;
  141.    end;
  142. if Col > (BeginBlock + pred(FieldLen[Row])) then
  143.    begin
  144.    if (I <> 72) and (I <> 80) then
  145.       begin
  146.       inc(Row);
  147.       Col := BeginBlock;
  148.       if Row > FinalLine then Row := FinalLine;
  149.       end
  150.    else
  151.       Col := BeginBlock + pred(FieldLen[Row]);
  152.    end;
  153. end;
  154.  
  155. (* -------------------------------------------------------------------- *)
  156.  
  157. procedure PageEditor;
  158. var I,
  159.     Row,
  160.     Col:                      integer;
  161.     check_space:              boolean;
  162.     Ch,
  163.     Ch2,
  164.     Ch3:                      char;
  165.  
  166.     procedure SwapC(I: integer);
  167.     var Temp: char;
  168.     begin
  169.     Temp := Frame[I,Row];
  170.     Frame[I,Row] := Frame[succ(I),Row];
  171.     Frame[succ(I),Row] := Temp;
  172.     end;
  173.  
  174. (* these next two procedures keep the format for Zip AlphaCode and phone number
  175.    correctly established *)
  176.  
  177.     procedure fix_constants_1;
  178.     var I:integer;
  179.     begin
  180.     for I:=FieldLen[Row] downto (Col-BeginBlock+2) do
  181.         if (Frame[I,Row]='/') or (Frame[I,Row]='-') then SwapC(I);
  182.     end;
  183.  
  184.     procedure fix_constants_2;
  185.     var I:integer;
  186.     begin
  187.     for I:= (Col-BeginBlock+2) to FieldLen[Row] do
  188.         if (Frame[I,Row]='/') or (Frame[I,Row]='-') then SwapC(I-1);
  189.     end;
  190.  
  191.     procedure enter_control(Ch:char);
  192.     var TempDiv,
  193.         TempSub,
  194.         OCh:                         integer;
  195.         Str:                          s2;
  196.     begin
  197.     I := ord(Ch);
  198.     if (I=27) then                                    (* esc *)
  199.        begin
  200.        if (Row=FinalLine) then
  201.           Continue := false
  202.          else
  203.           begin
  204.           Row := FinalLine;
  205.           Col := 1;
  206.           end;
  207.        end;
  208.     if I=59 then                                      (* f1 = enter AlphaCode *)
  209.        begin
  210.        CursorOn(false);
  211.        DivisionEdit(TempDiv, TempSub);
  212.        CursorOn(true);
  213.        FullPageDisplay;
  214.        end;
  215.     if I=60 then                                      (* f2 = jump *)
  216.        begin
  217.        Row := MailLine;
  218.        Col := 1;
  219.        end;
  220.     if I = 61 then                                    (* f3 = states *)
  221.        begin
  222.        CursorOn(false);
  223.        Str := DisplayStates;
  224.        if Str <> '  ' then
  225.           begin
  226.           Frame[1,7] := Str[1];
  227.           Frame[2,7] := Str[2];
  228.           FastWrite( Frame[1,7], 7, BeginBlock+(1)-1, Inputs.Attr);
  229.           FastWrite( Frame[2,7], 7, BeginBlock+(2)-1, Inputs.Attr);
  230.           end;
  231.        CursorOn(true);
  232.        end;
  233.     if (I=8) and (Col > BeginBlock) then             (* back space key *)
  234.        begin
  235.        dec(Col);
  236.        if (row >= ZipLine) and (row <= Phone2Line) then
  237.           begin
  238.           Ch2 := Frame[Col-BeginBlock+1,Row];
  239.           if (Ch2='/') or (Ch2='-') then
  240.              begin
  241.              for J := Col-BeginBlock+2 to FieldLen[Row] do
  242.                  Frame[J,Row] := Frame[J+1,Row];
  243.              Frame[FieldLen[Row],Row] := chr(PrintBlock);
  244.              Frame[(Col-BeginBlock+1),Row] := Ch2;
  245.              fix_constants_1;
  246.              dec(Col);
  247.              Frame[Col-BeginBlock+1,Row] := chr(PrintBlock);
  248.              end
  249.           else
  250.              begin
  251.              for J := Col-BeginBlock+1 to FieldLen[Row] do
  252.                  Frame[J,Row] := Frame[J+1,Row];
  253.              Frame[FieldLen[Row],Row] := chr(PrintBlock);
  254.              fix_constants_1;
  255.              end;
  256.           end
  257.        else
  258.           begin
  259.           for J := Col-BeginBlock+1 to pred(FieldLen[Row]) do
  260.               Frame[J,Row] := Frame[J+1,Row];
  261.           Frame[FieldLen[Row],Row] := chr(PrintBlock);
  262.           end;
  263.        for J := 1 to FieldLen[Row] do
  264.            FastWrite( Frame[J,Row], Row, BeginBlock+J-1, Inputs.Attr);
  265.        end;
  266.     if I=83 then                                        (* del key *)
  267.        begin
  268.        for J := Col-BeginBlock+1 to FieldLen[Row] do
  269.            Frame[J,Row] := Frame[J+1,Row];
  270.        Frame[FieldLen[Row],Row] := chr(PrintBlock);
  271.        if (row>=ZipLine) and (row<=Phone2Line) then fix_constants_1;
  272.        for J := 1 to FieldLen[Row] do
  273.            FastWrite( Frame[J,Row], Row, BeginBlock+J-1, Inputs.Attr);
  274.        end;
  275.     if I=82 then                                        (* insert key *)
  276.        begin
  277.        for J := FieldLen[Row] downto Col-BeginBlock+2 do
  278.            Frame[J,Row] := Frame[J-1,Row];
  279.        Frame[(Col-BeginBlock+1),Row] := chr(PrintBlock);
  280.        if (row>=ZipLine) and (row<=Phone2Line) then fix_constants_2;
  281.        for J := 1 to FieldLen[Row] do
  282.            FastWrite( Frame[J,Row], Row, BeginBlock+J-1, Inputs.Attr);
  283.        end;
  284.     if I=72 then dec(row);             (* up arrow *)
  285.     if I=80 then inc(Row);             (* down arrow *)
  286.     if I=75 then dec(Col);             (* left arrow *)
  287.     if I=77 then inc(Col);             (* right arrow *)
  288.     if I=71 then                       (* home *)
  289.        begin
  290.        Col := 1;
  291.        Row := 1;
  292.        end;
  293.     if I=13 then                       (* [enter] *)
  294.        begin
  295.        inc(Row);
  296.        Col := BeginBlock;
  297.        end;
  298.     CheckCursor(Row,Col,I);
  299.     end;
  300.  
  301.     procedure enter_other(Ch:char);
  302.     var OCh:                       integer;
  303.     begin
  304.     OCh := ord(Ch);
  305.     if (OCh > 31) and (OCh < 126) then
  306.        begin
  307.        if Col < BeginBlock+FieldLen[Row] then
  308.           begin
  309.           Frame[Col-BeginBlock+1,Row] := Ch;
  310.           gotoxy(Col,Row);
  311.           FastWrite( Frame[Col-BeginBlock+1,Row], Row, Col, Inputs.Attr);
  312.           inc(Col);
  313.           if Col > FieldLen[Row]+BeginBlock-1 then
  314.              Beep(1)
  315.             else
  316.              begin
  317.              Ch2 := Frame[Col-BeginBlock+1,Row];
  318.              Ch3 := Frame[Col-BeginBlock+2,Row];
  319.              if (Ch2='/') or (Ch2='-') then
  320.                 inc(Col);
  321.              end;
  322.           end
  323.          else
  324.           begin
  325.           Beep(1);
  326.           end;      (* if..then..else *)
  327.        end;
  328.     end;
  329.  
  330. begin
  331. Row :=1; Col := BeginBlock; Continue := true;
  332. CursorOn(true);
  333. while Continue do begin
  334.    gotoxy(Col,Row);
  335.    GetKey(Ch,FunctionKey);
  336.    if (Ch = #13) then FunctionKey := true;
  337.    if (Ch = #27) then FunctionKey := true;
  338.    if (Ch = #8) then FunctionKey := true;
  339.    if FunctionKey then
  340.       enter_control(Ch)
  341.    else
  342.       enter_other(Ch);
  343.    end;  (* while *)
  344. CursorOn(false);
  345. end;
  346.  
  347. procedure FieldSet;
  348. var I:integer;
  349. begin
  350. X := '';
  351. for I := 1 to FieldLen[Row] do
  352.     begin
  353.     if Frame[I,Row]=chr(PrintBlock) then Frame[I,Row] := ' ';
  354.     X := concat(X,Frame[I,Row]);
  355.     end;
  356. if X[ord(X[0])] = '-' then dec(X[0]);
  357. end;
  358.  
  359. procedure RecordSet;
  360. var X:          s40;
  361.     I:          integer;
  362. begin
  363. FieldSet(X,1);     Entry.Addressee := X;
  364. FieldSet(X,2);     Entry.Title := X;
  365. FieldSet(X,3);     Entry.Company := X;
  366. FieldSet(X,4);     Entry.AuxAddress := X;
  367. FieldSet(X,5);     Entry.MailAddress := X;
  368. FieldSet(X,6);     Entry.City := X;
  369. FieldSet(X,7);     Entry.State := X;
  370. FieldSet(X,8);     Entry.ZipCode := X;
  371. FieldSet(X,9);     Entry.Phone1 := X;
  372. FieldSet(X,10);    Entry.Phone2 := X;
  373. FieldSet(X,11);    Entry.Comments := X;
  374. end;
  375.  
  376. procedure Query;
  377. var garbage:boolean;
  378.     Ch:char;
  379. begin
  380. gotoxy(55,25);
  381. FastWrite( 'Another Entry ? (Y/N)', 21, 5, Inputs.Attr);
  382. GetKey(Ch,garbage);
  383. Ch := upcase(Ch);
  384. if Ch='Y' then X := true else X := false;
  385. end;
  386.  
  387. procedure NewDataInput;
  388. var Continue:            boolean;
  389.     test:                s30;
  390.     Temp2:                 integer;
  391. begin
  392. Continue := true;
  393. if FileTop <= high_record then
  394.    begin
  395.    while Continue do
  396.       begin
  397.       Entry.Division := #0;
  398.       Entry.SubDivision := #0;
  399.       EmptyPageDisplay;
  400.       PageEditor;
  401.       FastWrite( ' Saving record ! ', 20, 5, (Msgs.Attr or $0008));
  402.       RecordSet;
  403.       test := copy(Entry.Addressee,1,3);
  404.       if test <> '   ' then
  405.          begin
  406.          FileTop := FileTop + 1;
  407.          PutRec(Entry,FileTop);
  408.          PutFileTop;
  409.          FastWrite( ' Record saved !   ', 20, 5, (Msgs.Attr or $0008));
  410.          Query(Continue);
  411.          end
  412.       else
  413.          Continue := false;
  414.       if (FileTop - SortTop) > 97 then Continue := false;
  415. {$ifdef DemoOnly}
  416.          I := Restriction1;
  417.          I := I div Restriction2;
  418.          if FileTop >= I then
  419.             begin
  420.             FileTop := I;
  421.             FastWrite( CPad('Only 35 Addresses allowed in demo !',78),
  422.                       21, 2, Msgs.Attr);
  423.             Beep(3);
  424.             Continue := false;
  425.             end;
  426.          if SortTop >= I then SortTop := I;
  427. {$endif}
  428.       end;            (* while *)
  429.    end;               (* if..then *)
  430. end;
  431.  
  432.  
  433. end.
  434. 
  435.