home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / RAREPORT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-04  |  5.4 KB  |  152 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit RaReport;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   Db, DBTables, QuickRpt, Qrctrls, QRactrls, ExtCtrls, DBClient, FrmDSrce;
  33.  
  34. type
  35.   TfmRaReport = class(TForm)
  36.     Report: TQuickRep;
  37.     PageFooterBand: TQRaBand;
  38.     TitleBand: TQRBand;
  39.     QRSysData1: TQRSysData;
  40.     PageHeaderBand: TQRaBand;
  41.     QRSysData2: TQRSysData;
  42.     QRLabel3: TQRLabel;
  43.     QRSysData3: TQRSysData;
  44.     QRSysData4: TQRSysData;
  45.     QRlbOrgName: TQRLabel;
  46.     QRaSysData1: TQRSysData;
  47.     DetailBand: TQRaBand;
  48.     ColumnHeaderBand: TQRaBand;
  49.     qrlbUser: TQRaLabel;
  50.     procedure QRlbOrgNamePrint(sender: TObject; var Value: String);
  51.     procedure ReportPreview(Sender: TObject);
  52.     procedure FormCreate(Sender: TObject);
  53.     procedure QRLabel3Print(sender: TObject; var Value: String);
  54.     procedure qrlbUserPrint(sender: TObject; var Value: String);
  55.   public
  56.     procedure SetupPrinter;
  57.   end;
  58.  
  59. var UserName, FullUserName: string;
  60.  
  61. implementation
  62.  
  63. uses stdUtils, WinSpool, Printers, qrPrntr, CommDlg, RaPrevw;
  64. {$R *.DFM}
  65.  
  66. procedure TfmRaReport.SetupPrinter;
  67. var ADeviceMode: PDeviceMode;
  68.     hDevMode: HGLOBAL;
  69.     hDevNames: HGLOBAL;
  70. begin
  71.    stdUtils.GetPrinter(hDevMode, hDevNames);
  72.    ADeviceMode := GlobalLock(hDevMode);
  73.    try
  74.      if ADeviceMode^.dmPaperSize = 256 then
  75.      begin
  76.         Report.Page.PaperSize := Custom;
  77.         Report.Units := MM;
  78.         Report.Page.Length := ADeviceMode^.dmPaperLength/10;
  79.         Report.Page.Width := ADeviceMode^.dmPaperWidth/10;
  80.      end
  81.        else
  82.         Report.Page.PaperSize := TQRPaperSize(ADeviceMode^.dmPaperSize);
  83.      Report.PrinterSettings.Copies := ADeviceMode^.dmCopies;
  84.      Report.Page.Orientation := TPrinterOrientation(ADeviceMode^.dmOrientation-1);
  85.    finally
  86.      GlobalUnLock(hDevMode)
  87.    end;
  88.    if (Owner is TForm) then
  89.       Report.ReportTitle := (Owner as TForm).Caption;
  90. end;
  91.  
  92. procedure TfmRaReport.QRlbOrgNamePrint(sender: TObject; var Value: String);
  93. begin
  94.    Value := OrgName+' ('+Application.Title+')';
  95. end;
  96.  
  97. procedure TfmRaReport.ReportPreview(Sender: TObject);
  98.  
  99.   function GetMaxWidth: integer;
  100.   var i: Integer;
  101.   begin
  102.      Result := 0;
  103.      for i := 0 to ColumnHeaderBand.ControlCount-1 do
  104.         with ColumnHeaderBand.Controls[i] do
  105.         if Left+Width > Result then
  106.            Result := Left+Width;
  107.   end;
  108.  
  109. var AWidth: Integer;
  110. begin
  111.   SetupPrinter;
  112.   if PrinterType = ptGraphics then
  113.   while (Report.Font.Size > 5) and
  114.         (GetMaxWidth > DetailBand.Width) do
  115.   begin
  116.       Report.Font.Size := Report.Font.Size-1;
  117.       Application.ProcessMessages;
  118.   end;
  119.   AWidth := GetMaxWidth;
  120.   if AWidth < QRSysData1.Width+QRSysData2.Width then
  121.      AWidth := QRSysData1.Width+QRSysData2.Width;
  122.   if AWidth > PageHeaderBand.Width then
  123.      AWidth := PageHeaderBand.Width;
  124.   QRSysData2.Left := AWidth - QRSysData2.Width;
  125.   QRSysData3.Left := QRSysData2.Left;
  126.   QRaSysData1.Left := (AWidth-QRaSysData1.Width) div 2;
  127.   QRLabel3.Left := AWidth - QRLabel3.Width;
  128.   with TfmPreview.Create(Report) do
  129.     Show;
  130. end;
  131.  
  132. procedure TfmRaReport.FormCreate(Sender: TObject);
  133. begin
  134.    Report.PrinterSettings.PrinterIndex := Printer.PrinterIndex;
  135. end;
  136.  
  137. procedure TfmRaReport.QRLabel3Print(sender: TObject; var Value: String);
  138. begin
  139.    Value := Format(Value, [FormatDateTime('yyy', Date)]);
  140. end;
  141.  
  142. procedure TfmRaReport.qrlbUserPrint(sender: TObject; var Value: String);
  143. begin
  144.   Value := '';
  145.   if UserName <> '' then
  146.   begin
  147.     Value := Format('User: %s', [FullUserName]);
  148.   end;
  149. end;
  150.  
  151. end.
  152.