unit1.pas

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

unit Unit1;

// Please enable 'ENABLEPDF' if you have wPDF
//         - you can download the demo at http://www.wpcubed.com
// Please do NOT install the wPDF WPTools support, this code
// uses the standard TWPDFPrinter!
{$DEFINE ENABLEPDF}

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    PageCount: TLabel;
    Label3: TLabel;
    Prev: TButton;
    Next: TButton;
    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    PageNumber: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    SavePageAsEMF: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure PrevClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PrintAndSavePageAsEMFClick(Sender: TObject);
    procedure SavePageAsEMFClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    WPRichText1: TWPRichText;
    procedure WPRichText1PaintWatermark(Sender: TObject;
      RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas;
      PageRect: TRect; PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject;
      XRes, YRes: Integer;
      FCurrentZoom: Single;
      PaintMode: TWPPaintModes);
  end;

var
  Form1: TForm1;

implementation

{$IFDEF ENABLEPDF}
// From WPDF - to create PDF files
uses WPPDFR1, WPPDFR2;
{$ENDIF}

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  WPRichText1.FormatOptions := [wpfAlwaysFormatWithScreenRes];
  WPRichText1.Load;
  WPRichText1.ReformatAll;
  PageCount.Caption := IntToStr(WPRichText1.CountPages);
  if WPRichText1.CountPages > 0 then
  begin
      // These values are calculated for the virtual desktop. Since we don't use
      // any zooming we can use them right away
    PaintBox1.Width := WPRichText1.Memo.PaintPageWidth[0] + 10;
    PaintBox1.Height := WPRichText1.Memo.PaintPageHeight[0] + 10;
  end;
  PageNumber.Caption := '1';
end;

procedure TForm1.PrevClick(Sender: TObject);
var i: Integer;
begin
  i := StrToInt(PageNumber.Caption);
  i := i + (Sender as TControl).Tag;
  if i < 0 then i := 0
  else if i > WPRichText1.CountPages then i := WPRichText1.CountPages;
  PageNumber.Caption := IntToStr(i);
  PaintBox1.Invalidate;
end;

// Zoom, simply change size of paintbox

procedure TForm1.Button2Click(Sender: TObject);
begin
  PaintBox1.Width := MulDiv(PaintBox1.Width, 12, 10);
  PaintBox1.Height := MulDiv(PaintBox1.Height, 12, 10);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  PaintBox1.Width := MulDiv(PaintBox1.Width, 8, 10);
  PaintBox1.Height := MulDiv(PaintBox1.Height, 8, 10);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  WPRichText1.Memo.PaintRTFPage(StrToInt(PageNumber.Caption) - 1,
    0, 0, PaintBox1.Width - 10, PaintBox1.Height - 10,
    PaintBox1.Canvas, []
    );
end;

// The PDF Creation Code requires wPDF
// uses WPRTEPaint, WPPDFR1, WPPDFR2;

procedure TForm1.Button4Click(Sender: TObject);
{$IFNDEF ENABLEPDF}
begin
  ShowMessage('This requires wPDF');
end;
{$ELSE}
var WPPDFPrinter1: TWPPDFPrinter;
  i, w, h: Integer;
begin
  WPPDFPrinter1 := TWPPDFPrinter.Create(nil);
  WPPDFPrinter1.FileName := 'c:\wptools5demo.pdf';
  WPPDFPrinter1.CompressStreamMethod := wpCompressFastFlate;
  WPPDFPrinter1.AutoLaunch := TRUE;

  WPPDFPrinter1.Info.Author := '';
  WPPDFPrinter1.Info.Producer := 'WPTools 5 - www.wpcubed.com';
  WPPDFPrinter1.Info.Date := Now;

  WPPDFPrinter1.BeginDoc;
  try
    i := 0;
    while i < WPRichText1.CountPages do
    begin
      w := WPRichText1.Memo.PaintPageWidth[i];
      h := WPRichText1.Memo.PaintPageHeight[i];
      WPPDFPrinter1.StartPage(w, h, Screen.PixelsPerInch, Screen.PixelsPerInch, 0);
      try
         // Use 0 as w and h to let the function calculate the width and height
         // WPRichText1.Memo.PaintRTFPage(i,0,0,0,0,WPPDFPrinter1.Canvas, [] );
        WPRichText1.PaintPageOnCanvas(i, 0, 0, 0, 0, WPPDFPrinter1.Canvas, []);
      finally
        WPPDFPrinter1.EndPage;
      end;
      inc(i);
    end;
  finally
    WPPDFPrinter1.EndDoc;
    WPPDFPrinter1.Free;
  end;
end;
{$ENDIF}

// In this demo we use a TPWRichText object which was create
// "on the fly" without any parent object !
// Of course you can put a TWPRichText on the form and make it small and
// set 'Visible' to false

procedure TForm1.FormCreate(Sender: TObject);
begin
  WPRichText1 := TWPRichText.Create(nil);
  WPRichText1.OnPaintWatermark := WPRichText1PaintWatermark;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  WPRichText1.Free;
end;

procedure TForm1.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;
  toCanvas.Pen.Color := clGray; // On screen
  r := PageRect;

  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);

  // 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;

// Print page and save image as metafile

procedure TForm1.PrintAndSavePageAsEMFClick(Sender: TObject);
var metafile: TMetafile;
  metacan: TMetafileCanvas;
  outRect: TRect;
begin
  printer.BeginDoc;
  metafile := TMetafile.Create;
  try
    metafile.MMWidth := MulDiv(GetDeviceCaps(Printer.Handle, PHYSICALWIDTH),
      2540, GetDeviceCaps(Printer.Handle, LOGPIXELSX));
    metafile.MMHeight := MulDiv(GetDeviceCaps(Printer.Handle, PHYSICALHeight),
      2540, GetDeviceCaps(Printer.Handle, LOGPIXELSY));
    metacan := TMetafileCanvas.Create(metafile,
      printer.Canvas.Handle);
    try
      WPRichText1.PaintPageOnCanvas(StrToInt(PageNumber.Caption) - 1,
        0, 0, 0, 0, metacan,
        [wppWhiteIsTransparent, wppOutputToPrinter],
        0, 0, -1, -1, []);
    finally
      metacan.Free;
    end;
    outRect.Left := -GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
    outRect.Top := -GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
    outRect.Right := outRect.Left + GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
    outRect.Bottom := outRect.Top + GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
    Printer.Canvas.StretchDraw(outRect, metafile);
    metafile.SaveToFile('c:\page.emf');
  finally
    metafile.Free;
  end;
  printer.EndDoc;
end;

procedure TForm1.SavePageAsEMFClick(Sender: TObject);
var metafile: TMetafile;
  metacan: TMetafileCanvas;
  outRect: TRect;
begin
  SaveDialog1.Title := 'Save page ' +
     PageNumber.Caption + ' as metafile';
  if SaveDialog1.Execute then
  begin
  metafile := TMetafile.Create;
  try
    metafile.Width  := MulDiv(WPRichText1.Header.PageWidth, WPScreenPixelsPerInch, 1440);
    metafile.Height := MulDiv(WPRichText1.Header.PageHeight, WPScreenPixelsPerInch, 1440);
    metacan := TMetafileCanvas.Create(metafile, 0);
    try
      WPRichText1.PaintPageOnCanvas(StrToInt(PageNumber.Caption) - 1,
        0, 0, 0, 0, metacan,
        [wppWhiteIsTransparent, wppOutputToPrinter],
        0, 0, -1, -1, []);
    finally
      metacan.Free;
    end;
    metafile.SaveToFile(SaveDialog1.FileName);
  finally
    metafile.Free;
  end;
  end;
end;

end.