custdrawu1.pas

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

unit CustDrawU1;

// demo for OnCustomLinePaintAfter and OnCustomLinePaintBefore events
// WPTools 5

interface

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

type
  TWPCustDraw = class(TForm)
    WPRichText1: TWPRichText;
    Panel1: TPanel;
    Flash: TCheckBox;
    Timer1: TTimer;
    HiglightNOW: TCheckBox;
    CreateBox: TCheckBox;
    HideControlPar: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure WPRichText1CustomLinePaintBefore(Sender: TObject;
      RTFEngine: TWPRTFEngineBasis; Param: TWPVirtPagePaintParam;
      EndOfPageRun: Boolean);
    procedure WPRichText1CustomLinePaintAfter(Sender: TObject;
      RTFEngine: TWPRTFEngineBasis; Param: TWPVirtPagePaintParam;
      EndOfPageRun: Boolean);
    procedure HideControlParClick(Sender: TObject);
    procedure WPRichText1BeforeInitializePar(Sender: TObject;
      RTFEngine: TWPRTFEngineBasis; RTFDataBlock: TWPRTFDataBlock;
      par: TParagraph);
  private
    { Private-Deklarationen }
  public
    flashpar: TParagraph;
    flashmode: Boolean;
    HasOpenBox : Boolean;
  end;

var
  WPCustDraw: TWPCustDraw;

implementation

{$R *.dfm}

procedure TWPCustDraw.Timer1Timer(Sender: TObject);
begin
  flashmode := not flashmode;
  if Flash.Checked then
  begin
    if flashpar = WPRichText1.ActiveParagraph then flashpar := nil
    else flashpar := WPRichText1.ActiveParagraph;
    WPRichText1.Repaint;
  end
  else if HiglightNOW.Checked then WPRichText1.Repaint
end;

procedure TWPCustDraw.WPRichText1CustomLinePaintBefore(Sender: TObject;
  RTFEngine: TWPRTFEngineBasis; Param: TWPVirtPagePaintParam;
  EndOfPageRun: Boolean);
begin
  if Flash.Checked and (Param.Par = flashpar) then
  begin
    Param.Canvas.Brush.Style := bsSolid;
    Param.Canvas.Brush.Color := clYellow;
    Param.Canvas.FillRect(Param.Rect);
  end;
end;

procedure TWPCustDraw.WPRichText1CustomLinePaintAfter(Sender: TObject;
  RTFEngine: TWPRTFEngineBasis; Param: TWPVirtPagePaintParam;
  EndOfPageRun: Boolean);
var r: TRect;
  par: TParagraph;
begin
  if EndOfPageRun then // at last ...
  begin
    r := Param.UnionRect;
    Param.Canvas.Brush.Style := bsClear;
    if CreateBox.Checked and
      (Param.Tag=2) then
    begin
      Param.Canvas.Pen.Width := Param.Page.XPixelsPerInch div 30;
      Param.Canvas.Pen.Color := clBlack;
      InflateRect(r, Param.Page.XPixelsPerInch div 30,
        Param.Page.XPixelsPerInch div 30);

      // We need to start on next page with a box!
      if not Param.Par.HasText('$end') then
         HasOpenBox  := TRUE;

    end
    else
    begin
      Param.Canvas.Pen.Width := 0;
      if flashmode then Param.Canvas.Pen.Color := clYellow
      else Param.Canvas.Pen.Color := clRed;
    end;
    Param.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
  end else
    if Param.Tag = 0 then // check each par only once!
    begin
      // This is need to for dynamic boxes to span multiple pages!
      if Param.PageNo=0 then HasOpenBox := FALSE;

      Param.Tag := 1;
      if HiglightNOW.Checked and
        not Param.Par.IsTable
        and Param.Par.HasText('NOW') then
      begin
        Param.CallAgainToClose := TRUE;
        Param.UseUntilIncludingPar := Param.Par.LastInnerChild;
      end else if CreateBox.Checked then
      begin
        par := Param.Par;
        if HasOpenBox or par.HasText('$start') then
        begin
          while (par <> nil) and not par.HasText('$end') do
            par := par.next;
          Param.Tag := 2; // we need to know that this is a dynamic box
          Param.UseUntilIncludingPar := par;
          if par <> nil then Param.CallAgainToClose := TRUE;
        end;
      end;
    end;
end;

procedure TWPCustDraw.HideControlParClick(Sender: TObject);
begin
   // forces the BeforeInitializePar to be executed!
   WPRichText1.ReformatAll(true,true);
end;

procedure TWPCustDraw.WPRichText1BeforeInitializePar(Sender: TObject;
  RTFEngine: TWPRTFEngineBasis; RTFDataBlock: TWPRTFDataBlock;
  par: TParagraph);
var b : Boolean;
begin
  b := paprHidden in par.prop;
  if HideControlPar.Checked and
        par.StartWith('$') then
          include(par.prop, paprHidden)
  else exclude(par.prop, paprHidden);
  // Ok, we need a reformat!
  if b<>(paprHidden in par.prop) then
      WPRichText1.DelayedReformat;
end;

end.