qr2rmconv.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 509 行 · 第 1/2 页

unit QR2RMConv;

interface

{$I qr2rm.inc}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, QuickRpt, QRCtrls, QRPrntr, Printers, RM_Class, RM_Dataset, RM_Printer,
  RM_Common, DB,
{$IFDEF RM_Delphi6}
  DesignIntf, DesignEditors
{$ELSE}
  DsgnIntf
{$ENDIF};

type

	{ TQR2RMConv }
  TQR2RMConv = class(TComponent)
  private
    { Private declarations }
    FSource: TQuickRep;
    FTarget: TRMReport;
    procedure SetSource(Value: TQuickRep);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetBandAlignment(Control: TControl; v: TRMReportView);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Convert;
    property Target: TRMReport read FTarget;
  published
    property Source: TQuickRep read FSource write SetSource;
  end;

  { TQR2RMConvEditor }
  TQR2RMConvEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure Register;

implementation

uses Math, RM_RichEdit;

procedure Register;
begin
  RegisterComponents('ReportMachine Conver', [TQR2RMConv]);
  RegisterComponentEditor(TQR2RMConv, TQR2RMConvEditor);
end;

type
	THackQRLabel = class(TQRCustomLabel)
  end;

  THackReportView = class(TRMReportView)
  end;

function RMReplaceStr(const S, Srch, Replace: string): string;
var
  I: Integer;
  Source: string;
begin
  Source := S;
  Result := '';
  repeat
    I := Pos(Srch, Source);
    if I > 0 then
    begin
      Result := Result + Copy(Source, 1, I - 1) + Replace;
      Source := Copy(Source, I + Length(Srch), MaxInt);
    end
    else
      Result := Result + Source;
  until I <= 0;
end;

procedure AssignRich(Rich1, Rich2: TRichEdit);
var
  st: TMemoryStream;
begin
  st := TMemoryStream.Create;
  try
    with Rich2 do
    begin
      SelStart := 0;
      SelLength := Length(Text);
      SelAttributes.Protected := FALSE;
      Lines.SaveToStream(st);
    end;
    st.Position := 0;
    Rich1.Lines.LoadFromStream(st);
  finally
    st.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TQR2RMConv }
constructor TQR2RMConv.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if Assigned(AOwner) and (AOwner is TQuickRep) then
    FSource := TQuickRep(AOwner);
end;

destructor TQR2RMConv.Destroy;
begin
  inherited Destroy;
end;

procedure TQR2RMConv.SetSource(Value: TQuickRep);
begin
  FSource := Value;
end;

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

procedure TQR2RMConv.Convert;
var
  lBand: TRMView;
  v, bkView: TRMView;
  qrb: TQRBand;
  Control: TControl;
  i, j, maxdy: Integer;
  liPage: TRMReportPage;
  RMDBDataSet, RMDBSubDetailDataSet: TRMDBDataset;

  procedure SetFrame(Constrol: TControl);
  begin
  	maxdy := Max(maxdy, Control.Top + Control.Height);
    v.Name := Control.Name;
		if Control.Top < 0 then
	    v.SetspBounds(Control.Left + liPage.spMarginLeft, qrb.Top, Control.Width, Control.Height)    else
	    v.SetspBounds(Control.Left + liPage.spMarginLeft, Control.Top + qrb.Top, Control.Width, Control.Height);

    v.LeftFrame.Visible := TQRCustomLabel(Control).Frame.DrawLeft;
    v.LeftFrame.spWidth := TQRCustomLabel(Control).Frame.Width;
    v.LeftFrame.Style := TRMPenStyle(TQRCustomLabel(Control).Frame.Style);

    v.TopFrame.Visible := TQRCustomLabel(Control).Frame.DrawTop;
    v.TopFrame.spWidth := TQRCustomLabel(Control).Frame.Width;
    v.TopFrame.Style := TRMPenStyle(TQRCustomLabel(Control).Frame.Style);

    v.RightFrame.Visible := TQRCustomLabel(Control).Frame.DrawRight;
    v.RightFrame.spWidth := TQRCustomLabel(Control).Frame.Width;
    v.RightFrame.Style := TRMPenStyle(TQRCustomLabel(Control).Frame.Style);

    v.BottomFrame.Visible := TQRCustomLabel(Control).Frame.DrawBottom;
    v.BottomFrame.spWidth := TQRCustomLabel(Control).Frame.Width;
    v.BottomFrame.Style := TRMPenStyle(TQRCustomLabel(Control).Frame.Style);

    SetBandAlignment(Control, TRMReportView(v));
  end;

  procedure _CreateMemoView(Control: TControl);
  begin
    v := RMCreateObject(gtMemo, '');
    SetFrame(Control);

    case TQRCustomLabel(Control).Alignment of
      taLeftJustify: TRMMemoView(v).HAlign := rmhLeft;
      taRightJustify: TRMMemoView(v).HAlign := rmhRight;
      taCenter: TRMMemoView(v).HAlign := rmhCenter;
    end;

    TRMMemoView(v).Font := TQRCustomLabel(Control).Font;
		if not THackQRLabel(Control).Transparent then
	    v.FillColor := TQRCustomLabel(Control).Color;
    TRMMemoView(v).Visible := TQRCustomLabel(Control).Visible;
    TRMMemoView(v).Wordwrap := TQRCustomLabel(Control).WordWrap;
    TRMMemoView(v).Stretched := TQRCustomLabel(Control).AutoStretch;
    TRMMemoView(v).AutoWidth := TQRCustomLabel(Control).AutoSize;
  end;

  procedure CreateRMReport;
  var
    i: Integer;
    str: string;
  begin
    FTarget := TRMReport.Create(FSource.Owner);
    FTarget.ReportInfo.Title := FSource.ReportTitle;
    FTarget.ShowProgress := FSource.ShowProgress;
//    FTarget.PrintIfEmpty := FSource.PrintIfEmpty;
    FTarget.DefaultCopies := FSource.PrinterSettings.Copies;

    FTarget.Pages.Clear;
    liPage := FTarget.Pages.AddReportPage;
    FSource.Page.Units := MM;
    liPage.ChangePaper(rmpgCustom, Round(FSource.Page.Width * 10), Round(FSource.Page.Length * 10),
      liPage.PageBin, TRMPrinterOrientation(FSource.Page.Orientation));

    FSource.Page.Units := Pixels;
    liPage.spMarginLeft := Round(FSource.Page.LeftMargin);
    liPage.spMarginTop := Round(FSource.Page.TopMargin);
    liPage.spMarginRight := Round(FSource.Page.RightMargin);
    liPage.spMarginBottom := Round(FSource.Page.BottomMargin);

    RMDBDataSet := TRMDBDataset.Create(FSource.Owner);
    RMDBDataSet.DataSet := FSOurce.DataSet;
    i := 1;
    while True do
    begin
      str := 'RMDBDataset' + IntToStr(i);
      if FSource.Owner.FindComponent(str) = nil then
      begin
        RMDBDataset.Name := str;
        Break;
      end;
      Inc(i);
    end;

    FTarget.Dataset := RMDBDataSet;
  end;

  procedure CreateSubDetailDataSet;
  var
    i: Integer;
    str: string;
  begin
    RMDBSubDetailDataSet := TRMDBDataset.Create(FSource.Owner);
    RMDBSubDetailDataSet.DataSet := FSOurce.DataSet;
    i := 1;
    while True do
    begin
      str := 'RMDBDataset' + IntToStr(i);
      if FSource.Owner.FindComponent(str) = nil then
      begin
        RMDBSubDetailDataSet.Name := str;
        Break;
      end;
      Inc(i);
    end;
  end;

  procedure _SetSubDetailDataSet(ds: TDataSet);
  begin
		if (ds <> nil) and (ds <> RMDBDataSet.DataSet) then
    	RMDBSubDetailDataSet.DataSet := ds;
  end;