tsprintgrid.pas

企业进销存管理系统

{*******************************************************}
{                                                       }
{       ObjectSight Visual Components                   }
{       TopGrid TtsDbGrid Print routine                 }
{                                                       }
{       Copyright (c) 1997 - 2001, ObjectSight          }
{                                                       }
{*******************************************************}

unit tsPrintGrid;

{$INCLUDE TSCmpVer}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Printers, TsGrid,
  StdCtrls, ImgList, ComCtrls, quickrpt, Qrctrls, QRPrntr
  {$IFDEF TSVER_V6} , Variants {$ENDIF};

type
  TtsBaseGrid_ = class(TtsBaseGrid) end;
  TtsCustomGrid_ = class(TtsCustomGrid) end;

  TosReportTotal = class(TObject)
  private
    FColumn   : Integer;
    FLabel    : TQRLabel;
    FDataType : Integer;
    FTotal    : Double;
    FIsNegative : Boolean;
  public
    procedure ShowTotal;
  end;

  TfmPrintGrid = class(TForm)
    qrGrid: TQuickRep;
    bnColumnHeader: TQRBand;
    bnDetail: TQRBand;
    ilImages: TImageList;
    bnPageHeader: TQRBand;
    qlDateTimeLabel: TQRLabel;
    qsDateTime: TQRSysData;
    qrReportTitle: TQRSysData;
    qsPageNo: TQRSysData;
    qlPageLabel: TQRLabel;
    bnSummary: TQRBand;
    qlEndOfReport: TQRLabel;
    laRecordCount: TQRLabel;
    RichEdit1: TRichEdit;
    qiTitleImage: TQRImage;
    procedure qrGridNeedData(Sender: TObject; var MoreData: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure qrGridAfterPrint(Sender: TObject);
    procedure qrGridAfterPreview(Sender: TObject);
    procedure qrGridBeforePrint(Sender: TCustomQuickRep;
      var PrintReport: Boolean);
  private
    { Private declarations }
    FGrid : TtsGrid;
    FRow, FMaxCols, FDetailHeight, FRowCount : Integer;
    FHorzScale : Double;
    FcellDrawInfo : TtsDrawInfo;
    FCheckedBitmap : TBitmap;
    FUnCheckedBitmap : TBitmap;
    FContractBitmap, FExpandBitmap : TBitmap;
    FControls, FTotalControls : TList;
    FGroupCnt, FRecCnt : Integer;
    FBookmarks : TStringList;
    FTitle, FEndOfReportText : String;
    FPrinterOrientation : TPrinterOrientation;
    FDetailColor : TColor;
    FColumnSpacing : Integer;

    function  GetReportWidth : Integer;
    function  GetColumnSeparation : Integer;                        
    function  NextColumnPos(Left : Integer; aColumn : TtsCol) : Integer;
    function  ColWidth(Width : Integer) : Integer;
    procedure ComputeHorzScale;
    procedure ClearDrawInfo;
    function  GetOrientation : Integer;
    procedure SetOrientation(Value : Integer);
    procedure IncrementColumnTotal(iCol : Integer; theLabel : TQRLabel);
    function  ColumnReportTotal(iCol : Integer) : TosReportTotal;
    procedure ShowReportTotals;
    procedure ApplyCustomSettings;
  public
    { Public declarations }
    procedure Initialize;
    procedure ConfigureColumns(aGrid : TtsBaseGrid);
    procedure PreView;
    procedure Print;
    procedure SetGrid(aCustomGrid : TtsCustomGrid);

    property ContractBitmap: TBitmap read FContractBitmap write FContractBitmap;
    property ExpandBitmap: TBitmap read FExpandBitmap write FExpandBitmap;
    property Title : String read FTitle write FTitle;
    property EndofReportText : String read FEndOfReportText write FEndOfReportText;
    property PrinterOrientation : TPrinterOrientation read FPrinterOrientation write FPrinterOrientation;
    property Orientation : Integer read GetOrientation write SetOrientation;
    property ColumnSeparation : Integer read GetColumnSeparation;
    property ReportWidth : Integer read GetReportWidth;    
  end;

var
  fmPrintGrid: TfmPrintGrid;

implementation

{$R *.DFM}

function TfmPrintGrid.GetReportWidth : Integer;
begin
  Result := Round(qrGrid.Page.Width - qrGrid.Page.LeftMargin - qrGrid.Page.RightMargin);
end;

function TfmPrintGrid.GetColumnSeparation : Integer;
var iLeftMargin : Double;
begin
  // ColumnSpacing is in MM so we need to translate MM to Pixels...
  if (FColumnSpacing = 0) and
     (FGrid.GridReport.ColumnSpacing > 0) then
  begin
    iLeftMargin := qrGrid.Page.LeftMargin;  // Save to restore...
    qrGrid.Units := MM;
    try
      qrGrid.Page.LeftMargin := FGrid.GridReport.ColumnSpacing;
    finally
      qrGrid.Units := Pixels;
      FColumnSpacing := Round(qrGrid.Page.LeftMargin);
      qrGrid.Page.LeftMargin := iLeftMargin; // Reset back !
    end;
  end;
  Result := FColumnSpacing;
end;

function  TfmPrintGrid.GetOrientation : Integer;
begin
  Result := Integer(FPrinterOrientation);
end;

procedure TfmPrintGrid.SetOrientation(Value : Integer);
begin
  FPrinterOrientation := TPrinterOrientation(Value);
end;

procedure TfmPrintGrid.ComputeHorzScale;
var iGridWidth, i, printCol, AvailableReportWidth : Integer;
    aColumn : TtsCol;
begin
  // Fit FMaxCols columns on the page horizontally...
  FHorzScale := 1.0;
  iGridWidth := 0;
  printCol := 0;
  for i := 1 to FGrid.Cols do
  begin
    aColumn := FGrid.Col[FGrid.DataColnr[i]];
    if (aColumn <> Nil) and
       (aColumn.Visible) and
       (((aColumn.Selected) and (FGrid.ColSelectMode = csMulti)) or
        (FGrid.ColSelectMode = csNone) or (FGrid.SelectedCols.Count = 0))  then
    begin
       iGridWidth := iGridWidth + aColumn.Width;
       Inc(printCol);
    end;
    if (FGrid.PrintCols > 0) and
       (printCol >= FGrid.PrintCols) then
       break;
  end;
  AvailableReportWidth := ReportWidth - 4 - Round(Self.ColumnSeparation * (printCol - 1));
  if (iGridWidth > AvailableReportWidth) and
     (AvailableReportWidth > 0) then
     FHorzScale := Abs(iGridWidth / AvailableReportWidth);
end;

procedure TfmPrintGrid.ApplyCustomSettings;
begin
  if FGrid.GridReport = Nil then
  begin
    qlDateTimeLabel.Caption := 'DateTime:';
    qlPageLabel.Caption := 'Page:';
    qlEndOfReport.Caption := '*** END OF REPORT ***';
    qlDateTimeLabel.Font.Color := clBlack;
    qsDateTime.Font.Color := clBlack;
    qlPageLabel.Font.Color := clBlack;
    qsPageNo.Font.Color := clBlack;
    qlEndOfReport.Font.Color := clBlack;
    laRecordCount.Font.Color := clBlack;
    qrReportTitle.Font.Name := 'Aria';
    qrReportTitle.Font.Size := 14;
    qrReportTitle.Font.Style := [fsBold];
    qrReportTitle.Font.Color := clBlack;
    qiTitleImage.Picture.Assign(Nil);
    qiTitleImage.Left := Round(ReportWidth / 2) - Round(qiTitleImage.Width / 2);
    bnPageHeader.Height := 58;
    
    exit;
  end;

  // Switch to Millimeters briefly...
  qrGrid.Units := MM;
  qrGrid.Page.LeftMargin   := FGrid.GridReport.Margins.LeftMargin;
  qrGrid.Page.RightMargin  := FGrid.GridReport.Margins.RightMargin;
  qrGrid.Page.TopMargin    := FGrid.GridReport.Margins.TopMargin;
  qrGrid.Page.BottomMargin := FGrid.GridReport.Margins.BottomMargin;
  qrGrid.Units := Pixels;
  FDetailColor := FGrid.GridReport.PrintBandColor;
  if FGrid.GridReport.PrintLineMode = lmBanded then
     bnDetail.Color := FDetailColor
  else
     bnDetail.Color := clWhite;  
  qrGrid.Page.PaperSize := TQRPaperSize(FGrid.GridReport.PaperSize);
  qlDateTimeLabel.Caption := FGrid.GridReport.DateTimeLabel;
  qsDateTime.Left := qlDateTimeLabel.Left + qlDateTimeLabel.Width + 5;
  qlPageLabel.Caption := FGrid.GridReport.PageLabel;
  qlPageLabel.Left := ReportWidth - qlPageLabel.Width - 25;
  qlEndOfReport.Caption := FGrid.GridReport.EndOfReportLabel;

  if not FGrid.GridReport.ShowDateTime then
  begin
    qlDateTimeLabel.Font.Color := clWhite;
    qsDateTime.Font.Color := clWhite;
  end
  else
  begin
    qlDateTimeLabel.Font.Color := clBlack;
    qsDateTime.Font.Color := clBlack;
  end;
  if not FGrid.GridReport.ShowPageCount then
  begin
    qlPageLabel.Font.Color := clWhite;
    qsPageNo.Font.Color := clWhite;
  end
  else
  begin
    qlPageLabel.Font.Color := clBlack;
    qsPageNo.Font.Color := clBlack;
  end;
  if not FGrid.GridReport.ShowEndOfReport then
     qlEndOfReport.Font.Color := clWhite
  else
     qlEndOfReport.Font.Color := clBlack;
  if not FGrid.GridReport.ShowRecordCount then
     laRecordCount.Font.Color := clWhite
  else
     laRecordCount.Font.Color := clBlack;
  if (not FGrid.GridReport.ShowTitleSection) then
     bnPageHeader.Height := 0;     

  qrReportTitle.Font.Assign(FGrid.GridReport.TitleFont);

  if FGrid.GridReport.titleImage <> Nil then
  begin
    qiTitleImage.Picture.Assign(FGrid.GridReport.titleImage);
    qiTitleImage.Left := Round((ReportWidth / 2) - Round(qiTitleImage.Width / 2));
  end;
  bnDetail.Frame.DrawTop := (FGrid.GridReport.PrintLineMode = lmLine);
end;

procedure TfmPrintGrid.Initialize;
var i : Integer;
begin
  FGrid := Nil;
  FGroupCnt := 0;
  FRecCnt := 0;
  for i := FTotalControls.Count - 1 downto 0 do
  begin
    TosReportTotal(FTotalControls.Items[i]).FLabel.Free;
    TosReportTotal(FTotalControls.Items[i]).Free;
  end;
  for i := FControls.Count - 1 downto 0 do
    TObject(FControls.Items[i]).Free;
  FControls.Clear;
  FTotalControls.Clear;
  FBookmarks := TStringList.Create;
  FColumnSpacing := 0;
end;

procedure TfmPrintGrid.ConfigureColumns(aGrid : TtsBaseGrid);
var i, iLeft, iDataHeight, printCol : Integer;
    aColumn : TtsCol;
    aReportLabel : TQRLabel;
    aReportRichText : TQRRichText;
    aReportImage : TQRImage;

    procedure AddImage;
    begin
			aReportImage := TQRImage.Create(qrGrid);
			aReportImage.ParentReport := qrGrid;
			aReportImage.Parent := bnDetail;
			with aReportImage do
			begin
				Name := 'Col' + IntToStr(i);
				AutoSize    := False;
				Height      := bnDetail.Height;
				Size.Left   := iLeft + Round(aColumn.Width/2) - 6;
				Size.Top    := 0;
				Size.Width  := ColWidth(aColumn.Width)
			end;
			aColumn.Data := aReportImage;
      FControls.Add(aReportImage);
    end;

    procedure AddLabel;
    begin
		  aReportLabel := TQRLabel.Create(qrGrid);
		  aReportLabel.Parent := bnDetail;
		  with aReportLabel do
		  begin
				Name := 'Col' + IntToStr(i);
				Alignment   := TAlignment(aColumn.Alignment);
        if FGrid.PrintWithGridFormats then
        begin
				  Font.Style  := FGrid.Font.Style;
				  Font.Color  := FGrid.Font.Color;
				  if (aColumn.Color > 0) and
             (aColumn.Color <> clNone) then
					   Color := TColor(aColumn.Color)
				  else if aColumn.readonly then
					   Color := clSilver;
          Transparent := False;
        end
        else
        begin
          Font.Style := [];
          Font.Color := clBlack;
          Transparent := True;
        end;
				AutoSize    := False;
				AutoStretch := False;
				Height      :=  bnDetail.Height;
				Size.Left   := iLeft;
				Size.Width  := ColWidth(aColumn.Width);
        Top         := Trunc(Round((bnDetail.Height - Abs(Font.Height))/2)/2);
				if (aColumn.Color > 0) and
           (aColumn.Color <> clNone) then
					 Color := TColor(aColumn.Color)
				else if aColumn.readonly then
					 Color := clSilver;
				Caption := '';
        if (aColumn.WordWrap = wwOn) or
           ((aColumn.WordWrap = wwDefault) and (FGrid.WordWrap <> wwOff)) then
        begin
           WordWrap := True;
           AutoStretch := True;
        end
        else
           WordWrap := False;
		  end;         
		  aColumn.Data := aReportLabel;
      FControls.Add(aReportLabel);
    end;

    procedure AddRichText;
    begin
		  aReportRichText := TQRRichText.Create(qrGrid);
		  aReportRichText.Parent := bnDetail;
      aReportRichText.ParentRichEdit := RichEdit1;
		  with aReportRichText do
		  begin
				Name := 'Col' + IntToStr(i);
				Alignment   := TAlignment(aColumn.Alignment);
				Font.Style  := FGrid.Font.Style;
				Font.Color  := FGrid.Font.Color;
			 //	Font.Style  := aHeader.FontStyle;
				AutoSize    := False;
				AutoStretch := True;
				Height      :=  bnDetail.Height;
				Size.Left   := iLeft;
				Size.Top    := 0;
				Size.Width  := ColWidth(aColumn.Width);
				if aColumn.Color > 0 then
					 Color := TColor(aColumn.Color)
				else if aColumn.Readonly then
					 Color := clSilver;
				Caption := '';
		  end;
		  aColumn.Data := aReportRichText;
      FControls.Add(aReportRichText);
    end;

    procedure AddReportTotal;
    var aTotalLabel : TQRLabel;
        aReportTotal : TosReportTotal;
    begin
       aTotalLabel := TQRLabel.Create(qrGrid);
       aTotalLabel.Parent := bnSummary;
       with aTotalLabel do
       begin
          Name := 'Total' + IntToStr(i);
          Alignment  := TAlignment(aColumn.Alignment);
          Font.Style := [fsBold];
          Left  := iLeft;
          Size.Top   := 4;
          Size.Width := ColWidth(aColumn.Width);
          AutoSize := False;
          Caption := '';
          Frame.DrawTop := True;
       end;
       aReportTotal := TosReportTotal.Create;
       aReportTotal.FLabel := aTotalLabel;
       aReportTotal.FColumn := FGrid.DataColnr[i];
       aReportTotal.FDataType := 0;
       FTotalControls.Add(aReportTotal);
    end;

begin
  Initialize;
  // Create a TQRLabel for each column in the grid and position it
  // based upon same X locations in grid...
  iLeft := 2;
  FGrid := TtsGrid(aGrid);
  qrGrid.Font.Name := FGrid.Font.Name;
  qrGrid.Font.Size := FGrid.Font.Size;
  qrGrid.Page.Orientation := PrinterOrientation;
  qrGrid.ReportTitle := Title;

  ApplyCustomSettings;  

  qlPageLabel.Left := ReportWidth - 50;
  qsPageNo.Left := qlPageLabel.Left + qlPageLabel.Width + 4;
  qrReportTitle.Left := Round(bnPageHeader.Width/2) - Round(qrReportTitle.Width/2);
  if FGrid.HeadingOn then
     bnColumnHeader.Height := FGrid.HeadingHeight + 4
  else
     bnColumnHeader.Height := 0;

  // Now determine the height of the detail row based upon the Lines Per Page...
  iDataHeight := qrGrid.Height - bnPageHeader.Height - bnColumnHeader.Height  - Round(qrGrid.Page.TopMargin) - Round(qrGrid.Page.BottomMargin);
  if (FGrid.PrintLinesPerPage > 0) then
     FDetailHeight := Round(iDataHeight / FGrid.PrintLinesPerPage)
  else
     FDetailHeight := Round(iDataHeight / 40);
  bnDetail.Height := FDetailHeight;
  FMaxCols := FGrid.Cols;
  if (FGrid.PrintCols > 0) and
     (FGrid.PrintCols < FGrid.Cols) then
     FMaxCols := FGrid.PrintCols;
  // Then compute HorzScale...
  ComputeHorzScale;
  FRowCount := 0;