qm_rconsole.pas

一个管理系统

{*******************************************************}
{                                                       }
{                   QReportMaker 2.0                    }
{              TQMReportConsole Component               }
{                                                       }
{            Copyright (c) 2003,2004 by Zwm.            }
{                                                       }
{*******************************************************}
                                   
unit QM_RConsole;

interface


uses
  Windows, SysUtils, Graphics, Classes, Forms, DB, QM_DCtrl, QM_RGrid;

type

  { TQMReportConsole }
  TQMReportConsole = class(TComponent)
  private
    FOnAfterPrint: TNotifyEvent;
    FOnBeforePrint: TNotifyEvent;
    FOnAfterPreview: TNotifyEvent;
    FOnBeforePreview: TNotifyEvent;
    FOnBeforeDraw: TNotifyEvent;
    FOptions: TQMOptions;
    FPage: TQMPage;
    FPageFooter: TQMBand;
    FPageHeader: TQMBand;
    FParameters: TQMParameters;
    FReportTitle: TQMTitle;
    FLogo: TQMLogo;
    FSection: String;
    FSummary: TQMBand;
    FTitle: TQMBand;
    FFont: TFont;
    FDocumentTitle: String;
    FColorMode: TQMColorMode;
    FBackColor: TColor;
    FLineColor: TColor;
    FPercent: Integer;
    FScale:Integer;
    
    FBGColor: TColor;
    FNeedName: Boolean;
    FQROwner: TComponent;
    FScaleHT, FScaleWL: Real;
    FLftMargin: Integer;
    FFrame: TQMFrame;
    procedure SetOptions(const Value: TQMOptions);
    procedure SetPage(const Value: TQMPage);
    procedure SetPageFooter(const Value: TQMBand);
    procedure SetPageHeader(const Value: TQMBand);
    procedure SetSummary(const Value: TQMBand);
    procedure SetReportTitle(const Value: TQMTitle);
    procedure SetTitle(const Value: TQMBand);
    procedure SetParameters(const Value: TQMParameters);
    procedure SetFont(const Value: TFont);
    procedure SetPercent(const Value: Integer);
    procedure SetScale(const Value: Integer);
    procedure SetLogo(const Value: TQMLogo);
    function GetDocumentTitle: String;
    procedure SetSection(const Value: String);
  protected
    procedure FormatReport(ReportWidth: Integer);
    procedure DrawReport; virtual;
    function GetRecordCount: Integer; virtual;
    property BGColor: TColor read FBGColor;
    property QROwner: TComponent read FQROwner;
    property NeedName: Boolean read FNeedName;
    property LftMargin: Integer read FLftMargin;
    property ScaleHT: real read FScaleHT;
    property ScaleWL: real read FScaleWL;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Preview; virtual;
    procedure Print; virtual;
    function PageSetup: Boolean;
    procedure DrawTo(QuickRep: TObject);
    procedure ReDraw;
    property RecordCount: Integer read GetRecordCount;
  published
    property Font: TFont read FFont write SetFont;
    property ColorMode: TQMColorMode read FColorMode write FColorMode default pmColor;
    property BackColor: TColor read FBackColor write FBackColor default clWhite;
    property LineColor: TColor read FLineColor write FLineColor default clBlack;
    property Section: String read FSection write SetSection;
    property Options: TQMOptions read FOptions write SetOptions;
    property Page: TQMPage read FPage write SetPage;
    property PageFooter: TQMBand read FPageFooter write SetPageFooter;
    property PageHeader: TQMBand read FPageHeader write SetPageHeader;
    property Summary: TQMBand read FSummary write SetSummary;
    property Title: TQMBand read FTitle write SetTitle;
    property ReportTitle: TQMTitle read FReportTitle write SetReportTitle;
    property Logo: TQMLogo read FLogo write SetLogo;
    property DocumentTitle: String read GetDocumentTitle write FDocumentTitle;
    property Parameters: TQMParameters read FParameters write SetParameters;
    property Percent: Integer read FPercent write SetPercent default 100;
    property Scale: Integer read FScale write SetScale default 100;
    property Frame: TQMFrame read FFrame write FFrame;
    property OnAfterPrint: TNotifyEvent read FOnAfterPrint write FOnAfterPrint;
    property OnAfterPreview: TNotifyEvent read FOnAfterPreview write FOnAfterPreview;
    property OnBeforePreview: TNotifyEvent read FOnBeforePreview write FOnBeforePreview;
    property OnBeforePrint: TNotifyEvent read FOnBeforePrint write FOnBeforePrint;
    property OnBeforeDraw: TNotifyEvent read FOnBeforeDraw write FOnBeforeDraw;
  end;

  { TQMDataReport }
  TQMDataReport = class(TQMReportConsole)
  private
    FGrid: TQMCustomGrid;
    FDataSet: TDataSet;
    FCurrentIndex: Integer;
    FDataRowCount: Integer;
    procedure SetDataSet(const Value: TDataSet);
    procedure SetGrid(const Value: TQMCustomGrid);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DrawQMGrid(HasDataSet: Boolean);
    function GetData(ACol: Integer): string; virtual;
    function GridType: TQMGridType; virtual;
    property CurrentIndex: Integer read FCurrentIndex write FCurrentIndex;
    property DataRowCount: Integer read FDataRowCount write FDataRowCount;
    procedure OnNeedData(Sender: TObject; var MoreData: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DataSet: TDataSet read FDataSet write SetDataSet;
  published
    property Grid: TQMCustomGrid read FGrid write SetGrid;
  end;

implementation

uses QRCtrls, QuickRpt, QRPrntr, QM_Prntr, QM_Prvfrm, QM_Utils, QM_QRFuns;

procedure QM_SpaceBand(Margin: Integer; Band: TQRBand);
var
  i:integer;
begin
  for i := 0 to Band.ControlCount - 1 do
    Band.Controls[i].Top := Band.Controls[i].Top + Margin;
  Band.Height := Band.Height + Margin;
end;

{ TQMReportConsole }

const
  rcTBMargin=5;
  rcLRMargin=3;
  rcLblSpace=3;

var
  R_HasPageCount: Boolean;

constructor TQMReportConsole.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont := TFont.Create;
  FBackColor := clWhite;
  FPage := TQMPage.Create;
  FPageFooter := TQMBand.Create(FFont);
  FPageHeader := TQMBand.Create(FFont);
  FSummary := TQMBand.Create(FFont);
  FTitle := TQMBand.Create(FFont);
  FLogo := TQMLogo.Create;
  FReportTitle := TQMTitle.Create(FFont);
  FParameters := TQMParameters.Create(self, TQMParameter);
  FFrame := TQMFrame.Create;
  FPercent := 100;
  FScale := 100;
  FSection := ClassName + FormatDateTime('mmsszzz', time);
  Options := [rcFirstPageHeader, rcLastPageFooter, rcRepWidth];
end;

destructor TQMReportConsole.Destroy;
begin
  FPage.Free;
  FPageFooter.Free;
  FPageHeader.Free;
  FSummary.Free;
  FTitle.Free;
  FLogo.Free;
  FReportTitle.Free;
  FParameters.Free;
  FFont.Free;
  FFrame.Free;
  inherited Destroy;
end;

procedure TQMReportConsole.Preview;
var
  tmpFrm: TQMPreviewForm;
begin
  tmpFrm := TQMPreviewForm.Create(nil);
  try
    if not (csDesigning in ComponentState) then QM_LoadSetting(self);
    FNeedName := False;
    with tmpFrm do
    begin
      QM_QRep := TQuickRep.Create(tmpFrm);
      QM_QRep.OnPreview := QM_QRepOnPreview;
      QMReportConsole := self;
      QMQuickRep := QM_QRep;
      QM_ApplySetting(self);
      DrawReport();
      if Assigned(OnBeforePreview) then OnBeforePreview(self);
      if R_HasPageCount then QM_ChkPageCount();
      QM_QRep.PreviewModal;
      ShowModal;
      if Assigned(OnAfterPreview) then OnAfterPreview(self);
    end;
  finally
    tmpFrm.Free;
  end;
end;

procedure TQMReportConsole.Print;
var
  tmpRep: TQuickRep;
begin
  tmpRep := TQuickRep.Create(self.Owner);
  try
    if not (csDesigning in ComponentState) then QM_LoadSetting(self);
    FNeedName := False;
    QMQuickRep := tmpRep;
    QM_ApplySetting(self);
    DrawReport();
    if Assigned(OnBeforePrint) then OnBeforePrint(self);
    if R_HasPageCount then QM_ChkPageCount();
    tmpRep.Print;
    if Assigned(OnAfterPrint) then OnAfterPrint(self);
  finally
    tmpRep.Free;
  end; 
end;

procedure TQMReportConsole.SetOptions(const Value: TQMOptions);
begin
  FOptions := Value;
end;

procedure TQMReportConsole.SetPage(const Value: TQMPage);
begin
  FPage.Assign(Value);
end;

procedure TQMReportConsole.SetPageFooter(const Value: TQMBand);
begin
  FPageFooter.Assign(Value);
end;

procedure TQMReportConsole.SetPageHeader(const Value: TQMBand);
begin
  FPageHeader.Assign(Value);
end;

procedure TQMReportConsole.SetTitle(const Value: TQMBand);
begin
  FTitle.Assign(Value);
end;

procedure TQMReportConsole.SetSummary(const Value: TQMBand);
begin
  FSummary.Assign(Value);
end;

procedure TQMReportConsole.SetReportTitle(const Value: TQMTitle);
begin
  FReportTitle.Assign(Value);
end;

procedure TQMReportConsole.SetParameters(const Value: TQMParameters);
begin
  FParameters.Assign(Value);
end;

procedure TQMReportConsole.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TQMReportConsole.SetPercent(const Value: Integer);
begin
  FPercent := QM_GetIntValue(Value, 0, 100);
end;

procedure TQMReportConsole.SetScale(const Value: Integer);
begin
  FScale := QM_GetIntValue(Value, 10, 500);
end;

var
  R_PageWd, R_ReportWd: Integer;

procedure TQMReportConsole.FormatReport(ReportWidth: Integer);
var
  T_Real: Real;
  T_Val: Integer;
begin
  if QMQuickRep.Owner = nil then FQROwner := QMQuickRep
  else FQROwner := QMQuickRep.Owner;
  if ColorMode = pmBlack then FBGColor := clWhite
  else FBGColor := QM_PrintColor(self, BackColor);
  R_PageWd := QM_FindBand(rbTitle, BGColor).Width;
  QMQuickRep.Bands.HasTitle := False;
  if R_PageWd < 10 then R_PageWd := 10;
  if ReportWidth < 10 then R_ReportWd := R_PageWd
  else R_ReportWd := ReportWidth;
  FScaleWL := Scale/100;
  FScaleHT := FScaleWL;
  T_Val := Round(R_ReportWd * FScaleWL);
  T_Real := Round(R_PageWd/R_ReportWd * 100)/100;
  if rcFitToPageWidth in Options then
  begin
    if (rcAllowExtend in Options) or (T_Val > R_PageWd) then
      if rcScaleWhole in Options then
      begin
        FScaleWL := T_Real;
        FScaleHT := T_Real;
      end else
        FScaleWL := T_Real;
  end;
  FScaleHT := QM_GetFloatValue(FScaleHT, 0.1, 5);
  FScaleWL := QM_GetFloatValue(FScaleWL, 0.1, 5);
  if (rcCenter in Options) and (T_Val < R_PageWd)
    and ( not ((rcFitToPageWidth in Options) and (rcAllowExtend in Options))) then
    FLftMargin := (R_PageWd - T_Val) div 2 - 1
  else FLftMargin := 0;
end;

procedure TQMReportConsole.DrawReport;
var
  R_LblWd,R_TitleTop,R_LineTop,R_TtlHg,R_TitleHg,R_TitleMargin: Integer;
  R_QRBand: TQRBand;
  R_Font, R_RepFont: TFont;
  T_Cnt,T_Val,T_TextHg: Integer;

  function Max(Val1, Val2, Val3: Integer):Integer;
  begin
    Result := Val1;
    if Val2 > Result then Result := Val2;
    if Val3 > Result then Result := Val3;
  end;

  procedure DrawLine(Ltyp: TQMLineType; iTop: Integer);
  var
    C_QRShape: TQRShape;
  begin
    if ltyp=rltNone then exit;
    C_QRShape := TQRShape.Create(QROwner);
    C_QRShape.Parent := R_QRBand;
    with C_QRShape do
    begin
      Left := 0;
      Top := iTop;
      Width := R_LblWd + 5;
      if rcRepWidth in Options then
      begin
        Width := Round(Width * FScaleWL);
        Left := FLftMargin;
      end;
      if ltyp=rltSingle then
      begin
        Height := 1;
        Shape := qrsHorLine;
      end else
      begin
        Height := 3;
        Shape := qrsTopAndBottom;
      end;
      Pen.Color := QM_PrintColor(self, LineColor);
      if FNeedName then
        Name := QM_UniqueName(QROwner, 'QRShape');
    end;
  end;

  procedure DrawBand(sList: TStrings; iAlign,iTop: Integer; isStored: Boolean);
  var
    i,iType: Integer;
    cCaption: String;
    C_QRLabel: TQRLabel;
    C_QRExpr: TQRExpr;
  begin
    for i := 0 to sList.Count - 1 do
    begin
      if Trim(sList[i])='' then Continue;
      cCaption := sList[i];
      iType := QM_GetParaString(self, cCaption);
      if iType < 2 then
      begin
        C_QRLabel := TQRLabel.Create(QROwner);
        C_QRLabel.Parent := R_QRBand;
        with C_QRLabel do
        begin