📄 wwrtfprintpreview.pas
字号:
unit wwrtfprintpreview;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, RichEdit, wwriched,
Menus, ImgList, Mask, wwdbedit, Wwdotdot, Wwdbcomb, Wwdbspin, wwcommon;
type
TwwRtfPreviewForm = class(TForm)
ToolBar1: TToolBar;
ScrollBox1: TScrollBox;
PaintBox1: TPaintBox;
PrintDialog: TPrintDialog;
RichEditButtonIcons: TImageList;
PopupMenu1: TPopupMenu;
N5001: TMenuItem;
N2001: TMenuItem;
N1501: TMenuItem;
N10001: TMenuItem;
N751: TMenuItem;
N501: TMenuItem;
N251: TMenuItem;
Auto1: TMenuItem;
zoomCombo: TwwDBComboBox;
ToolButton2: TToolButton;
ToolButton5: TToolButton;
Label1: TLabel;
wwDBSpinEdit1: TwwDBSpinEdit;
procedure PaintBox1Paint(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ScrollBox1Resize(Sender: TObject);
procedure wwDBSpinEdit1Change(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure zoomComboChange(Sender: TObject);
private
{ Private declarations }
FMetafile: TMetafile;
FRichedit: TwwCustomRichedit;
FPages : Array of richedit.TCharRange;
FPagerect: TRect;
FPrintRect: TRect;
FZoomFactor: double;
NumPages: integer;
Procedure PreparePreview( aRichedit: TwwCustomRichedit );
Procedure Paginate;
Procedure DrawPage( pagenum: Integer );
Function RenderPage( pagenum: Integer; render: BOOL = true ): Integer;
procedure VerifyPagenum(pagenum: Integer);
procedure PrintHeader(cv: TCanvas);
// function TwipsToPrinterPixels(Twips: integer): integer;
procedure UpdateZoom;
Procedure DrawScaled( Canvas: TCanvas; const outrect: TRect;
image: TGraphic; iwidth, iheight: Integer );
public
{ Public declarations }
Destructor Destroy; override;
constructor Create(AOwner: TComponent); override;
class procedure Preview( arichedit: TwwCustomRichedit );
end;
var
wwRtfPreviewForm: TwwRtfPreviewForm;
implementation
{$R *.dfm}
uses printers;
Type
TPageInfo = record
width, height: Integer; { physical width and height, in dots }
offsetX, offsetY: Integer;{ nonprintable margin, in dots }
resX, resY: Integer; { logical resolution, dots per inch }
End;
Procedure GetPageinfo( Var info: TPageInfo; index: Integer = -1 );
Begin
If index > -1 Then
Printer.PrinterIndex := index;
With Printer Do Begin
info.resX := GetDeviceCaps( handle, LOGPIXELSX );
info.resY := GetDeviceCaps( handle, LOGPIXELSY );
info.offsetX := GetDeviceCaps( handle, PHYSICALOFFSETX );
info.offsetY := GetDeviceCaps( handle, PHYSICALOFFSETY );
info.width := GetDeviceCaps( handle, PHYSICALWIDTH );
info.height := GetDeviceCaps( handle, PHYSICALHEIGHT );
End; { With }
End;
Procedure DotsToTwips( Var value: Integer; dpi: Integer );
Begin
value := MulDiv( value, 1440, dpi );
End;
{-- DrawScaled --------------------------------------------------------}
{: Draw an image scaled isotropically so it fits into the outrect
of the canvas.
@Param Canvas is the output device
@Param outrect is the available space on the device
@Param image is the graphic element to render
@Param iwidth is the elements width
@Param iheight is the elements height
@Precondition Canvas <> nil, passed width and height > 0
@Desc If the graphic is drawn scaled to fit the output area, while
preserving the aspect ratio. If a Nil graphic is passed we exit
without doing anything.
}{ Created 21.6.2001 by P. Below
-----------------------------------------------------------------------}
Procedure TwwRtfPreviewForm.DrawScaled( Canvas: TCanvas; const outrect: TRect;
image: TGraphic; iwidth, iheight: Integer );
Var
imageaspect, outputaspect: Double;
r: TRect;
outwidth, outheight: Integer;
Begin { DrawScaled }
Assert( Assigned( Canvas ), 'DrawScaled: no canvas');
Assert( iwidth > 0, 'DrawScaled: width cannot be negative' );
Assert( iheight > 0, 'DrawScaled: height cannot be negative' );
If not Assigned( image ) Then Exit;
outwidth := outrect.right - outrect.left;
outheight:= outrect.bottom - outrect.top;
imageaspect:= iwidth / iheight;
outputaspect := outwidth / outheight;
r:= Rect( 0,0,0,0);
If (imageaspect > outputaspect) Then Begin
r.right := outwidth;
r.Bottom := round( outwidth / imageaspect );
OffsetRect( r,
outrect.left, outrect.top);
// OffsetRect( r,
// outrect.left,
// outrect.top + ( outheight - r.bottom ) div 2
// );
End { If }
Else Begin
r.bottom := outheight;
r.right := Round( outheight * imageaspect );
OffsetRect( r,
outrect.left + ( outwidth - r.right ) div 2,
outrect.top
);
End; { Else }
// r.left:= r.left + 300;
Canvas.StretchDraw( r, image );
End; { DrawScaled }
destructor TwwRtfPreviewForm.Destroy;
begin
PaintBox1.OnPaint := nil;
Fmetafile.Free;
inherited;
end;
constructor TwwRtfPreviewForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FZoomFactor:= 1.0;
end;
Procedure TwwRtfPreviewForm.VerifyPagenum( pagenum: Integer );
Begin
If pagenum >= Length( FPages ) Then
SetLength( FPages, pagenum+32 );
End;
procedure TwwRtfPreviewForm.wwDBSpinEdit1Change(Sender: TObject);
begin
Drawpage(trunc(wwdbspinedit1.value-1));
end;
procedure TwwRtfPreviewForm.zoomComboChange(Sender: TObject);
begin
// if select then
begin
if (zoomcombo.value='500') then
FZoomFactor:= 5.0
else if (zoomcombo.value='200') then
FZoomFactor:= 2.0
else if (zoomcombo.value='100') then
FZoomFactor:= 1.0
else if (zoomcombo.value='75') then
FZoomFactor:= 0.75
else if (zoomcombo.value='50') then
FZoomFactor:= 0.5
else if (zoomCombo.value='FitWidth') then
FZoomFactor:= -1;
UpdateZoom;
end;
end;
procedure TwwRtfPreviewForm.DrawPage(pagenum: Integer);
Function VerifyPagination: Boolean;
Begin
Result := FPages[0].cpMax > Fpages[0].cpMin;
End;
begin
VerifyPagenum( pagenum );
If not VerifyPagination Then
Paginate;
RenderPage( pagenum );
FRichedit.Perform( EM_FORMATRANGE, 0, 0 );
PaintBox1.Invalidate;
end;
procedure TwwRtfPreviewForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_next then
wwdbspinedit1.Value:= wwdbspinedit1.value+1
else if key=vk_prior then
wwdbspinedit1.value:= wwdbspinedit1.value - 1
else if key=vk_up then
begin
scrollbox1.VertScrollBar.Position:= wwmax(1, scrollbox1.vertscrollbar.position - scrollbox1.vertscrollbar.increment);
// sysutils.abort;
key:= 0;
end
else if key=vk_down then begin
scrollbox1.VertScrollBar.Position:= wwmin(scrollbox1.VertScrollBar.range, scrollbox1.vertscrollbar.position + scrollbox1.vertscrollbar.increment);
// sysutils.abort;
key:= 0;
end;
end;
procedure TwwRtfPreviewForm.FormShow(Sender: TObject);
begin
zoomcombo.Items.Add('500%' + #9 + '500');
zoomcombo.Items.Add('200%' + #9 + '200');
zoomcombo.Items.Add('100%' + #9 + '100');
zoomcombo.Items.Add('75%' + #9 + '75');
zoomcombo.Items.Add('50%' + #9 + '50');
zoomcombo.Items.Add('Fit Width' + #9 + 'FitWidth');
zoomcombo.Items.Add('Whole Page' + #9 + 'WholePage');
zoomCombo.ItemIndex:= 5;
UpdateZoom;
scrollbox1.SetFocus;
{
zoomcombo.Items.AddObject('200%', '200');
zoomcombo.Items.AddObject('100%', '100');
zoomcombo.Items.AddObject('75%', '75');
zoomcombo.Items.AddObject('50%', '50');
zoomcombo.Items.AddObject('Fit Width', 'FitWidth');
zoomcombo.Items.AddObject('Fit Page', 'FitPage');
}
end;
procedure TwwRtfPreviewForm.Paginate;
var
info: TPageInfo;
pagenum, lastchar, len: Integer;
Procedure RectToTwips( Var rect: TRect );
Begin
DotsToTwips( rect.left, info.resX );
DotsToTwips( rect.right, info.resX );
DotsToTwips( rect.top, info.resY );
DotsToTwips( rect.bottom, info.resY );
End;
begin
GetPageinfo( info );
FPagerect := Rect( 0, 0, info.width, info.height );
RectToTwips( FPagerect );
FPrintrect := FRichedit.PageRect;
If IsRectEmpty( FprintRect ) Then Begin
// use a default output rect with 1 inch magin top and bottom
// and 1 inch right and left
// Fprintrect := FPagerect;
// InflateRect( FPrintrect, -1440, -1440 );
FPrintRect:= FRichEdit.GetPrinterRect;
End
Else
RectToTwips( FPrintrect );
pagenum := 0;
lastchar := 0;
len := FRichedit.GetTextLen;
Screen.Cursor := crHourglass;
//Scrollbar.Min := 0;
//Scrollbar.Max := 0;
Try
While lastchar < len Do Begin
VerifyPagenum( pagenum );
FPages[pagenum].cpMin := lastchar;
FPages[pagenum].cpMax := len;
lastchar := RenderPage( pagenum, false );
If lastchar <= FPages[pagenum].cpMin Then
lastchar := len
Else Begin
FPages[pagenum].cpMax := lastchar-1;
// Scrollbar.Max := pagenum;
Inc( pagenum );
End;
FRichEdit.TotalPages:= pagenum;
End;
Finally
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -