home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / pg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  11.9 KB  |  386 lines
  1. unit PG;
  2.  
  3. interface
  4. uses Crt,      Def,      ColorDef, FastWr,   GetForU,  StrnU, StriU,  RE,
  5.      FixNamU,  LPaU,     StripOuU, SetBU,    DrawSqar, CPaU,  GetKeU, Str2InU,
  6.      CursorOU;
  7. procedure PrintDevice;
  8. procedure CompressPrint;
  9. procedure DeCompressPrint;
  10. procedure PrintLabel( Top, RecordNum: integer);
  11. procedure PrintRecord( Top, RecordNum: integer);
  12. procedure MailMergeRecord(RecordNum: integer);
  13. procedure PrintQuery;
  14.  
  15. implementation
  16.  
  17. procedure PrintDevice;
  18. var Temp:              string;
  19.     AllowInput:        boolean;
  20.     AllowControl:      integer;
  21. begin
  22. CursorOn(False);
  23. AllowControl := -1;
  24. AllowInput := true;
  25. Temp := '';
  26. FastWrite( 'File name for print-out ? ([ENTER] defaults to the printer)',
  27.           1, 1, Inputs.Attr);
  28. Temp := Strip( GetForm( 1, 2, 78, Strng(78,' '), Temp, AllowControl,
  29.                         AllowInput, Inputs.Attr, [#31..#126]));
  30. Device := 'PRN';
  31. if ord(Temp[0]) > 1 then Device := Temp;
  32. FastWrite( Strng(80,#32), 1, 1, Displays.Attr);
  33. FastWrite( Strng(80,#32), 2, 1, Displays.Attr);
  34. end;
  35.  
  36. procedure CompressPrint;
  37. begin
  38. if ((Compress1[ActivePrinter] <> 0) or (Compress2[ActivePrinter] <> 0))
  39.    and (Device='PRN') then
  40.    begin
  41.    if Compress1[ActivePrinter] <> 0 then
  42.       write( OutPutDevice, chr(Compress1[ActivePrinter]));
  43.    if Compress2[ActivePrinter] <> 0 then
  44.       write( OutPutDevice, chr(Compress2[ActivePrinter]));
  45.    end;
  46. end;
  47.  
  48. procedure DeCompressPrint;
  49. begin
  50. if ((DeCompress1[ActivePrinter]<>0) or (DeCompress2[ActivePrinter]<>0))
  51.    and (Device='PRN') then
  52.    begin
  53.    if DeCompress1[ActivePrinter] <> 0  then
  54.       write(OutPutDevice,chr(DeCompress1[ActivePrinter]));
  55.    if DeCompress2[ActivePrinter] <> 0  then
  56.       write(OutPutDevice,chr(DeCompress2[ActivePrinter]));
  57.    end;
  58. end;
  59.  
  60. procedure PrintLabel;
  61. var ReturnAddressName,
  62.     Use,
  63.     AddressName:                  s40;
  64.     ExtraLines,
  65.     Count,
  66.     X1,
  67.     X2,
  68.     J,
  69.     I:                     integer;
  70.  
  71.    procedure PrintActiveLabel( Entry: MainRecordType);
  72.    var A:            array [1..MaxFormLength,1..MaxFormWidth] of char;
  73.        J,
  74.        I:            integer;
  75.  
  76.      procedure PlaceFileds(E: MainRecordType; X, Y: integer);
  77.      var I,
  78.          J,
  79.          K,
  80.          Row,
  81.          Col:                                  integer;
  82.          Temp:                                 S80;
  83.          PrintSomething:                      boolean;
  84.      begin
  85.      Row := Y;
  86.      I := 1;
  87.      while (Form[ActiveForm].PlaceArray[I,1] <> 0) and (I < LastDescription) do
  88.          begin
  89.          Col := X;
  90.          PrintSomething := false;
  91.          J := 1;
  92.          while (Form[ActiveForm].PlaceArray[I,J] <> 0)
  93.          and   (J <= MaxFieldLine) do
  94.              begin
  95.              case Form[ActiveForm].PlaceArray[I,J] of
  96.                 1:  Temp := Use;
  97.                 2:  Temp := E.Title;
  98.                 3:  Temp := E.Company;
  99.                 4:  Temp := E.AuxAddress;
  100.                 5:  Temp := E.MailAddress;
  101.                 6:  if Komma then
  102.                        Temp := Strip(E.City)+','
  103.                       else
  104.                        Temp := Strip(E.City);
  105.                 7:  if Komma then
  106.                        Temp := E.State+'.'
  107.                       else
  108.                        Temp := E.State;
  109.                 8:  Temp := E.ZipCode;
  110.                 9:  Temp := E.Phone1;
  111.                 10: Temp := E.Phone2;
  112.                 11: Temp := E.Comments;
  113.                 end;
  114.              if ord(Temp[0]) > 1 then
  115.                 while (ord(Temp[ord(Temp[0])]) < 33)
  116.                 and   (ord(Temp[0]) > 1) do
  117.                     dec(Temp[0]);
  118.              if length(Temp) > 1 then
  119.                 begin
  120.                 if Form[ActiveForm].PlaceArray[I,J] = 8 then
  121.                    if length(Temp) = 6 then
  122.                       delete(Temp,6,1);
  123.                 PrintSomething := true;
  124.                 for K := 1 to length(Temp) do
  125.                     begin
  126.                     A[Row,Col] := Temp[K];
  127.                     inc(Col);
  128.                     end;
  129.                 A[Row,Col] := ' ';
  130.                 inc(Col);
  131.                 end;
  132.              inc(J);
  133.              end;
  134.          if PrintSomething then inc(Row);
  135.          inc(I);
  136.          end;
  137.      end;
  138.  
  139.      function FindLastCol( Row: integer): integer;
  140.      var Col:                             integer;
  141.      begin
  142.      Col := Form[ActiveForm].FormWidth;
  143.      while (A[Row,Col] = ' ') and (Col > 1) do dec(Col);
  144.      FindLastCol := Col;
  145.      end;
  146.  
  147.    begin
  148.    with Form[ActiveForm] do
  149.       begin
  150.       for I := 1 to FormLen do
  151.           for J := 1 to FormWidth do A[I,J] := ' ';
  152.       Use := ReturnAddressName;
  153.       if (ReturnColOffset <> 0) and (ReturnRowOffset <> 0) then
  154.          PlaceFileds( ReturnAddress, ReturnColOffset, ReturnRowOffset);
  155.       Use := AddressName;
  156.       if (ColOffset <> 0) and (RowOffset <> 0) then
  157.          PlaceFileds( Entry, ColOffset, RowOffset);
  158.       for I := 1 to FormLen do
  159.           begin
  160.           for J := 1 to FindLastCol(I) do write(OutPutDevice,A[I,J]);
  161.           writeln(OutPutDevice,' ');
  162.           end;
  163.       end;   (* with *)
  164.    end;
  165.  
  166.    procedure PrintDefaultLabel( Entry: MainRecordType);
  167.    var I:    integer;
  168.    begin
  169.    ExtraLines := 3;
  170.    if length(Strip(AddressName)) > 30 then CompressPrint;
  171.    writeln(OutPutDevice,AddressName);
  172.    if length(Strip(AddressName)) > 30 then DeCompressPrint;
  173.    if (length(Strip(Entry.Title)) > 0)
  174.    or (length(Strip(Entry.Company)) > 0) then
  175.       begin
  176.       CompressPrint;
  177.       if (length(Strip(Entry.Title)) > 0) then
  178.          write(OutPutDevice,Entry.Title,' ');
  179.       if (length(Strip(Entry.Company)) > 0) then
  180.          write(OutPutDevice,Entry.Company);
  181.       writeln(OutPutDevice,'');
  182.       dec(ExtraLines);
  183.       DeCompressPrint;
  184.       end;
  185.    X1 := length(Strip(Entry.AuxAddress));
  186.    if (X1 > 0) then
  187.       begin
  188.       if X1 > 30 then CompressPrint;
  189.       writeln(OutPutDevice,Entry.AuxAddress);
  190.       if X1 > 30 then DeCompressPrint;
  191.       dec(ExtraLines);
  192.       end;
  193.    X1 := length(Entry.MailAddress);
  194.    if X1 > 30 then CompressPrint;
  195.    writeln(OutPutDevice,Entry.MailAddress);
  196.    if X1 > 30 then DeCompressPrint;
  197.    CompressPrint;
  198.    if Komma then
  199.       write(OutPutDevice,Strip(Entry.City),', ',Entry.State,'. ')
  200.      else
  201.       write(OutPutDevice,Strip(Entry.City),' ',Entry.State);
  202.    if (ord(Entry.ZipCode[7]) < 48) or
  203.       (ord(Entry.ZipCode[7]) > 57) then X1 := 5 else X1 := 10;
  204.    writeln(OutPutDevice,copy(Entry.ZipCode,1,X1));
  205.    DeCompressPrint;
  206.    for I := 1 to ExtraLines do writeln(OutPutDevice,' ');
  207.    end;
  208.  
  209. begin
  210. GetRec(Entry,RecordNum);
  211. AddressName := Entry.Addressee;
  212. FixName(AddressName);
  213. ReturnAddressName := ReturnAddress.Addressee;
  214. FixName(ReturnAddressName);
  215. for Count := 1 to Top do
  216.     if ActiveForm = 0 then
  217.        PrintDefaultLabel(Entry)
  218.       else
  219.        PrintActiveLabel(Entry);
  220. end;
  221.  
  222. (* -------------------------------------------------------------------- *)
  223.  
  224. procedure PrintRecord;
  225. var Temp1,
  226.     Temp2,
  227.     Temp:                               s40;
  228.     Count,
  229.     I:                                  integer;
  230.     Compress_test:                      boolean;
  231. begin
  232. Compress_test := false;
  233. GetRec(Entry,RecordNum);
  234. Temp := Entry.Addressee;
  235. FixName(Temp);
  236. CompressPrint;
  237. for Count := 1 to Top do
  238.     begin
  239.     write(OutPutDevice, LPad(Temp,25));
  240.     if (PrinterMode=1) or (PrinterMode=3) then
  241.        begin
  242.        write(OutPutDevice,' ',Entry.MailAddress,' ',Entry.City,' ',Entry.State);
  243.        write(OutPutDevice,' ',Entry.ZipCode);
  244.        end;
  245.     if (PrinterMode=2) or (PrinterMode=3) then
  246.        begin
  247.        write(OutPutDevice,' ',Entry.Phone1,' ',Entry.Phone2);
  248.        if PrinterMode = 2 then
  249.           write(OutPutDevice,' ',Entry.Title,' ',Entry.Company);
  250.        end;
  251.     if (PrinterMode=4) then
  252.        begin
  253.        writeln(OutPutDevice,#92,Entry.Title,#92,Entry.Company);
  254.        write(OutPutDevice,'   ',Entry.AuxAddress,#92,Entry.MailAddress,#92);
  255.        writeln(OutPutDevice,Entry.City,#92,Entry.State,#92,Entry.ZipCode);
  256.        Ch := Entry.Division;        I := ord(Ch);
  257.        Ch := Entry.SubDivision;     J := ord(Ch);
  258.        if (I < 1) or (I > DivisionTop) then
  259.           Temp1 := ' null AlphaCode'
  260.          else
  261.           Temp1 := AlphaCode[I,0];
  262.        if (J < 1) or (J > SubDivisionTop) then
  263.           Temp2 := ' null AlphaCode'
  264.          else
  265.           Temp2 := AlphaCode[I,J];
  266.        Temp1 := LPad(Temp1,14);
  267.        Temp2 := LPad(Temp2,14);
  268.        write(OutPutDevice,'   ',Entry.Phone1,#92,Entry.Phone2,#92,Temp1:14);
  269.        writeln(OutPutDevice,#92,Temp2:14,#92,Entry.Comments);
  270.        end;
  271.     if PrinterMode=4 then
  272.        writeln(OutPutDevice,'--------')
  273.       else
  274.        writeln(OutPutDevice,'');
  275.     end;
  276. DeCompressPrint;
  277. end;
  278.  
  279. (* -------------------------------------------------------------------- *)
  280.  
  281. procedure MailMergeRecord;
  282. var Temp1,
  283.     Temp2,
  284.     FirstName,
  285.     LastName:                                 s40;
  286.     Lngth,
  287.     X:                                  integer;
  288. begin
  289. GetRec(Entry,RecordNum);
  290. FirstName := Strip(Entry.Addressee);
  291. LastName := FirstName;
  292. X := pos(';',FirstName);
  293. if X = 0 then
  294.    LastName := ''
  295.   else
  296.    begin
  297.    LastName[0] := chr(pred(X));
  298.    X := succ(X);
  299.    Lngth := succ(ord(FirstName[0]) - X);
  300.    move( FirstName[X], FirstName[1], Lngth);
  301.    FirstName[0] := chr(Lngth);
  302.    FirstName := Strip(FirstName);
  303.    LastName := Strip(LastName);
  304.    end;
  305.  
  306. Ch := Entry.Division;        I := ord(Ch);
  307. Ch := Entry.SubDivision;     J := ord(Ch);
  308. if (I < 1) or (I > DivisionTop) then
  309.    Temp1 := ' null AlphaCode'
  310.   else
  311.    Temp1 := AlphaCode[I,0];
  312. if (J < 1) or (J > SubDivisionTop) then
  313.    Temp2 := ' null AlphaCode'
  314.   else
  315.    Temp2 := AlphaCode[I,J];
  316. Temp1 := Strip(Temp1);
  317. Temp2 := Strip(Temp2);
  318. Entry.ZipCode := Strip(Entry.ZipCode);
  319. Lngth := ord(Entry.ZipCode[0]);
  320. if Entry.ZipCode[Lngth] = '-' then dec(Entry.ZipCode[0]);
  321. (*  := chr(pred(Lngth));  *)
  322.  
  323. if StripOut(Entry.Phone1,'/- ') = '' then Entry.Phone1 := '';
  324. if StripOut(Entry.Phone2,'/- ') = '' then Entry.Phone2 := '';
  325.  
  326. writeln( OutPutDevice,
  327.          '"', FirstName, '","', LastName, '","',
  328.          StripOut(Strip(Entry.Title),'"'), '","',
  329.          StripOut(Strip(Entry.Company),'"'), '","',
  330.          StripOut(Strip(Entry.AuxAddress),'"'), '","',
  331.          StripOut(Strip(Entry.MailAddress),'"'), '","',
  332.          StripOut(Strip(Entry.City),'"'), '","',
  333.          StripOut(Strip(Entry.State),'"'), '","',
  334.          StripOut(Strip(Entry.ZipCode),'"'), '","',
  335.          StripOut(Strip(Entry.Phone1),'"'), '","',
  336.          StripOut(Strip(Entry.Phone2),'"'), '","',
  337.          StripOut(Strip(Entry.Comments),'"'), '","',
  338.          chr(ord(Entry.Division)+64), '","', Temp1, '","',
  339.          chr(ord(Entry.SubDivision)+64), '","', Temp2, '"' );
  340. end;
  341.  
  342. (* -------------------------------------------------------------------- *)
  343.  
  344. procedure PrintQuery;
  345. var Row,
  346.     I,
  347.     J,
  348.     Err,
  349.     AllowControl,
  350.     Col:                   integer;
  351.     AllowInput,
  352.     FunctionKey:           boolean;
  353.     Ch:                    char;
  354. begin
  355. SetBG;
  356. clrscr;
  357. Col := 30;  Row := 12;
  358. DrawSquare( 1, 1, 80, 25, Menus.Attr, true);
  359. FastWrite( CPad('1. Use current form method',20), Row+1, Col, Menus.Attr);
  360. FastWrite( CPad('2. Use current line method',20), Row+2, Col, Menus.Attr);
  361. GetKey(Ch,FunctionKey);
  362. if (Ch = '1') or (Ch = '2') then
  363.    begin
  364.    AllowControl := -1;
  365.    AllowInput := true;
  366.    FastWrite( LPad('How many entries ?',40), 20, 5, Inputs.Attr);
  367.    I := Str2Int( GetForm( 50, 20, 5, Strng(5,' '), '1', AllowControl,
  368.                           AllowInput, (Inputs.Attr or $0008), ['0'..'9']),
  369.                  Err);
  370.    SetBG;
  371.    if (I > 0) then
  372.       begin
  373.       assign(OutPutDevice,'PRN');
  374.       rewrite(OutPutDevice);
  375.       case Ch of
  376.           '1': PrintLabel(I,RecordNum);
  377.           '2': PrintRecord(I,RecordNum);
  378.           end;
  379.       close(OutPutDevice);
  380.       end;
  381.    end;
  382. end;
  383.  
  384. end.
  385. 
  386.