📄 rm_e_graphic.pas
字号:
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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -