⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wwrtfprintpreview.pas

📁 InfoPower_Studio 2007 v5.0.1.3 banben
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -