home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / divedit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  4.9 KB  |  148 lines
  1. unit DivEdit;
  2.  
  3. interface
  4. uses Crt,     Def,      ColorDef, PrtDiv,  GetKeU,  FastWr, LPaU, CPaU, Swap,
  5.      RE,      SubEdit,  Co,       GetForU, StrnU;
  6. procedure DivisionEdit( var Division, SubDivision: integer);
  7.  
  8. implementation
  9.  
  10. procedure DivisionEdit;
  11. var Continue,
  12.     AllowInput,
  13.     FunctionKey,
  14.     Change:                        boolean;
  15.     Ch2,
  16.     Ch:                            char;
  17.     A,
  18.     B:                             s1;
  19.     Swap1,
  20.     Swap2,
  21.     OCh,
  22.     RecNumber,
  23.     AllowControl,
  24.     N1,
  25.     N2:                            integer;
  26.     Temp2,
  27.     Temp:                          s30;
  28. begin
  29. Continue := true;
  30. Change := false;
  31. while Continue do
  32.    begin
  33.    PrintDivision;
  34.    GetKey(Ch,FunctionKey);
  35.    AllowControl := -1;
  36.    AllowInput := true;
  37.    Ch := upcase(Ch);
  38.    N1 := ord(Ch);
  39.    if N1 = 59 then
  40.       N1 := -1
  41.      else
  42.       if N1 = 27 then
  43.          N1 := 0
  44.         else
  45.          if (N1 = 63) and FunctionKey then
  46.             N1 := -2
  47.            else
  48.             if (N1>64) and (N1<91) then
  49.                N1 := N1 - 64
  50.               else
  51.                N1 := -3;
  52.    case N1 of
  53.       -2:  begin
  54.            FastWrite(LPad('First letter to swap ?',40), 21, 1, Inputs.Attr);
  55.            GetKey(Ch,FunctionKey);
  56.            Ch := upcase(Ch);
  57.            OCh := ord(Ch);
  58.            if (OCh >= 65) and (OCh <= 90) then
  59.               begin
  60.               Swap1 := OCh - 64;
  61.               FastWrite(LPad('Second letter to swap ?',40), 21, 1, Inputs.Attr);
  62.               GetKey(Ch,FunctionKey);
  63.               Ch := upcase(Ch);
  64.               OCh := ord(Ch);
  65.               if (OCh >= 65) and (OCh <= 90) and (OCh <> Swap1+64) then
  66.                  begin
  67.                  Swap2 := OCh - 64;
  68.                  FastWrite( BlankLine, 21, 1, Displays.Attr);
  69.                  FastWrite( CPad( 'Swap:  "'+AlphaCode[0,Swap1]+'" & "'+
  70.                                  AlphaCode[0,Swap2]+'"   (Y/N)  ',80),
  71.                            21, 1, Inputs.Attr);
  72.                  GetKey(Ch,FunctionKey);
  73.                  Ch := upcase(Ch);
  74.                  if Ch = 'Y' then
  75.                     begin
  76.                     Change := true;
  77.                     SwapS( AlphaCode[0,Swap1], AlphaCode[0,Swap2]);
  78.                     SwapS( AlphaCode[Swap1,0], AlphaCode[Swap2,0]);
  79.                     for I := 1 to SubDivisionTop do
  80.                         SwapS( AlphaCode[Swap1,I], AlphaCode[Swap2,I]);
  81.                     FastWrite( BlankLine, 21, 1, Displays.Attr);
  82.                     FastWrite( 'Modifying record:', 21, 1, Msgs.Attr);
  83.                     for RecNumber := 1 to FileTop do
  84.                         begin
  85.                         if (RecNumber mod 10) = 0 then
  86.                            begin
  87.                            str(RecNumber,Temp2);
  88.                            FastWrite( Temp2, 21, 21, (Msgs.Attr or $0008));
  89.                            end;
  90.                         GetRec(HoldEntry,RecNumber);
  91.                         if HoldEntry.Division = chr(Swap1) then
  92.                            begin
  93.                            HoldEntry.Division := chr(Swap2);
  94.                            PutRec(HoldEntry,RecNumber);
  95.                            end
  96.                           else
  97.                            begin
  98.                            if HoldEntry.Division = chr(Swap2) then
  99.                               begin
  100.                               HoldEntry.Division := chr(Swap1);
  101.                               PutRec(HoldEntry,RecNumber);
  102.                               end;
  103.                            end;
  104.                         end;
  105.                     end;
  106.                  end;
  107.               end;
  108.            end;
  109.       -1:begin
  110.            Change := true;
  111.            FastWrite( BlankLine, 21, 1, Displays.Attr);
  112.            FastWrite( 'Select a letter', 21, 1, Inputs.Attr);
  113.            GetKey(Ch,FunctionKey);
  114.            Ch := upcase(Ch);
  115.            N2 := ord(Ch);
  116.            if N2 = 59 then N2 := -1 else
  117.               if (N2 > 64) and (N2 < 91) then N2 := N2 - 64;
  118.            FastWrite( BlankLine, 21, 1, Displays.Attr);
  119.            FastWrite( 'AlphaCode for division '+chr(N2+64),
  120.                       21, 1, Inputs.Attr);
  121.            Temp := GetForm( 40, 21, 30, Strng(30,#32), AlphaCode[N2,0],
  122.                             AllowControl, AllowInput, Inputs.Attr,
  123.                             [#32..#126]);
  124.            if (N2 >= 1) and (N2 <= DivisionTop) then
  125.               begin
  126.               AlphaCode[N2,0] := Temp;
  127.               AlphaCode[0,N2] := Temp;
  128.               end;
  129.            end;
  130.        0:Continue := false;
  131.        1..DivisionTop :begin
  132.            Entry.Division := chr(N1);
  133.            Division := N1;
  134.            EditSubDivision(N1,Change);
  135.            if N1 in [1..SubDivisionTop] then SubDivision := N1;
  136.            Continue := false;
  137.            end;
  138.        end;        (* case *)
  139.    end;            (* while *)
  140. if Change then
  141.    begin
  142.    clrscr;
  143.    PutAlphaCodes;
  144.    end;
  145. end;
  146.  
  147. end.
  148.