?? rpsystem.pas
字號:
if not Aborted then begin
if ReportDest in [rdPrinter,rdFile] then begin
if (ReportDest = rdPrinter) or DoNativeOutput then begin // Printer or Native output
PrintReport(StatusForm);
end else if Assigned(RenderObject) then begin // Rendered output
PrintRender(StatusForm);
end else begin // NDR output only
if Assigned(FOnOverrideStatus) then begin
FOnOverrideStatus(self,omFree,StatusForm);
end; { if }
end; { else }
end else if ReportDest = rdPreview then begin
PreviewReport(PreviewForm);
end; { else }
end; { if }
finally
if ReportStream <> nil then begin
ReportStream.Free;
end; { if }
if ((ReportDest = rdPreview) or (soUseFiler in SystemOptions) or
ForceMultiPrint) and
(SystemFiler.StreamMode = smTempFile) then begin { Erase temp file }
AssignFile(TempFile,SystemFiler.FileName);
try
Erase(TempFile);
except
end; { tryx }
end; { if }
end; { tryf }
end; { if }
end; { Execute }
procedure TRvSystem.SetRenderObject(const Value: TRPRender);
begin
FRenderObject := Value;
end;
procedure TRvSystem.InitRenderStream(var RenderStream: TStream);
begin
case SystemFiler.StreamMode of
smMemory: begin
RenderStream := TMemoryStream.Create;
with RenderStream as TMemoryStream do begin
SystemFiler.Stream.Position := 0;
LoadFromStream(SystemFiler.Stream);
end; { with }
end;
smFile,smTempFile: begin
RenderStream := TFileStream.Create(SystemFiler.Filename,fmOpenRead or
fmShareDenyWrite);
end;
smUser: begin
if SystemFiler.Stream = nil then begin
RaiseError(Trans('StreamMode is smUser but Stream is nil'));
end; { if }
RenderStream := SystemFiler.Stream;
RenderStream.Position := 0;
end;
end; { case }
RenderStream.Position := 0;
end;
procedure TRvSystem.PrintRender(var StatusForm: TForm);
var
NDRStream: TStream;
begin
//!!! Add calls to OnOverrideStatus similar to PrintReport
if Assigned(FOnOverrideStatus) and Assigned(StatusForm) then begin
FOnOverrideStatus(self,omFree,StatusForm);
end; { if }
NDRStream := nil;
try
InitRenderStream(NDRStream);
RenderObject.OutputFileName := OutputFileName;
RenderObject.Render(NDRStream);
finally
if SystemFiler.StreamMode <> smUser then begin
FreeAndNil(NDRStream);
end; { if }
end;
end;
{ class TSystemPrinter }
constructor TSystemPrinter.Create;
begin { Create }
inherited Create;
FCopies := 1;
FFirstPage := 1;
FLastPage := 9999;
FLineHeightMethod := lhmFont;
FLinesPerInch := 6;
FMarginBottom := 0.0;
FMarginLeft := 0.0;
FMarginRight := 0.0;
FMarginTop := 0.0;
FOrientation := poPortrait;
FScaleX := 100.0;
FScaleY := 100.0;
FStatusFormat := Trans('Printing page %p');
FStatusText := TStringList.Create;
FTabShade := 0;
FTextBKMode := bkTransparent;
FTitle := Trans('ReportPrinter Report');
FUnits := unInch;
FUnitsFactor := 1.0;
FCollate := false;
FDuplex := GlobalDevice.Duplex;
end; { Create }
destructor TSystemPrinter.Destroy;
begin { Destroy }
FreeAndNil(FStatusText);
inherited Destroy;
end; { Destroy }
procedure TSystemPrinter.SetStatusText(Value: TStrings);
begin { SetStatusText }
FStatusText.Assign(Value);
end; { SetStatusText }
procedure TSystemPrinter.SetTabShade(Value: integer);
begin { SetTabShade }
if Value >= 100 then begin
FTabShade := 100;
end else if Value <= 0 then begin
FTabShade := 0;
end else begin
FTabShade := Value;
end; { else }
end; { SetTabShade }
procedure TSystemPrinter.SetUnits(Value: TPrintUnits);
begin { SetUnits }
FUnits := Value;
case FUnits of
unInch: begin
FUnitsFactor := 1.0;
end;
unMM: begin
FUnitsFactor := 25.4;
end;
unCM: begin
FUnitsFactor := 2.54;
end;
unPoint: begin
FUnitsFactor := 72.0;
end;
unUser: begin
{ Don't change FUnitsFactor }
end;
end; { case }
end; { SetUnits }
procedure TSystemPrinter.SetUnitsFactor(Value: double);
var
R1: array [1..4] of double;
begin { SetUnitsFactor }
if Value > 0.0 then begin
FUnitsFactor := Value;
R1[1] := 1.0;
R1[2] := 25.4;
R1[3] := 2.54;
R1[4] := 72.0;
if (FUnitsFactor = R1[1]) then begin
FUnits := unInch;
end else if (FUnitsFactor = R1[2]) then begin
FUnits := unMM;
end else if (FUnitsFactor = R1[3]) then begin
FUnits := unCM;
end else if (FUnitsFactor = R1[4]) then begin
FUnits := unPoint;
end else begin
FUnits := unUser;
end; { else }
end; { if }
end; { SetUnitsFactor }
procedure TSystemPrinter.InitPrinter(BaseReport: TBaseReport);
begin { InitPrinter }
with BaseReport do begin
Copies := FCopies;
FirstPage := FFirstPage;
LastPage := FLastPage;
LineHeightMethod := FLineHeightMethod;
LinesPerInch := FLinesPerInch;
MarginBottom := FMarginBottom;
MarginLeft := FMarginLeft;
MarginRight := FMarginRight;
MarginTop := FMarginTop;
Orientation := FOrientation;
ScaleX := FScaleX;
ScaleY := FScaleY;
StatusFormat := FStatusFormat;
StatusText := FStatusText;
TabShade := FTabShade;
TextBKMode := FTextBKMode;
Title := FTitle;
Units := FUnits;
if FUnits = unUser then begin
UnitsFactor := FUnitsFactor;
end; { if }
if (RPDev = nil) or not RPDev.InvalidPrinter then begin
Collate := FCollate;
Duplex := FDuplex;
end; { if }
end; { with }
end; { InitPrinter }
{ class TSystemPreview }
constructor TSystemPreview.Create;
begin { Create }
inherited Create;
FFormWidth := 615;
FFormHeight := 450;
FFormState := wsNormal;
FGridHoriz := 0.0;
FGridPen := TPen.Create;
FGridVert := 0.0;
FMarginMethod := mmFixed;
FMarginPercent := 0.0;
FMonochrome := false;
FRulerType := rtNone;
FShadowDepth := 0;
FZoomFactor := 100.0;
FZoomInc := 10;
FPagesWide := 1;
FPagesHigh := 1;
FPageInc := 1;
end; { Create }
destructor TSystemPreview.Destroy;
begin { Destroy }
FreeAndNil(FGridPen);
inherited Destroy;
end; { Destroy }
procedure TSystemPreview.SetMonochrome(Value: boolean);
begin { SetMonochrome }
if (ShadowDepth > 0) and Value then begin { Warn programmer }
ShowMessage({Trans-}'Monochrome not allowed while shadows are in effect.'#13 +
{Trans-}'Change ShadowDepth to 0 first');
end else begin
FMonochrome := Value;
end; { else }
end; { SetMonochrome }
procedure TSystemPreview.SetShadowDepth(Value: integer);
begin { SetShadowDepth }
if (Value > 0) and Monochrome then begin { Warn programmer }
ShowMessage({Trans-}'Shadows not allowed while monochrome in effect.'#13 +
{Trans-}'Change Monochrome to false first');
end else begin
FShadowDepth := Value;
end; { else }
end; { SetShadowDepth }
procedure TSystemPreview.SetZoomFactor(Value: double);
begin { SetZoomFactor }
if Value < 10.0 then begin
FZoomFactor := 10.0;
end else if Value > 200.0 then begin
FZoomFactor := 200.0;
end else begin
FZoomFactor := Value;
end; { else }
end; { SetZoomFactor }
procedure TSystemPreview.InitPreview(RenderPreview: TRvRenderPreview);
begin { InitPreview }
with RenderPreview as TRvRenderPreview do begin
GridHoriz := FGridHoriz;
GridPen := FGridPen;
GridVert := FGridVert;
MarginMethod := FMarginMethod;
MarginPercent := FMarginPercent;
ShadowDepth := FShadowDepth; // Must be set before Monochrome
Monochrome := FMonochrome;
PagesWide := FPagesWide;
PagesHigh := FPagesHigh;
PageInc := FPageInc;
RulerType := FRulerType;
ZoomFactor := FZoomFactor;
ZoomInc := FZoomInc;
end; { with }
end; { InitPreview }
{ class TSystemFiler }
constructor TSystemFiler.Create;
begin { Create }
inherited Create;
FAccuracyMethod := amPositioning;
FFileName := '';
FStatusFormat := Trans('Generating page %p');
FStatusText := TStringList.Create;
FStreamMode := smMemory;
FStream := nil;
end; { Create }
destructor TSystemFiler.Destroy;
begin { Destroy }
FreeAndNil(FStatusText);
inherited Destroy;
end; { Destroy }
procedure TSystemFiler.SetStatusText(Value: TStrings);
begin { SetStatusText }
FStatusText.Assign(Value);
end; { SetStatusText }
procedure TSystemFiler.InitFiler(BaseReport: TBaseReport);
begin { InitFiler }
BaseReport.IgnoreRPTF := IgnoreRPTF;
if BaseReport is TRvNDRWriter then begin
with BaseReport as TRvNDRWriter do begin
AccuracyMethod := FAccuracyMethod;
FileName := FFileName;
StatusFormat := FStatusFormat;
StatusText := FStatusText;
if FStreamMode = smMemory then begin
StreamMode := smUser;
FStream := TMemoryStream.Create;
end else begin
StreamMode := FStreamMode;
end; { else }
Stream := FStream;
end; { with }
(*!!PORT!!
end else if BaseReport is TRvNDRPrinter then begin
With BaseReport as TRvNDRPrinter do begin
FileName := FFileName;
If FStreamMode = smMemory then begin
StreamMode := smUser;
end else begin
StreamMode := FStreamMode;
end; { else }
Stream := FStream;
end; { with }
*)
end; { else }
end; { InitFiler }
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -