rm_e_graphic.pas

中小企业管理系统------ ERP系统原代码

unit RM_e_Graphic;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls, RM_Class;

type

 { TRMGraphicExport }
  TRMGraphicExport = class(TRMExportFilter)
  private
    FFileNames: TStringList;
    FScaleX, FScaleY: Double;
    FPageVisible: Boolean;
    function GetFileCount: Integer;
  protected
    FFileExtension: string;
    FPageNo: Integer;
    FPageWidth, FPageHeight: Integer;
    procedure DrawbkPicture(aCanvas: TCanvas);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OnBeginDoc; override;
    procedure OnBeginPage; override;
    procedure OnEndPage; override;

    property FileNames: TStringList read FFileNames;
    property FileCount: Integer read GetFileCount;
  published
    property ScaleX: Double read FScaleX write FScaleX;
    property ScaleY: Double read FScaleY write FScaleY;
  end;

implementation

uses RM_CmpReg, RM_Utils;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMGraphicExport }

constructor TRMGraphicExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FScaleX := 1;
  FScaleY := 1;
  ShowDialog := True;
  FFileNames := TStringList.Create;
end;

destructor TRMGraphicExport.Destroy;
begin
  RMUnRegisterExportFilter(Self);
  FFileNames.Free;
  inherited Destroy;
end;

function TRMGraphicExport.GetFileCount: Integer;
begin
  Result := FFileNames.Count;
end;

procedure TRMGraphicExport.OnBeginDoc;
begin
  FPageNo := 0;
  FPageWidth := Round(CurReport.EMFPages[0].PrnInfo.Pgw * ScaleX);
  FPageHeight := Round(CurReport.EMFPages[0].PrnInfo.Pgh * ScaleY);
  FFileNames.Clear;
end;

procedure TRMGraphicExport.OnBeginPage;
var
  SaveFileName: string;
begin
  SaveFileName := FileName;
  if (FPageNo <> 0) then
  begin
    SaveFileName := ExtractFilePath(FileName) + RMMakeFileName(FileName, FFileExtension, FPageNo + 1);
    Stream := TFileStream.Create(SaveFileName, fmCreate);
  end;
  FFileNames.Add(SaveFileName);
  FPageVisible := CurReport.EMFPages[FPageNo].Visible;
  CurReport.EMFPages[FPageNo].Visible := True;
end;

procedure TRMGraphicExport.OnEndPage;
begin
  if FPageNo <> 0 then Stream.Free;
  CurReport.EMFPages[FPageNo].Visible := FPageVisible;
  Inc(FPageNo);
end;

procedure TRMGraphicExport.DrawbkPicture(aCanvas: TCanvas);
var
  lbkPic: TRMbkPicture;
  lPic: TPicture;
  r1: TRect;
begin
  lbkPic := CurReport.EMFPages.bkPictures[CurReport.EMFPages[FPageNo].bkPictureIndex];
  if lbkPic = nil then Exit;
  lPic := lbkPic.Picture;
  if lPic.Graphic <> nil then
  begin
    r1 := Rect(0, 0, Round(lPic.Width * FScaleX), Round(lPic.Height * FScaleY));
    OffsetRect(r1, Round(lbkPic.Left * FScaleX), Round(lbkPic.Top * FScaleY));
    RMPrintGraphic(aCanvas, r1, lPic.Graphic, False);
  end;
end;

end.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档