unit1.pas

wptools5 pro 完整源代码 Msword界面的文本编辑器源代码

unit Unit1;
// Modified for WPTools V5:

{ removed units:
    WPDefs, WPPrint, WpWinCtr, WPRich, WPEmOBJ, 
  added units
    WPRTEPaint, WPIO
  ------
  The ViewOption 'wpUseWatermark' is not used anymore.
  ------
  The event 'PaintPage' has been replaced by 'OnPaintWatermark' -
  Please see the modified code below



}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   WPTbar, ExtCtrls, WPUtil, WPPrvFrm,
  StdCtrls, Printers, WPCTRRich, WPRTEDefs, WPCTRMemo, WPIO, WPRTEPaint;

type
  TWaterM = class(TForm)
    WPRichText1: TWPRichText;
    WPToolBar1: TWPToolBar;
    Image1: TImage;
    Button1: TButton;
    WPPreviewDlg1: TWPPreviewDlg;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
  {  procedure WPRichText1PaintPage(Sender: TObject; toCanvas: TCanvas;
      PageRect: TRect; XRes, YRes, PageNo: Integer; firstpar: PTParagraph;
      firstline: PTLine; BufferObj: TWPPageBackgroundBuffer);  }
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure WPRichText1PaintWatermark(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas;
  PageRect: TRect; PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject;
  XRes, YRes: Integer;
  FCurrentZoom : Single;
  PaintMode: TWPPaintModes);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  WaterM: TWaterM;

implementation

{$R *.DFM}

procedure TWaterM.FormCreate(Sender: TObject);
begin
   WPRichText1.LayoutMode := wplayFullLayout;
  //WPRichText1.ViewOptions := [wpUseWatermark];
end;

{ OLD CODE FOR WPTOOLS VERSION 4
procedure TWaterM.WPRichText1PaintPage(Sender: TObject; toCanvas: TCanvas;
  PageRect: TRect; XRes, YRes, PageNo: Integer; firstpar: PTParagraph;
  firstline: PTLine; BufferObj: TWPPageBackgroundBuffer);
var r: TRect;
  offx, offy: Integer;
begin
  r := PageRect;
  if WPRichText1.PrintParameter.Printing then
  begin
    toCanvas.Pen.Color := clBlack; // on Printer !
       // Please note that if we print we need to respect the physical offset
       // This is calculated in the printer engine and provided as twips
    offx := MulDiv(WPRichText1.PrintParameter.PrintXOffset, XRes, 1440);
    offy := MulDiv(WPRichText1.PrintParameter.PrintYOffset, YRes, 1440);

       // Subtract the pysical offset since the printer is adding this anyway
    dec(r.Left, offx);
    dec(r.Top, offy);
    dec(r.Right, offx);
    dec(r.Bottom, offy);
  end
  else
  begin
    toCanvas.Pen.Color := clGray; // On screen
    r := PageRect;
  end;

  toCanvas.Brush.Style := bsClear;
  toCanvas.Pen.Style := psSolid;

  toCanvas.Rectangle(
    r.Left + XRes div 2,
    r.Top + YRes div 2,
    r.Right - XRes div 2,
    r.Bottom - YRes div 2);

  toCanvas.StretchDraw(
    Rect(r.Right - XRes * 2,
    r.Top + YRes div 4,
    r.Right - XRes div 2,
    r.Top + YRes div 2),
    Image1.Picture.Metafile)
end; }

// NEW CODE
procedure TWaterM.WPRichText1PaintWatermark(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas;
  PageRect: TRect; PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject;
  XRes, YRes: Integer;
  FCurrentZoom : Single;
  PaintMode: TWPPaintModes);
var r: TRect;
  offx, offy: Integer;
begin
  r := PageRect;
{ if WPRichText1.PrintParameter.Printing then
  begin
    toCanvas.Pen.Color := clBlack; // on Printer !
       // Please note that if we print we need to respect the physical offset
       // This is calculated in the printer engine and provided as twips
    offx := MulDiv(WPRichText1.PrintParameter.PrintXOffset, XRes, 1440);
    offy := MulDiv(WPRichText1.PrintParameter.PrintYOffset, YRes, 1440);

       // Subtract the pysical offset since the printer is adding this anyway
    dec(r.Left, offx);
    dec(r.Top, offy);
    dec(r.Right, offx);
    dec(r.Bottom, offy);
  end
  else }
  begin
    toCanvas.Pen.Color := clGray; // On screen
    r := PageRect;
  end;

  toCanvas.Brush.Style := bsClear;
  toCanvas.Pen.Style := psSolid;

  toCanvas.Rectangle(
    r.Left + XRes div 2,
    r.Top + YRes div 2,
    r.Right - XRes div 2,
    r.Bottom - YRes div 2);

  toCanvas.StretchDraw(
    Rect(r.Right - XRes * 2,
    r.Top + YRes div 4,
    r.Right - XRes div 2,
    r.Top + YRes div 2),
    Image1.Picture.Metafile);

  // We want a marker at 2,2 Inch
  toCanvas.Font.Height := XRes div 4;
  toCanvas.Font.Color := clRed;
  toCanvas.TextOut(r.Left + XRes*2,r.Top + YRes*2,'This is Pos 2,2 INCH');


end;

procedure TWaterM.Button1Click(Sender: TObject);
begin
  WPPreviewDlg1.Execute;
end;

procedure TWaterM.Button2Click(Sender: TObject);
var xoff, yoff, resx, resy, x, y, w, h: Integer;
begin
  Printer.BeginDoc;
  xoff := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  yoff := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
  resx := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  resy := GetDeviceCaps(Printer.Handle, LOGPIXELSY);

  w := Round(21 / 2.54 * resx); // DINA 4 Width
  h := Round(29.7 / 2.54 * resy); // DINA 4 Height

  // Print a cross in the center of the paper
  x := w div 2 - xoff;
  y := h div 2 - yoff;
  Printer.Canvas.MoveTo(0, y);
  Printer.Canvas.LineTo(w, y);
  Printer.Canvas.MoveTo(x, 0);
  Printer.Canvas.LineTo(x, h);

  Printer.Canvas.TextOut(resx - xoff, resy - yoff, 'TOP-LEFT (at 1,1 in)');
  Printer.EndDoc;
end;

procedure TWaterM.Button3Click(Sender: TObject);
var thumbnail: TBitmap;
  ratio: Single;
  pageno: Integer;
begin
  thumbnail := TBitmap.Create;
  try
    ratio := 50; // twips to pixel !
    pageno := 0;
    // The layout is the logical size, same as PageWidth(PageHeight but
    // swapped for landscape!
    thumbnail.Width := Round(WPRichText1.Header._Layout.paperw / ratio);
    thumbnail.Height := Round(WPRichText1.Header._Layout.paperh / ratio);
    WPRichText1.PrintPageOnCanvas(thumbnail.Canvas,
      thumbnail.Canvas.ClipRect,
      pageno,
      [ppmUseBorders, ppmStretchWidth,
      ppmStretchHeight, ppmIgnoreSelection, ppmUseEvents],
      0);  
    thumbnail.SaveToFile('c:\thumb.bmp');
  finally
    thumbnail.Free;
  end;
end;





end.