rm_formreport.pas

来自「report machine 2.3 功能强大」· PAS 代码 · 共 1,965 行 · 第 1/5 页

      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintDBGrid }
  TRMPrintDBGrid = class(TRMFormReportObject)
  private
    FDBGrid: TCustomDBGrid;
    procedure OnBeforePrintBandEvent(Band: TRMBand; var PrintBand: Boolean);
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

  { TRMPrintStringGrid }
  TRMPrintStringGrid = class(TRMFormReportObject)
  private
    FFormReport: TRMFormReport;
    FGrid: TCustomGrid;
    FUserDataset: TRMUserDataset;
    FList: TStringList;
    FCurrentRow: Integer;
    procedure OnUserDatasetCheckEOF(Sender: TObject; var Eof: Boolean);
    procedure OnUserDatasetFirst(Sender: TObject);
    procedure OnUserDatasetNext(Sender: TObject);
    procedure OnUserDatasetPrior(Sender: TObject);
    procedure OnReportBeginBand(Band: TRMBand);
    procedure SetMemos;
  public
    constructor CreateObject; override;
    destructor Destroy; override;
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

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

implementation

uses
  Math, RM_Rich, RM_Shape, RM_chbox, RM_Utils, RM_Const1
{$IFDEF InfoPower}
  , RM_wwrtf
{$ELSE}
{$IFDEF RX}
  , RM_rxrtf
{$ENDIF}
{$ENDIF};

var
  FFormReportList: TStringList;

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: TStringList;
begin
  if FFormReportList = nil then
    FFormReportList := TStringList.Create;
  Result := FFormReportList;
end;

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

procedure FreeFormReportList; // 释放资源
var
  i: Integer;
begin
  if FFormReportList = nil then Exit;
  for i := 0 to FFormReportList.Count - 1 do
    TRMAddInFormReportObjectInfo(FFormReportList[i]).Free;

  FFormReportList.Free; FFormReportList := nil;
end;

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

constructor TRMPageLayout.Create;
begin
  inherited Create;
  FPageSize := 9; // A4
  FPageWidth := 2100; FPageHeight := 2970;
  FPageOr := poPortrait;
  FColumns := 0;
  FColumnSpace := 0;
  FPrintToDefault := True;
  FPrinterName := RMLoadStr(SDefaultPrinter);
  FDoublePass := False;

  FLeftMargin := Round(RMConvertToPixels(100, rmsuMM));
  FTopMargin := Round(RMConvertToPixels(100, rmsuMM));
  FRightMargin := Round(RMConvertToPixels(100, rmsuMM));
  FBottomMargin := Round(RMConvertToPixels(100, rmsuMM));
end;

procedure TRMPageLayout.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  pgSize := TRMPageLayout(Source).pgSize;
  LeftMargin := TRMPageLayout(Source).LeftMargin;
  TopMargin := TRMPageLayout(Source).TopMargin;
  RightMargin := TRMPageLayout(Source).RightMargin;
  BottomMargin := TRMPageLayout(Source).BottomMargin;
  Columns := TRMPageLayout(Source).Columns;
  ColumnSpace := TRMPageLayout(Source).ColumnSpace;
  Height := TRMPageLayout(Source).Height;
  Width := TRMPageLayout(Source).Width;
  pgOr := TRMPageLayout(Source).pgOr;
  pgBin := TRMPageLayout(Source).pgBin;
  PrintToDefault := TRMPageLayout(Source).PrintToDefault;
  PrinterName := TRMPageLayout(Source).PrinterName;
  DoublePass := TRMPageLayout(Source).DoublePass;
end;

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

constructor TRMPageHeaderFooter.Create;
begin
  inherited Create;
  FCaption := TStringList.Create;
  FHeight := 20;
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
    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.Lines.Add(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;
  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;
end;

procedure TRMGridNumOptions.SetNumber(Value: Integer);
begin
  if Value >= 0 then
    FNumber := Value;
end;

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

constructor TRMScaleOptions.Create;
begin
  inherited Create;
  FCenterOnPageH := False;
  FCenterOnPageV := False;
  FFitPageWidth := False;
  FFitPageHeight := False;
  FScaleMode := rmsmAdjust;
  FScaleFactor := 100;
end;

procedure TRMScaleOptions.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  CenterOnPageH := TRMScaleOptions(Source).CenterOnPageH;
  CenterOnPageV := TRMScaleOptions(Source).CenterOnPageV;
  FitPageWidth := TRMScaleOptions(Source).FitPageWidth;
  FitPageHeight := TRMScaleOptions(Source).FitPageHeight;
  ScaleMode := TRMScaleOptions(Source).ScaleMode;
  ScaleFactor := TRMScaleOptions(Source).ScaleFactor
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMGroupItem}

constructor TRMGroupItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFormNewPage := False;
end;

procedure TRMGroupItem.Assign(Source: TPersistent);
begin
  if Source is TRMGroupItem then
  begin
  end
  else
    inherited Assign(Source);
end;

function TRMGroupItem.GetReport: TRMCustomGridReport;
begin
  if Assigned(Collection) and (Collection is TRMGroupItems) then
    Result := TRMGroupItems(Collection).Report
  else
    Result := nil;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMGroupItems}

constructor TRMGroupItems.Create(aReport: TRMCustomGridReport);
begin
  inherited Create(TRMGroupItem);
  FReport := aReport;
end;

function TRMGroupItems.Add: TRMGroupItem;
begin
  Result := TRMGroupItem(inherited Add);
end;

function TRMGroupItems.GetItem(Index: Integer): TRMGroupItem;
begin
  Result := TRMGroupItem(inherited GetItem(Index));
end;

procedure TRMGroupItems.SetItem(Index: Integer; Value: TRMGroupItem);
begin
  inherited SetItem(Index, Value);
end;

function TRMGroupItems.GetOwner: TPersistent;
begin
  Result := FReport;
end;

procedure TRMGroupItems.Update(Item: TCollectionItem);
begin
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMMasterDatalBandOptions}

constructor TRMMasterDataBandOptions.Create;
begin
  inherited Create;
  FLinesPerPage := 0;
  FColumns := 1;
  FColumnWidth := 200;
  FColumnGap := 20;
  FNewPageAfter := False;
end;

procedure TRMMasterDataBandOptions.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  LinesPerPage := TRMMasterDataBandOptions(Source).LinesPerPage;
  Columns := TRMMasterDataBandOptions(Source).Columns;
  ColumnWidth := TRMMasterDataBandOptions(Source).ColumnWidth;
  ColumnGap := TRMMasterDataBandOptions(Source).ColumnGap;
  FNewPageAfter := TRMMasterDataBandOptions(Source).NewPageAfter;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMMasterDatalBandOptions}

constructor TRMGridFontOptions.Create;
begin
  inherited Create;
  FUseMaualFont := False;
  FFont := TFont.Create;
end;

destructor TRMGridFontOptions.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TRMGridFontOptions.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  UseMaualFont := TRMGridFontOptions(Source).UseMaualFont;