externalu.pas

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

unit ExternalU;

interface

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

type
  TWPExternalP = class(TForm)
    Panel1: TPanel;
    Label3: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    cbxZoomModes: TComboBox;
    ACount: TEdit;
    ALine: TEdit;
    UpdateBtn: TButton;
    ClearBtn: TButton;
    WPRichText1: TWPRichText;
    PrintBtn: TButton;
    PageCount: TLabel;
    procedure UpdateBtnClick(Sender: TObject);
    procedure WPRichText1PaintExternPage(Sender: TObject;
      RTFEngine: TWPRTFEnginePaint; prCanvas: TCanvas; xoff, yoff: Integer;
      r: TRect; PaintPageNr: Integer; ExternPageRef: TObject; DestXRes,
      DestYRes: Integer);
    procedure ClearBtnClick(Sender: TObject);
    procedure cbxZoomModesChange(Sender: TObject);
    procedure PrintBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  WPExternalP: TWPExternalP;

implementation

{$R *.dfm}

procedure TWPExternalP.UpdateBtnClick(Sender: TObject);
var s       : string;
    c,i     : Integer;
    x,y,th,h: Integer;
    pw, ph  : Integer;
    PageNr  : Integer;
    aPage   : TMetafile;
    aCanvas : TMetafileCanvas;
    procedure NewPage;
    begin
      if aPage = nil then
      begin
         aPage := TMetafile.Create;
         aPage.Width := pw;
         aPage.Height := ph;
      end;
      if aCanvas=nil then
      begin
        aCanvas := TMetafileCanvas.Create( aPage, 0);
        aCanvas.Font.Name := 'Arial';
        aCanvas.Font.Size := 11;
        h := ph - WPScreenPixelsPerInch;
        y := WPScreenPixelsPerInch div 2;
        th:= aCanvas.TextHeight('Ag');
        x := WPScreenPixelsPerInch div 2;
      end;

      PageCount.Caption := IntToStr(PageNr+1) + ' Extern Pages';
      PageCount.Update;
    end;
    procedure PostPage;
    var PageRef : TWPRTFExternPageRef;
    begin
      FreeAndNil(aCanvas);
      if aPage<>nil then
      begin
         // We add a page at a certain location. The data object we added
         // Is freed automatically unless we set in the
         // returned TWPRTFExternPageRef object the property DontFreeExternPage
         // to true
         PageRef := WPRichText1.Memo.ExternPageRefAdd(
             wpAsPageX,
             PageNr,
             0,
             aPage,
             nil
            );
         // This values are optional
         PageRef.PageWidth  := MulDiv( pw, 1440, WPScreenPixelsPerInch);
         PageRef.PageHeight := MulDiv( ph, 1440, WPScreenPixelsPerInch);


        inc(PageNr);
        aPage := nil;
      end;
    end;
begin
   c := StrToInt(ACount.Text);
   s := ALine.Text;
   aPage    := nil;
   aCanvas  := nil;
   PageNr   := 0;
   WPRichText1.Memo.ExternPageRefClear;

   // The page size for the external page in pixels
   pw := MulDiv( WPRichText1.Header.PageWidth, WPScreenPixelsPerInch, 1440);
   ph := MulDiv( WPRichText1.Header.PageHeight, WPScreenPixelsPerInch, 1440);

   // Try it: The external pages will be landscape!
   // ph := MulDiv( WPRichText1.Header.PageWidth, WPScreenPixelsPerInch, 1440);
   // pw := MulDiv( WPRichText1.Header.PageHeight, WPScreenPixelsPerInch, 1440);


   // Now create the lines
   for i:=1 to c do
   begin
      if y>h then PostPage;
      NewPage;
      aCanvas.TextOut(x,y,Format(s,[i,Random(1000000)]));
      inc(y,th);
   end;
   PostPage;

   WPRichText1.DelayedReformat;
end;

procedure TWPExternalP.WPRichText1PaintExternPage(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; prCanvas: TCanvas; xoff, yoff: Integer;
  r: TRect; PaintPageNr: Integer; ExternPageRef: TObject; DestXRes,
  DestYRes: Integer);
begin
  prCanvas.StretchDraw( r, ExternPageRef as TGraphic );
end;

procedure TWPExternalP.ClearBtnClick(Sender: TObject);
begin
  WPRichText1.Memo.ExternPageRefClear;
  WPRichText1.DelayedReformat;
end;

procedure TWPExternalP.cbxZoomModesChange(Sender: TObject);
var i, z : Integer;
begin
  z := StrToIntDef(cbxZoomModes.Text,-1);
  for i:=0 to cbxZoomModes.Items.Count-1 do
  begin
    if CompareText( cbxZoomModes.Items[i],cbxZoomModes.Text)=0 then
    begin
      case i of
         0 : z := 500;  // 500%
         1 : z := 200;  // 200%
         2 : z := 150;  // 150%
         3 : z := 100;  // 100%
         4 : z := 75;  // 75%
         5 : z := 50;  // 50%
         6 : z := 25;  // 25%
         7 : z := 10;  // 10%
         8 :  // Page Width
         begin
           WPRichText1.LayoutMode := wplayFullLayout;
           WPRichText1.AutoZoom := wpAutoZoomWidth;
           WPRichText1.Columns := 1;
         end;
         9 :   // Full Page
         begin
           WPRichText1.LayoutMode := wplayFullLayout;
           WPRichText1.AutoZoom := wpAutoZoomFullPage;
           WPRichText1.Columns := 1;
         end;
         10 :   // Two Pages
         begin
           WPRichText1.LayoutMode := wplayFullLayout;
           WPRichText1.AutoZoom := wpAutoZoomFullPage;
           WPRichText1.Columns := 2;
         end;
      end;

      break;
    end;
  end;
  if (z>0) and (z<=10) then
  begin
     WPRichText1.AutoZoom := wpAutoZoomFullPage;
     WPRichText1.LayoutMode := wpThumbNailView;
  end else
  if (z>0) and (z<=50) then
  begin
     WPRichText1.AutoZoom := wpAutoZoomAdjustColumnCount; // wpAutoZoomOff;
     WPRichText1.LayoutMode := wplayFullLayout;
     WPRichText1.Zooming := z;
  end else
  if z>0 then
  begin
     WPRichText1.LayoutMode := wplayFullLayout;
     WPRichText1.AutoZoom := wpAutoZoomOff;
     WPRichText1.Columns := 1;
     WPRichText1.Zooming := z;
  end;
  WPRichText1.PageNumber := WPRichText1.PageNumber;
  WPRichText1.Refresh;
  // ZoomValue.Caption := IntToStr(WPRichText1.CurrentZooming) + '%';
end;

procedure TWPExternalP.PrintBtnClick(Sender: TObject);
begin
   WPRichtext1.PrintDialog;
end;

procedure TWPExternalP.FormShow(Sender: TObject);
begin
 cbxZoomModesChange(nil);
end;

end.