rm_formreport.pas

进销存·完整的·有数据库的·非常完整·只得参考

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

 { TRMPrintEdit }
  TRMPrintEdit = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintImage }
  TRMPrintImage = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

  { TRMPrintRichEdit }
  TRMPrintRichEdit = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintShape }
  TRMPrintShape = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintCheckBox }
  TRMPrintCheckBox = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintDateTimePicker }
  TRMPrintDateTimePicker = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: 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; Page: TRMPage;
      Control: 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_Rich, RM_Utils, RM_Const1, RM_Pgopt, RM_Shape, RM_chbox
{$IFDEF InfoPower}
  , RM_wwrtf
{$ELSE}
{$IFDEF RX}
  , RM_rxrtf
{$ENDIF}
{$ENDIF};

var
  FFormReportList: TList;

{$IFNDEF Delphi4}

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 := poPortrait;
  FColumns := 0;
  FColumnSpace := 0;
  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;
  PrinterName := TRMPageLayout(Source).PrinterName;
  DoublePass := TRMPageLayout(Source).DoublePass;
  Title := TRMPageLayout(Source).Title;
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;
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;