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

📄 drawtest.pas

📁 wptools5 pro 完整源代码 Msword界面的文本编辑器源代码
💻 PAS
字号:
unit DrawTest;

interface

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

type
  TForm1 = class(TForm)
    WPRichText1: TWPRichText;
    Panel3: TPanel;
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    Bevel1: TBevel;
    PaintBox1: TPaintBox;
    ScrollBox1: TScrollBox;
    PaintBox2: TPaintBox;
    TabSheet3: TTabSheet;
    PaintBox3: TPaintBox;
    Change: TButton;
    procedure LoadFile(Sender: TObject);
    procedure PaintUsingDraw(Sender: TObject);
    procedure CreateLines(Sender: TObject);
    procedure PaintBox2Paint(Sender: TObject);
    procedure PaintBox3Paint(Sender: TObject);
    procedure ChangeClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    YOff : Integer;
    Foff, FZoom : Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.LoadFile(Sender: TObject);
begin
  WPRichText1.Load;
  WPRichText1.Header.SetPageWH(-1,-1,0,0,0,0);
  YOff := 0;
end;

procedure TForm1.CreateLines(Sender: TObject);
var i : Integer;
begin
 { WPRichText1.Header.LeftMargin := 0;
  WPRichText1.Header.TopMargin := 0;
  WPRichText1.Header.RightMargin := 0;
  WPRichText1.Header.BottomMargin := 0;    

  for i:=1 to 100 do
    WPRichText1.InputString(IntToStr(i)+#13);  }
end;

procedure TForm1.PaintUsingDraw(Sender: TObject);
var start_y : Integer;  res : Integer;
    px, py, ph : Integer;
begin
   start_y := 0;
   res := Screen.PixelsPerInch div 2;

   px := Bevel1.Left+1;
   py := Bevel1.Top;
   ph := Bevel1.Height;

   start_y := WPRichText1.Memo.Draw(PaintBox1.Canvas,
     px, py, ph,
     res,
     res,start_y, false);

   if start_y>0 then
   begin
     inc(px, Bevel1.Width div 2);
     WPRichText1.Memo.Draw(PaintBox1.Canvas,
     px, py, ph,
     res,
     res,start_y, false);
   end;   
end;

procedure TForm1.PaintBox2Paint(Sender: TObject);
var res : Integer;
begin
  res := Round(WPScreenPixelsPerInch * (
          PaintBox2.Width /
            MulDiv(WPRichText1.Header.PageWidth
             -WPRichText1.Header.LeftMargin-
             WPRichText1.Header.RightMargin,
                 WPScreenPixelsPerInch, 1440)));
  WPRichText1.Memo.Draw(PaintBox2.Canvas,
     0, 0, PaintBox2.Height,
     res,
     res,0, false);
end;

procedure TForm1.PaintBox3Paint(Sender: TObject);
var i, x, w, l : Integer;
begin
   if FZoom<>0 then
   begin
   w := MulDiv(WPRichText1.Header.PageWidth
     -WPRichText1.Header.LeftMargin
     -WPRichText1.Header.RightMargin
     + 360,
      WPScreenPixelsPerInch*FZoom, 1440*100);
   l := 0;
   x := 0;
   repeat
     l := WPRichText1.Draw(PaintBox3.Canvas,
      Rect(x,0, x+w, PaintBox3.Height),
      FZoom,l);
     inc(x,w);
   until (x>PaintBox3.Width) or (l <= 0);
   end;
end;

procedure TForm1.ChangeClick(Sender: TObject);
begin
  if Foff=0 then
  begin
     Foff  := -10;
     FZoom := 90;
  end;
  FZoom := FZoom + Foff;
  if (FZoom>300) or (FZoom<=10) then Foff := -Foff;
  PaintBox3.Invalidate;
  TabSheet3.DoubleBuffered := TRUE;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -