quickrpt.pas

delphi7报表打印控件源码 可以设计报表

    procedure CreateComposite;
    procedure SetPrinterValues;
  protected
    procedure CMPreviewClose(var Message : TCM_QRPreviewClose);
    procedure CMPrint(var Message : TCM_QRPrint);
    property Generating : boolean read FGenerating;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Prepare;
    // export
    procedure ExportToFilter(AFilter : TQRExportFilter);
    procedure PrinterSetup;
    procedure Preview;
    procedure Print;
    property Index : integer read FIndex;
    property Reports : TList read FReports write FReports;
  published
    property OnAddReports : TNotifyEvent read FOnAddReports write FOnAddReports;
    property OnFinished : TNotifyEvent read FOnFinished write FOnFinished;
    property Options : TQuickReportOptions read FOptions write FOptions;
    property PrinterSettings : TQRCompositePrinterSettings read FPrinterSettings write FPrinterSettings;
    property ReportTitle : string read FReportTitle write FReportTitle;
  end;

  procedure PerformSQLParamsUpdate(Query : TQuery; Environment : TQREvEnvironment);

  procedure SetQRHiColor;
  procedure SetQRLoColor;
  function UniqueName(AComponent : TComponent; Start : string) : string;


implementation

uses
  QRCtrls, CommDlg, QRPrnSu;

const
  cQRBandTypeName : array[rbTitle..rbChild] of string =
    (SqrTitle, SqrPageHeader, SqrDetail, SqrPageFooter,
     SqrSummary, SqrGroupHeader, SqrGroupFooter, SqrSubDetail,
     SqrColumnHeader, SqrOverlay, SqrChild);

  cQRBandComponentName : array[rbTitle..rbChild] of string =
    (SqrTitleBandName, SqrPageHeaderBandName, SqrDetailBandName, SqrPageFooterBandName,
     SqrSummaryBandName, SqrGroupHeaderBandName, SqrGroupFooterBandName, SqrSubDetailBandName,
     SqrColumnHeaderBandName, SqrOverlayBandName, SqrChildBandName);

{$R QUICKRPT.RES}

{ Misc. internal routines }

var
  GlobalCompositeFlag : boolean;
  cqrRulerMinorStyle : TPenStyle;
  cqrRulerMajorStyle : TPenStyle;
  cqrRulerMinorColor : TColor;
  cqrRulerMajorColor : TColor;
  cqrRulerFontName : string[30];
  cqrRulerFontColor : TColor;
  cqrRulerFontSize : integer;

  cqrMarginStyle : TPenStyle;
  cqrMarginColor : TColor;

  cqrBandFrameStyle : TPenStyle;
  cqrBandFrameColor : TColor;
  LocalMeasureInches : boolean;
  PageBroken : boolean;

function UniqueName(AComponent : TComponent; Start : string) : string;
var
  i : integer;
begin
  i := 1;
  while AComponent.FindComponent(Start + IntToStr(I)) <> nil do
    inc(i);
  result := Start + IntToStr(I);
end;

function DataSetOK(ADataSet : TDataSet) : boolean;
begin
  Result := (ADataSet <> nil) and
    ADataSet.Active;
end;

function CharWidth(Size : integer):extended;
begin
  result := 80 / Size / 2.54;
end;

function CharHeight(Size : integer):extended;
begin
  result := 145.3 / Size / 2.54;
end;

function SnapToUnit(Value : extended; aUnit : TQRUnit) : extended;
begin
  case aUnit of
    Characters : Result := round(Value);
    MM : Result := round(Value)
  else
    Result := round(Value * 40) / 40;
  end
end;

{ TQRCustomController }

constructor TQRCustomController.Create(AOwner : TComponent);
begin
  inherited Create(nil);
  OrgOwner := AOwner;
  PrintAfterList := TList.Create;
  PrintBeforeList := TList.Create;
  GroupList := TList.Create;
  Master := nil;
  FSelfCheck := self;
  PrintBefore := false;
  PrintIfEmpty := true;
  NotifyList := TList.Create;
end;

destructor TQRCustomController.Destroy;
begin
  PrintAfterList.Free;
  PrintBeforeList.Free;
  GroupList.Free;
  NotifyList.Free;
  inherited Destroy;
end;

procedure TQRCustomController.AddAfter(aController : TQRCustomController);
begin
  PrintAfterList.Add(aController);
end;

procedure TQRCustomController.AddBefore(aController : TQRCustomController);
begin
  PrintBeforeList.Add(aController);
end;

function TQRCustomController.CheckGroups : boolean;
var
  I, J : integer;
begin
  result := false;
  for I := 0 to GroupList.Count - 1 do
  begin
    TQRGroup(GroupList[I]).Check;
    if TQRGroup(GroupList[I]).Reprint then
    begin
      result := true;
      for J := I + 1 to GroupList.Count - 1 do
        with TQRGroup(GroupList[J]) do
        begin
          GroupValue := Evaluator.Value;
          Reprint := true;
          HasResult := true;
        end;
      exit;
    end
  end
end;

procedure TQRCustomController.NewPageCheckGroups;
var
  I, J : integer;
  Reprint : boolean;
begin
  for I := 0 to GroupList.Count - 1 do
    if TQRGroup(GroupList[I]).Reprint then
      Exit;
  for I := 0 to PrintBeforeList.Count - 1 do
    TQRCustomController(PrintBeforeList[I]).NewPageCheckGroups;
  Reprint := false;
  for I := 0 to GroupList.Count - 1 do
  begin
    TQRGroup(GroupList[I]).NewPageCheck;
    if TQRGroup(GroupList[I]).Reprint then
    begin
      Reprint := true;
      for J := I + 1 to GroupList.Count - 1 do
        with TQRGroup(GroupList[J]) do
        begin
          GroupValue := Evaluator.Value;
          Reprint := true;
          HasResult := true;
        end;
      break;
    end
  end;
  if Reprint then PrintGroupHeaders;
  for I := 0 to PrintAfterList.Count - 1 do
    TQRCustomController(PrintAfterList[I]).NewPageCheckGroups;
end;

procedure TQRCustomController.PrintGroupHeaders;
var
  I : integer;
begin
  for I := 0 to GroupList.Count - 1 do
    if TQRGroup(GroupList[I]).Reprint then
      TQRGroup(GroupList[I]).PrintGroupHeader;
end;

procedure TQRCustomController.PrintGroupFooters;
var
  I : integer;
begin
  for I := GroupList.Count - 1 downto 0 do
    if TQRGroup(GroupList[I]).Reprint then
      TQRGroup(GroupList[I]).PrintGroupFooter;
end;

procedure TQRCustomController.SetMaster(Value : TComponent);
begin
  if (Value <> TControl(Self)) and
    ((Value is TCustomQuickRep) or (Value is TQRCustomController) or (Value is TQRControllerBand)) then
  begin
    FMaster := Value;
{$ifdef win32}
    if Assigned(Value) then Value.FreeNotification(Self);
{$endif}
  end
end;

procedure TQRCustomController.SetPrintBefore(Value : boolean);
begin
   FPrintBefore := Value;
end;

procedure TQRCustomController.CheckLastGroupFooters;
var
  I : integer;
begin
  for I := 0 to GroupList.Count - 1 do
    TQRGroup(GroupList[I]).Reprint := not TQRGroup(GroupList[I]).Reprint;
end;

procedure TQRCustomController.RegisterBands;
begin

end;

procedure TQRCustomController.BuildTree;
var
  Controller : TQRCustomController;
  Group : TQRGroup;

  procedure BuildTreeFrom(Component: TComponent);
  var
    I : integer;
  begin
    if Component = nil then Exit;
    for I := 0 to Component.ComponentCount - 1 do
    begin
      if (Component.Components[I] is TQRCustomController) or
         (Component.Components[I] is TQRControllerBand) then
      begin
        if (Component.Components[I] is TQRControllerBand) then
          Controller := TQRControllerBand(Component.Components[I]).Controller
        else
          Controller := TQRCustomController(Component.Components[I]);
        if (Controller <> nil) and (TQRCustomController(Controller.Master) = SelfCheck) then
        begin
          Controller.ParentReport := ParentReport;
          if Controller.PrintBefore then
            AddBefore(Controller)
          else
            AddAfter(Controller);
          Controller.BuildTree;
        end
      end;
      if (Component.Components[I] is TQRGroup) then
      begin
        Group := TQRGroup(Component.Components[I]);
        if (Group.Master = SelfCheck) and not (csDestroying in Group.ComponentState) then
        begin
          GroupList.Add(Group);
          Group.ParentReport := ParentReport;
        end
      end
    end
  end;

begin
  if not (csDestroying in ComponentState) then
  begin
    PrintBeforeList.Clear;
    PrintAfterList.Clear;
    GroupList.Clear;
    if SelfCheck is TQRCustomController then
      BuildTreeFrom(TQRCustomController(SelfCheck).OrgOwner)
    else
      BuildTreeFrom(SelfCheck.Owner);
    BuildTreeFrom(SelfCheck);
    RegisterDatasets;
  end;
end;

procedure TQRCustomController.RegisterDatasets;
begin
end;

procedure TQRCustomController.PrintBeforeControllers;
var
  I : integer;
begin
  for I := 0 to PrintBeforeList.Count - 1 do
    TQRCustomController(PrintBeforeList[I]).Execute;
end;

procedure TQRCustomController.PrintAfterControllers;
var
  I : integer;
begin
  for I := 0 to PrintAfterList.Count - 1 do
    TQRCustomController(PrintAfterList[I]).Execute;
end;

procedure TQRCustomController.PrintEmptyController;
begin
  PrintBeforeControllers;
  PrintAfterControllers;
end;

procedure TQRCustomController.Prepare;
var
  I : integer;
begin
  NotifyList.Clear;
  for I := 0 to PrintBeforeList.Count - 1 do
    TQRCustomController(PrintBeforeList[I]).Prepare;
  for I := 0 to PrintAfterList.Count - 1 do
    TQRCustomController(PrintAfterList[I]).Prepare;
  for I := 0 to GroupList.Count - 1 do
    TQRGroup(GroupList[I]).Prepare;
  EvConstant := ParentReport.Functions.GetConstant(OrgOwner.Name);
end;

function TQRCustomController.LocalVarValue : TQREvResult;
begin
  Result.Kind := resError;
end;

procedure TQRCustomController.UpdateLocalVar;
begin
  ParentReport.Functions.SetConstant(EvConstant, LocalVarValue);
end;

procedure TQRCustomController.Unprepare;
var
  I : integer;
begin
  for I := 0 to PrintBeforeList.Count - 1 do
    TQRCustomController(PrintBeforeList[I]).Unprepare;
  for I := 0 to PrintAfterList.Count - 1 do
    TQRCustomController(PrintAfterList[I]).Unprepare;
  for I := 0 to GroupList.Count - 1 do
    TQRGroup(GroupList[I]).Unprepare;
end;

procedure TQRCustomController.Execute;
begin
  if PrintIfEmpty then
    PrintEmptyController;
end;

procedure TQRCustomController.AddNotifyClient(Value : TQRPrintable);