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

📄 textobjunit1.pas

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

interface

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

type
  TForm1 = class(TForm)
    WPRichText1: TWPRichText;
    Panel1: TPanel;
    MergeField: TButton;
    PageNumber: TButton;
    CustomObj: TButton;
    TxtObjText: TEdit;
    CustomMarker: TButton;
    InsertImage: TButton;
    Image1: TImage;
    PageNumberInHeader: TButton;
    Button1: TButton;
    procedure MergeFieldClick(Sender: TObject);
    procedure PageNumberClick(Sender: TObject);
    procedure CustomObjClick(Sender: TObject);
    procedure WPRichText1TextObjGetTextEx(RefCanvas: TCanvas;
      TXTObject: TWPTextObj; var PrintString: WideString; var WidthInPix,
      HeightInPix: Integer; var PaintObject: TWPTextObj; Xres,
      YRes: Integer);
    procedure TxtObjTextChange(Sender: TObject);
    procedure CustomMarkerClick(Sender: TObject);
    procedure WPRichText1TextObjectClick(Sender: TWPCustomRtfEdit;
      pobj: TWPTextObj; obj: TWPObject; var ignore: Boolean);
    procedure WPRichText1TextObjectMouseMove(Sender: TWPCustomRtfEdit;
      pobj: TWPTextObj; obj: TWPObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure InsertImageClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure OnPaintMarker(Sender : TWPTextObj;
    OutCanvas  : TCanvas;
    XRes, YRes : Integer;
    X, Y, W, H, BASE: Integer );
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MergeFieldClick(Sender: TObject);
begin
   WPRichText1.InputMergeField('NAME','Julian Ziersch');
end;

procedure TForm1.PageNumberClick(Sender: TObject);
var dropmarker : Integer;
begin
  if Sender=PageNumberInHeader then
  begin
      dropmarker := WPRichText1.TextCursor.DropMarker;
      WPRichText1.ActiveText := WPRichText1.HeaderFooter.Get
        (wpIsHeader, wpraOnAllPages, '');
      WPRichText1.ActiveText.Clear;
  end else dropmarker := 0;
  WPRichText1.InputString('Page ');
  WPRichText1.InputTextField(wpoPageNumber);
  WPRichText1.InputString(' of ');
  WPRichText1.InputTextField(wpoNumPages);
  if dropmarker<>0 then
  begin
      WPRichText1.InputString(#10);
      WPRichText1.TextObjects.InsertNewObject(wpobjHorizontalLine,false,false).Height := 4;
      WPRichText1.WorkOnText := wpBody;
      WPRichText1.TextCursor.GotoMarker(dropmarker);
  end;
  WPRichText1.SetFocus;
end;

// Custom Text field Object 

procedure TForm1.CustomObjClick(Sender: TObject);
begin
  WPRichText1.InputTextFieldName('CHANGEME');
end;

procedure TForm1.WPRichText1TextObjGetTextEx(RefCanvas: TCanvas;
  TXTObject: TWPTextObj; var PrintString: WideString; var WidthInPix,
  HeightInPix: Integer; var PaintObject: TWPTextObj; Xres, YRes: Integer);
begin
  if TXTObject.Name='CHANGEME' then
  begin
      PrintString := #32+ TxtObjText.Text + #32;
      RefCanvas.Font.Height := -Round(YRes/72*9); // 9 pt!
      RefCanvas.Font.Color := clRed;
      RefCanvas.Brush.Color := clYellow;
  end
  else if TXTObject.Name='MARKER' then
  begin
     WidthInPix := Xres div 5;
     TXTObject.OnPaint := OnPaintMarker; 
     // This line is required:
     PaintObject :=  TXTObject;
  end;
end;

procedure TForm1.TxtObjTextChange(Sender: TObject);
begin
  WPRichText1.ReformatAll(true,true); // Initialize!!
end;

// ---------- MARKER

procedure TForm1.CustomMarkerClick(Sender: TObject);
begin
  WPRichText1.InputTextFieldName('MARKER');
end;

procedure TForm1.OnPaintMarker(Sender : TWPTextObj;
    OutCanvas  : TCanvas;
    XRes, YRes : Integer;
    X, Y, W, H, BASE: Integer );
var o : Integer;
begin
      OutCanvas.Pen.Color := clBlack;
      OutCanvas.Brush.Color := clYellow;
      OutCanvas.RoundRect(x,y,x+w,y+h,XRes div 10, YRes div 10);
      OutCanvas.Pen.Color := clRed;
      o := XRes div 60;
      OutCanvas.Pen.Width := 0;
      OutCanvas.MoveTo(x + o*2, y + h div 2);
      OutCanvas.LineTo(x + w - o*3, y + h div 2);
      OutCanvas.MoveTo(x + w - o * 6, y + h div 2 - o * 3);
      OutCanvas.LineTo(x + w - o*3, y + h div 2);
      OutCanvas.LineTo(x + w - o * 6, y + h div 2 + o * 3);
end;

procedure TForm1.WPRichText1TextObjectClick(Sender: TWPCustomRtfEdit;
  pobj: TWPTextObj; obj: TWPObject; var ignore: Boolean);
begin
  if (pobj.ObjType=wpobjTextObject)
     and (pobj.Name='MARKER')
  then
  begin
     // locate next data record or similar ...
     ShowMessage('Object was clicked!' + #13 +
         pobj.AGetWPSS );
  end;
end;

procedure TForm1.WPRichText1TextObjectMouseMove(Sender: TWPCustomRtfEdit;
  pobj: TWPTextObj; obj: TWPObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (pobj.ObjType=wpobjTextObject)
//     and (pobj.Name='CHANGEME')
  then
  begin
     // locate next data record or similar ...
     // ShowMessage('Object "' + pobj.Name + '" was clicked!');
     Screen.Cursor := crHandPoint;
  end;
end;

// Insert an image

procedure TForm1.InsertImageClick(Sender: TObject);
begin
  WPRichText1.TextObjects.InsertCopy(Image1.Picture.Graphic);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WPRichText1.SelectionAsString :=
    '{\rtf{\*\field{\fldinst{MARKER}}{\fldrslt{params}}}}';   // If you need to set the text in 'params'
 // WPRichText1.SelectionAsString :=
 //   '{\rtf{\*\field\fldinst{MARKER sourcetext}}}';   // short form, sourcetext -> TextObj.Source

end;

end.

⌨️ 快捷键说明

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