rm_formreport.pas

这是一个功能强大

  TRMFormReportObject = class(TObject)
  private
    FAutoFree: Boolean;
  protected
  public
    constructor Create; virtual;
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); virtual; abstract;
    property AutoFree: Boolean read FAutoFree write FAutoFree;
  end;

  { TRMAddInFormReportObjectInfo }
  TRMAddInFormReportObjectInfo = class
  private
    FClassRef: TClass;
    FObjectClass: TClass;
  public
    constructor Create(AClassRef: TClass; AObjectClass: TClass);
    property ClassRef: TClass read FClassRef;
    property ObjectClass: TClass read FObjectClass;
  end;

  { TRMFormReport }
  TRMFormReport = class(TRMCustomFormReport)
  private
    FGridFixedCols: Integer;
    FDrawOnPageFooter: Boolean;
    FColumnHeaderViews, FPageDetailViews, FPageFooterViews: TList;
    FColumnFooterViews: TList;
    FGroupFooterViews: TList;
    FGridTop, FGridHeight: Integer;
    FPrintControl: TWinControl;
    FDetailPrintControl: TWinControl;
    FReportObjects: TList;
    FOnPrintObject: TRMOnPrintObjectEvent;
    FOnAfterCreateObject: TRMOnAfterCreateObjectEvent;
    FOnAfterCreateGridFieldObject: TRMOnAfterCreateGridObjectEvent;
    procedure Clear;
  protected
    CanSetDataSet: Boolean;

    function CreateReportFromGrid: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property ColumnHeaderViews: TList read FColumnHeaderViews;
    property PageDetailViews: TList read FPageDetailViews;
    property PageFooterViews: TList read FPageFooterViews;
    property ColumnFooterViews: TList read FColumnFooterViews;
    property GroupFooterViews: TList read FGroupFooterViews;
    property GridTop: Integer read FGridTop write FGridTop;
    property GridHeight: Integer read FGridHeight write FGridHeight;
    property DrawOnPageFooter: Boolean read FDrawOnPageFooter write FDrawOnPageFooter;

    property DetailPrintControl: TWinControl read FDetailPrintControl write FDetailPrintControl;
    property DetailDataSet;
  published
    property Groups;
    property PrintControl: TWinControl read FPrintControl write FPrintControl;
    property GridFixedCols: Integer read FGridFixedCols write FGridFixedCols default 0;
    property OnPrintObject: TRMOnPrintObjectEvent read FOnPrintObject write FOnPrintObject;
    property OnAfterCreateObject: TRMOnAfterCreateObjectEvent read FOnAfterCreateObject write FOnAfterCreateObject;
    property OnAfterCreateGridObjectEvent: TRMOnAfterCreateGridObjectEvent read FOnAfterCreateGridFieldObject write FOnAfterCreateGridFieldObject;
  end;

  { TRMPrintControl }
  TRMPrintControl = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintEdit }
  TRMPrintEdit = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintImage }
  TRMPrintImage = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintRichEdit }
  TRMPrintRichEdit = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintShape }
  TRMPrintShape = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintCheckBox }
  TRMPrintCheckBox = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintDateTimePicker }
  TRMPrintDateTimePicker = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
  end;

  { TRMPrintListView }
  TRMPrintListView = class(TRMFormReportObject)
  private
    FFormReport: TRMFormReport;
    FListView: TCustomListView;
    FUserDataset: TRMUserDataset;
    FList: TStringList;
    procedure OnUserDatasetCheckEOF(Sender: TObject; var Eof: Boolean);
    procedure OnUserDatasetFirst(Sender: TObject);
    procedure OnUserDatasetNext(Sender: TObject);
    procedure OnUserDatasetPrior(Sender: TObject);
    procedure SetMemos;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure OnGenerate_Object(aFormReport: TRMFormReport; aPage: TRMReportPage;
      aControl: TControl; var t: TRMView); override;
    procedure OnBeforePrintBandEvent(Band: TRMBand; var PrintBand: Boolean);
  public
  end;

function RMGetOneField(const str: string): string;
procedure RMRegisterFormReportControl(ClassRef, ObjectClass: TClass);

implementation

uses
  Math, RM_RichEdit, RM_Utils, RM_Const1, RM_PageSetup, RM_CheckBox, RM_EditorHF;

type
  THackListView = class(TCustomListView)
  end;

  THackView = class(TRMReportView)
  end;

  THackReport = class(TRMReport)
  end;

var
  FFormReportList: TList;

  {$IFNDEF COMPILER4_UP}

function Max(Value1, Value2: Integer): Integer;
begin
  if Value1 > Value2 then
    Result := Value1
  else
    Result := Value2;
end;

function Min(Value1, Value2: Integer): Integer;
begin
  if Value1 > Value2 then
    Result := Value2
  else
    Result := Value1;
end;
{$ENDIF}

function RMGetOneField(const str: string): string;
var
  i: integer;
begin
  i := pos(';', str);
  if i > 0 then
    Result := Copy(str, 1, i - 1)
  else
    Result := str;
end;

function ListSortCompare(Item1, Item2: Pointer): Integer;
begin
  Result := TControl(Item1).Top - TControl(Item2).Top;
  if Result = 0 then
    Result := TControl(Item1).Left - TControl(Item2).Left;
end;

function RMFormReportList: TList;
begin
  if FFormReportList = nil then
    FFormReportList := TList.Create;
  Result := FFormReportList;
end;

procedure RMRegisterFormReportControl(ClassRef, ObjectClass: TClass); // 注册一个打印控件
var
  tmp: TRMAddInFormReportObjectInfo;
begin
  tmp := TRMAddInFormReportObjectInfo.Create(ClassRef, ObjectClass);
  RMFormReportList.Add(tmp);
end;

procedure FreeFormReportList; // 释放资源
begin
  if FFormReportList = nil then Exit;
  while FFormReportList.Count > 0 do
  begin
    TRMAddInFormReportObjectInfo(FFormReportList[0]).Free;
    FFormReportList.Delete(0);
  end;

  FFormReportList.Free;
  FFormReportList := nil;
end;

{--------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------}
{ TRMPageLayout }

constructor TRMPageLayout.Create;
begin
  inherited Create;
  FPageSize := 9; // A4
  FPageWidth := 2100;
  FPageHeight := 2970;
  FPageOr := rmpoPortrait;
  FPrinterName := RMLoadStr(SDefaultPrinter);
  FDoublePass := False;
  FColumnCount := 1;
  FColumnGap := 0;

  FLeftMargin := Round(RMFromMMThousandths(10 * 1000, rmutScreenPixels));
  FTopMargin := Round(RMFromMMThousandths(10 * 1000, rmutScreenPixels));
  FRightMargin := Round(RMFromMMThousandths(10 * 1000, rmutScreenPixels));
  FBottomMargin := Round(RMFromMMThousandths(10 * 1000, rmutScreenPixels));
end;

procedure TRMPageLayout.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  PageSize := TRMPageLayout(Source).PageSize;
  LeftMargin := TRMPageLayout(Source).LeftMargin;
  TopMargin := TRMPageLayout(Source).TopMargin;
  RightMargin := TRMPageLayout(Source).RightMargin;
  BottomMargin := TRMPageLayout(Source).BottomMargin;
  Height := TRMPageLayout(Source).Height;
  Width := TRMPageLayout(Source).Width;
  PageOrientation := TRMPageLayout(Source).PageOrientation;
  PageBin := TRMPageLayout(Source).PageBin;
  PrinterName := TRMPageLayout(Source).PrinterName;
  DoublePass := TRMPageLayout(Source).DoublePass;
  Title := TRMPageLayout(Source).Title;
  ColumnCount := TRMPageLayout(Source).ColumnCount;
  ColumnGap := TRMPageLayout(Source).ColumnGap;
end;

{--------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------}
{ TRMPageHeaderFooter }

constructor TRMPageHeaderFooter.Create;
begin
  inherited Create;
  FCaption := TStringList.Create;
  FHeight := 0;
end;

destructor TRMPageHeaderFooter.Destroy;
begin
  FCaption.Free;
  inherited Destroy;
end;

procedure TRMPageHeaderFooter.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  Caption := TRMPageHeaderFooter(Source).Caption;
  Height := TRMPageHeaderFooter(Source).Height;
end;

procedure TRMPageHeaderFooter.Clear;
begin
  FCaption.Clear;
end;

procedure TRMPageHeaderFooter.Add(const AStr: string; AFont: TFont; Align: TAlignment);
var
  RichEdit: TRichEdit;
  Stream: TMemoryStream;
  StringList: TStringList;

  function link2(s1, s2: string): string;
  var
    p: integer;
  begin
    if s1 = '' then
    begin
      Result := s2;
      Exit;
    end;

    p := LastDelimiter('}', s1);
    if p > 0 then
      s1 := copy(s1, 1, p - 1)
    else
      s1 := '{' + s1;
    p := Pos('{', s2);
    if p > 0 then
      Delete(s2, 1, p)
    else
      s2 := s2 + '}';
    Result := s1 + s2;
  end;

begin
  RichEdit := TRichEdit.Create(nil);
  Stream := TMemoryStream.Create;
  StringList := TStringList.Create;
  try
    RichEdit.Parent := RMDialogForm;
    RichEdit.SelStart := 1;
    RichEdit.SelText := AStr;
    RichEdit.SelectAll;

    RichEdit.SelAttributes.Style := AFont.Style;
    RichEdit.SelAttributes.Name := AFont.Name;
    RichEdit.SelAttributes.Size := AFont.Size;
    RichEdit.Paragraph.Alignment := Align;

    RichEdit.Lines.SaveToStream(Stream);
    Stream.Position := 0;
    StringList.LoadFromStream(Stream);

    FCaption.Text := Link2(FCaption.Text, StringList.Text);
  finally
    RichEdit.Free;
    Stream.Free;
    StringList.Free;
  end;
end;

procedure TRMPageHeaderFooter.LoadFromRichEdit(ARichEdit: TRichEdit);
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    ARichEdit.Lines.SaveToStream(Stream);
    Stream.Position := 0;
    TStrings(FCaption).LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TRMPageHeaderFooter.GetStrings(aStrings: TStrings);
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create('');
  try
    FCaption.SaveToStream(Stream);
    Stream.Position := 0;
    aStrings.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TRMPageHeaderFooter.SetHeight(Value: Integer);
begin
  if Value >= 0 then
    FHeight := Value;
end;

procedure TRMPageHeaderFooter.SetCaption(Value: TStrings);
begin
  FCaption.Assign(Value);
end;

{--------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------}
{TRMScaleOptions}

constructor TRMGridNumOptions.Create;
begin
  inherited Create;
  FText := 'No';
  FNumber := 7;
end;

procedure TRMGridNumOptions.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  Text := TRMGridNumOptions(Source).Text;
  Number := TRMGridNumOptions(Source).Number;