qlrptbld.pas

详细的ERP设计资料

unit QLRptBld;

interface

uses Windows, SysUtils, Classes, QuickRpt, QRExtra, QRCtrls, DBGrids;

type
  TQLDBGridReportBuilder = class(TQRBuilder)
  private
    FDBGrid: TDBGrid;
    FAutoWidth: Boolean;
    FSummaryFields: TStrings;
    FAutoOrientation: Boolean;
    FHasRowLines: Boolean;
    FHasColLines: Boolean;
    FSubDetailAutoFit: Boolean;
    FSubDetailPrintFields: string;
    FPrintFields: string;
    FSubDetailDBGrid: TDBGrid;
    FSubDetailSummaryFields: TStrings;
    function GetReport: TCustomQuickRep;
    procedure SetReport(const Value: TCustomQuickRep);
    procedure SetDBGrid(const Value: TDBGrid);
  protected
    procedure SetActive(Value: Boolean); override;
    procedure Build;
    procedure BuildList(Grid: TDBGrid; AutoFit: Boolean; ColumnHeaderBand, DetailBand,
      SummaryBand: TQRCustomBand; FieldList: TList; SummaryFields: TStrings); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property AutoFit: Boolean read FAutoWidth write FAutoWidth;
    property SubDetailAutoFit: Boolean read FSubDetailAutoFit write FSubDetailAutoFit;
    property SubDetailDBGrid: TDBGrid read FSubDetailDBGrid write FSubDetailDBGrid;
    property SubDetailPrintFields: string read FSubDetailPrintFields write FSubDetailPrintFields;
    property SubDetailSummaryFields: TStrings read FSubDetailSummaryFields;
  published
    property Active;
    property AutoWidth: Boolean read FAutoWidth write FAutoWidth;
    property AutoOrientation: Boolean read FAutoOrientation write FAutoOrientation;
    property DBGrid: TDBGrid read FDBGrid write SetDBGrid;
    property HasColLines: Boolean read FHasColLines write FHasColLines;
    property HasRowLines: Boolean read FHasRowLines write FHasRowLines;
    property Report: TCustomQuickRep read GetReport write SetReport;
    property PrintFields: string read FPrintFields write FPrintFields;
    property SummaryFields: TStrings read FSummaryFields;
    property Font;
    property Orientation;
    property Title;
  end;

implementation

uses StrUtils, Printers, Graphics, DB, Controls, TypInfo, Dialogs{$IFDEF DEBUG}, DbugIntf{$ENDIF};

type
  THackDBGrid = class(TDBGrid);

  TQRDBText = class(TQRCustomLabel)
  private
//    ComboBox : TEdit;
    Field : TField;
    FieldNo : integer;
    FieldOK : boolean;
    DataSourceName : string[30];
    FDataSet : TDataSet;
    FDataField : string;
    FMask : string;
    IsMemo : boolean;
    procedure SetDataSet(Value : TDataSet);
    procedure SetDataField(Value : string);
    procedure SetMask(Value : string);
  protected
//    function GetCaptionBased : boolean; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Prepare; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure Unprepare; override;
  public
    constructor Create(AOwner : TComponent); override;
{.$ifdef ver110}
    function UseRightToLeftAlignment: boolean; override;
{.$endif}
  published
    property Alignment;
    property AlignToBand;
    property AutoSize;
    property AutoStretch;
{.$ifdef ver110}
    property BiDiMode;
    property ParentBiDiMode;
{.$endif}
    property Color;
    property DataSet : TDataSet read FDataSet write SetDataSet;
    property DataField : string read FDataField write SetDataField;
    property Font;
    property Mask : string read FMask write SetMask;
    property OnPrint;
    property ParentFont;
    property Transparent;
    property WordWrap;
  end;

function OkToChangeFieldAlignment(AField: TField; Alignment: TAlignment): Boolean;
begin
  { dont change the alignment for these fields:
    ftSmallInt     ftInteger      ftWord         ftFloat        ftCurrency
    ftBCD          ftDate         ftTime         ftDateTime     ftAutoInc }
  if Assigned(AField) then with AField do
    Result := (DataType < ftSmallInt) or
              (DataType = ftBoolean) or
              ((DataType > ftDateTime) and (DataType <> ftAutoInc))
  else
    Result := Alignment <> taCenter;
end;


function QRDBUseRightToLeftAlignment(AControl: TControl; AField: TField): Boolean;
var
  AAlignment: TAlignment;
begin
  if Assigned(AField) then
    AAlignment := AField.Alignment
  else
    AAlignment := taLeftJustify;
  { Calling AControl.UseRightToLeftAlignment cause an endless recursion }
  Result := (AControl.BiDiMode = bdRightToLeft) and
    (OkToChangeFieldAlignment(AField, AAlignment));
end;

constructor TQRDBText.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  DataSourceName := '';
//  ComboBox := nil;
  IsMemo := false;
end;

procedure TQRDBText.SetDataSet(Value : TDataSet);
begin
  FDataSet := Value;
  if Value <> nil then
    Value.FreeNotification(self);
end;

//function TQRDBText.GetCaptionBased : boolean;
//begin
//  Result := not IsMemo;
//end;

procedure TQRDBText.SetDataField(Value : string);
begin
  FDataField := Value;
  Caption := Value;
end;

procedure TQRDBText.Loaded;
var
  aComponent : TComponent;
begin
  inherited Loaded;
  if DataSourceName<>'' then
  begin
    aComponent := Owner.FindComponent(DataSourceName);
    if (aComponent <> nil) and (aComponent is TDataSource) then
      DataSet:=TDataSource(aComponent).DataSet;
  end;
end;

procedure TQRDBText.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
    if AComponent = FDataSet then
      FDataSet := nil;
end;

procedure TQRDBText.SetMask(Value : string);
begin
  FMask := Value;
end;

procedure TQRDBText.Prepare;
begin
  inherited Prepare;
  if assigned(FDataSet) then
  begin
    Field := FDataSet.FindField(FDataField);
    if Field <> nil then
    begin
      FieldNo := Field.Index;
      FieldOK := true;
      if (Field is TMemoField) or (Field is TBlobField) then
      begin
        Caption := '';
        IsMemo := true;
      end
        else IsMemo := false;
    end;
  end else
  begin
    Field := nil;
    FieldOK := false;
  end;
end;

procedure TQRDBText.Print(OfsX, OfsY : integer);
begin
  if IsEnabled then
  begin
    if FieldOK then
    begin
      if FDataSet.DefaultFields then;
//        Field := FDataSet.Fields[FieldNo];
    end
    else
      Field := nil;
    if assigned(Field) then
    begin
      try
        if (Field is TMemoField) or
           (Field is TBlobField) then
        begin
          Lines.Text := TMemoField(Field).AsString;
        end else
          if (Mask = '') or (Field is TStringField) then
            if not (Field is TBlobField) then
              Caption := Field.DisplayText
            else
              Caption := Field.AsString
          else
          begin
            if (Field is TIntegerField) or
               (Field is TSmallIntField) or
               (Field is TWordField) then
               Caption := FormatFloat(Mask, TIntegerField(Field).Value * 1.0)
            else
              if (Field is TFloatField) or
                 (Field is TCurrencyField) or
                 (Field is TBCDField) then
                 Caption := FormatFloat(Mask,TFloatField(Field).Value)
              else
                if (Field is TDateTimeField) or
                   (Field is TDateField) or
                   (Field is TTimeField) then
                  Caption := FormatDateTime(Mask,TDateTimeField(Field).Value);
          end;
      except
        Caption := '';
      end;
    end else
      Caption := '';
//    DoneFormat := false;
    inherited Print(OfsX,OfsY);
  end;
end;

procedure TQRDBText.Unprepare;
begin
  Field := nil;
  inherited Unprepare;
  if DataField <> '' then
    SetDataField(DataField) { Reset component caption }
  else
    SetDataField(Name);
end;

{.$ifdef ver110}
function TQRDBText.UseRightToLeftAlignment: Boolean;
begin
  Result := QRDBUseRightToLeftAlignment(Self, Field);
end;
{.$endif}

{ TQDBGridBuilder }

procedure TQLDBGridReportBuilder.SetActive(Value: Boolean);
begin
  if Value <> Active then begin
    if Value then
    begin
      inherited SetActive(True);
      Report.FreeNotification(Self);
      Build;
    end
    else begin
      // 如果 Report = nil 的话，调用 inherited SetActive(False) 会引起异常
      if Report = nil then Report := TCustomQuickRep.Create(Self);
      inherited SetActive(False);
    end;
  end;
end;

procedure TQLDBGridReportBuilder.Build;
var
  FieldList: TList;
  SubDetail: TQRSubDetail;
  I: Integer;
  S: string;
begin
  FieldList := TList.Create;
  try
    if FDBGrid <> nil then
    begin
      TQuickRep(Report).DataSet := FDBGrid.DataSource.DataSet;
      Report.Bands.HasColumnHeader := True;
      Report.Bands.HasDetail := True;
      if (FSummaryFields.Count > 0) and not Report.Bands.HasSummary then
        Report.Bands.HasSummary := True;
    //  AHeight := Round(Report.Bands.DetailBand.Height / 1.5);
      if FPrintFields = '' then
      begin
        for I := 0 to FDBGrid.Columns.Count - 1 do
          if S = '' then S := FDBGrid.Columns[I].FieldName
          else S := S + '; ' + FDBGrid.Columns[I].FieldName;
        FDBGrid.DataSource.DataSet.GetFieldList(FieldList, S);
      end
      else FDBGrid.DataSource.DataSet.GetFieldList(FieldList, FPrintFields);
      BuildList(FDBGrid, FAutoWidth, Report.Bands.ColumnHeaderBand, Report.Bands.DetailBand,
        Report.Bands.SummaryBand, FieldList, FSummaryFields);
    end;
    if FSubDetailDBGrid <> nil then
    begin
//      Report.Bands.DetailBand.HasChild := True;
      SubDetail := TQRSubDetail.Create(Report);
      SubDetail.Parent := Report;
      SubDetail.ParentReport := Report;
      SubDetail.Master := Report;
      SubDetail.DataSet := FSubDetailDBGrid.DataSource.DataSet;
      SubDetail.Bands.HasHeader := True;
//      SubDetail.HeaderBand := Report.Bands.DetailBand.ChildBand;
//      SubDetail.HasChild := True;
      if not SubDetail.Bands.HasFooter then
      begin
        SubDetail.Bands.HasFooter := True;
        SubDetail.FooterBand.Height := SubDetail.Height;
      end;
      if (FSubDetailSummaryFields.Count > 0) then
      begin
        SubDetail.FooterBand.HasChild := True;
//        SubDetail.FooterBand := SubDetail.ChildBand;
//        SubDetail.ChildBand.HasChild := True;
      end;
      if FSubDetailPrintFields = '' then
      begin
        for I := 0 to FSubDetailDBGrid.Columns.Count - 1 do
          if S = '' then S := FSubDetailDBGrid.Columns[I].FieldName
          else S := S + '; ' + FSubDetailDBGrid.Columns[I].FieldName;
        FSubDetailDBGrid.DataSource.DataSet.GetFieldList(FieldList, S);
      end
      else
        FSubDetailDBGrid.DataSource.DataSet.GetFieldList(FieldList, FSubDetailPrintFields);
      BuildList(FSubDetailDBGrid, FSubDetailAutoFit, SubDetail.HeaderBand,
        SubDetail, SubDetail.FooterBand, FieldList, FSubDetailSummaryFields);
    end;
  finally
    FieldList.Free;
  end;
//  RenameObjects;
end;


constructor TQLDBGridReportBuilder.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSummaryFields := TStringList.Create;
  FSubDetailSummaryFields := TStringList.Create;
  FAutoOrientation := True;
  FHasColLines := True;
  FHasRowLines := True;
end;

destructor TQLDBGridReportBuilder.Destroy;
begin
  FSummaryFields.Free;
  FSubDetailSummaryFields.Free;