eds_wptools.pas

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

unit eds_wptools;
{ ------------------------------------------------------------------------------
  EDSPELL Suppoort for WPTools V4.x and WPTools 5.x
  ------------------------------------------------------------------------------
  Add this unit to your application which utilizes the word processor WPTools Version 4.
  The spellcheck actions installed by WPTools will then work automatically.
  No further installation code is required.

  The new WPTools version supports WYSIWYG page layout view, RTF reporting, optional export
  to PDF,  header and footer, manual hyphenation, tabstops, paragraph alignment etc etc.

  You can download and evaluate WPTools at: http://www.wptools.de/
  ------------------------------------------------------------------------------ }

interface

{$I WPINC.INC}

uses Classes, Sysutils, Windows, Forms, Controls, StdCtrls, Dialogs,
  WPBuff, AbsBuff, EDSSpell, SpellGbl, Menus
{$IFDEF WPTOOLS5}
  , WPCtrMemo, WPRTEPaint, WPRTEDefs
{$ELSE}
  , WPRich, WPWinCtr, WPDefs
{$ENDIF};

type
  TWPTSpellDlg = class(EDSSpell.TSpellDlg)
  public
    procedure InitBufferMgr(ForControl: TControl); override;
    function SpellCheck(AControl: TControl): integer; override;
  end;

var
  EDSDictionary: string;

implementation

uses Types;

procedure TWPTSpellDlg.InitBufferMgr(ForControl: TControl);
begin
  if ForControl is TWPCustomRtfEdit then
    BufferMgr := TWPBuf.Create(Self)
  else
    inherited InitBufferMgr(ForControl);
end;

function TWPTSpellDlg.SpellCheck(AControl: TControl): integer;
begin
{$IFDEF WPTOOLS5}
  with AControl as TWPCustomRtfEdit do
{$ELSE}
  with AControl as TWPCustomRichText do
{$ENDIF}
    if SpellCheckMode = scmCheckFromStart then
      Spell_FromStart
    else
      Spell_FromCursorPos;
  Result := inherited SpellCheck(AControl);
end;

type
  TWPEDSPopupMenu = class(TPopupMenu);

  TWPSpellCheckInterface = class(TObject)
  private
    FChanged, FIsOK: Boolean;
    FCheckedWord: string;
    FEdsSpell: TWPTSpellDlg;
    FSpellPopupMenu: TPopupMenu;
    {$IFDEF WPTOOLS5}
    FCurrEdit : TWPCustomRtfEdit;
    {$ENDIF}
    function GetEdsSpell: TWPTSpellDlg;
    function GetSpellPopupMenu: TPopupMenu;
  protected
{$IFDEF WPTOOLS5}
    procedure DoMouseDownRight(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer; par: TParagraph;
      posinpar: Integer; Pos: Integer; len: Integer; var text: string;
      var atr: Cardinal; var Abort: Boolean);
    procedure DoSpellCheckWord(Sender: TObject; var Word: WideString;
      var Res: TSpellCheckResult; var Hyphen: TSpellCheckHyphen;
      par: TParagraph; posinpar: Integer);
{$ELSE}
    procedure DoMouseDownRight(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
      pos: Longint; len: Integer; var text: string; var atr: TAttr);
    procedure DoSpellCheckWord(Sender: TObject; word: string; var res: TSpellCheckResult; var hypen: TSpellCheckHyphen);
{$ENDIF}
    procedure DoWordPopupClick(Sender: TObject);
    procedure DoWordPopupIgnoreClick(Sender: TObject);
  public
    procedure DoSpellCheck(Sender: TObject; Mode: TWPStartSpellcheckMode);
    destructor Destroy; override;
    property Eds_Spell: TWPTSpellDlg read GetEdsSpell;
    property SpellPopupMenu: TPopupMenu read GetSpellPopupMenu;
  end;

destructor TWPSpellCheckInterface.Destroy;
begin
  if assigned(FEdsSpell) then FEdsSpell.Free;
  if assigned(FSpellPopupMenu) then FSpellPopupMenu.Free;
  inherited Destroy;
end;

var FLastDictionary: string;

function TWPSpellCheckInterface.GetEdsSpell: TWPTSpellDlg;
begin
  if not assigned(FEdsSpell) then
  begin
    FEdsSpell := TWPTSpellDlg.Create(nil);
    FLastDictionary := '';
  end;
  if EDSDictionary <> FLastDictionary then
  begin
    FEdsSpell.DictionaryName := ExtractFileName(EDSDictionary);
    FEdsSpell.DictionaryPath := ExtractFilePath(EDSDictionary);
    FLastDictionary := EDSDictionary;
  end;
  Result := FEdsSpell;
end;

function TWPSpellCheckInterface.GetSpellPopupMenu: TPopupMenu;
begin
  if not assigned(FSpellPopupMenu) then FSpellPopupMenu := TWPEDSPopupMenu.Create(nil);
  Result := FSpellPopupMenu;
end;


procedure TWPSpellCheckInterface.DoSpellCheck(Sender: TObject; Mode: TWPStartSpellcheckMode);
begin
  // TWPStartSpellcheckMode = (wpStartSpellCheck, wpStartThesuarus, wpStartSepllAsYouGo, wpStopSpellAsYouGo);
  if Sender is TWPCustomRtfEdit then
    case Mode of
      wpStartSpellCheck: Eds_Spell.SpellCheck(TWPCustomRtfEdit(Sender));
      // wpStartThesuarus:
      wpStartSpellAsYouGo:
        begin
{$IFDEF WPTOOLS5}
          TWPCustomRtfEdit(Sender).Spell_RemoveMarkers;
          TWPCustomRtfEdit(Sender).Memo._3RDPartyOnSpellCheckWord := Self.DoSpellCheckWord;
          TWPCustomRtfEdit(Sender)._3RDParty_OnMouseDownWord := Self.DoMouseDownRight;
          TWPCustomRtfEdit(Sender).Refresh(true);
{$ELSE}
          TWPCustomRtfEdit(Sender).OnMouseDownRight := Self.DoMouseDownRight;
          TWPCustomRtfEdit(Sender).OnSpellCheckWord := Self.DoSpellCheckWord;
{$ENDIF}
        end;
      wpStopSpellAsYouGo:
        begin
{$IFDEF WPTOOLS5}
          TWPCustomRtfEdit(Sender).Memo._3RDPartyOnSpellCheckWord := nil;
          TWPCustomRtfEdit(Sender)._3RDParty_OnMouseDownWord := nil;
          TWPCustomRtfEdit(Sender).Spell_RemoveMarkers;
{$ELSE}
          TWPCustomRtfEdit(Sender).OnMouseDownRight := nil;
          TWPCustomRtfEdit(Sender).OnSpellCheckWord := nil;
{$ENDIF}
        end;
    end;
end;

// interface functions to work with WPTools (by wpcubed GmbH)
var
  WPSpellCheckInterface: TWPSpellCheckInterface;

// Locates Word in dictionary
{$IFDEF WPTOOLS5}

procedure TWPSpellCheckInterface.DoSpellCheckWord(Sender: TObject; var Word: WideString;
  var Res: TSpellCheckResult; var Hyphen: TSpellCheckHyphen;
  par: TParagraph; posinpar: Integer);
begin
  if not Eds_Spell.IsBadWord(word) then
    res := [] else
    res := [spMisSpelled];
end;
{$ELSE}

procedure TWPSpellCheckInterface.DoSpellCheckWord(Sender: TObject; word: string; var res: TSpellCheckResult; var hypen: TSpellCheckHyphen);
begin
  if not Eds_Spell.IsBadWord(word) then
    res := [] else
    res := [spMisSpelled];
end;
{$ENDIF}

// Creates popup menu with possible alternatives
{$IFDEF WPTOOLS5}

procedure TWPSpellCheckInterface.DoMouseDownRight(
  Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState;
  X, Y: Integer;
  par: TParagraph;
  posinpar: Integer;
  Pos: Integer;
  len: Integer;
  var text: string;
  var atr: Cardinal;
  var Abort: Boolean);
{$ELSE}

procedure TWPSpellCheckInterface.DoMouseDownRight(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
  pos: Longint; len: Integer; var text: string; var atr: TAttr);
{$ENDIF}
var list: TStringList;
  i: Integer;
  m: TMenuItem;
{$IFDEF WPTOOLS5}
  r: TRect;
{$ENDIF}
  p: TPoint;
begin
{$IFDEF WPTOOLS5}
  if ((atr and cafsMisSpelled) = 0) or (Button <> mbRight) then exit;
{$ELSE}
  if not (afsMisSpelled in atr.Style) or (Button <> mbRight) then exit;
{$ENDIF}

  for i := SpellPopupMenu.Items.Count - 1 downto 0 do
    SpellPopupMenu.Items[i].Destroy;
  SpellPopupMenu.AutoHotkeys := maManual;

{$IFDEF WPTOOLS5}
  Abort := TRUE;
  TWPCustomRtfEdit(sender).TextCursor.DisableTextSelection := TRUE;
{$ENDIF}

  (Sender as TWPCustomRtfEdit).SetSelPosLen(Pos, Length(Text));
{$IFDEF WPTOOLS5}
  r := (Sender as TWPCustomRtfEdit).SelRect;
  p.X := r.Left;
  p.Y := r.Bottom;
  FCurrEdit := (Sender as TWPCustomRtfEdit);
{$ELSE}
  with TWPCustomRtfEdit(sender).Memo do
  begin
    p.X := Get_X_from_Cp(block_s_par, block_s_lin, block_s_cp) + left_offset;
    p.Y := Get_Y_from_Lin(block_s_lin) - top_offset + 16;
  end;
{$ENDIF}
  p := TControl(Sender).ClientToScreen(p);

  FCheckedWord := text;
  FChanged := FALSE;
  FIsOk := FALSE;
  list := Eds_Spell.SuggestWords(text, 10);
  if list <> nil then
  try
    for i := 0 to list.Count - 1 do
    begin
      m := TMenuItem.Create(SpellPopupMenu);
      m.Caption := list[i];
      m.OnClick := DoWordPopupClick;
      SpellPopupMenu.Items.Add(m);
    end;
    // Sperarator
    m := TMenuItem.Create(SpellPopupMenu);
    m.Caption := '-';
    m.Enabled := FALSE;
    SpellPopupMenu.Items.Add(m);

    // Ignore ...
    m := TMenuItem.Create(SpellPopupMenu);
    m.Caption := 'Ignore';
    m.OnClick := DoWordPopupIgnoreClick;
    SpellPopupMenu.Items.Add(m);



    SpellPopupMenu.Popup(p.x, p.y);
    // Execute the OnClick !
    Application.ProcessMessages;
    // Changed ?
    if FChanged then
    begin
      text := FCheckedWord;
      FIsOk := TRUE;
    end;

    if FIsOk then
    begin
{$IFDEF WPTOOLS5}
      atr := atr and not cafsMisSpelled or cafsWasChecked;
{$ELSE}
      Exclude(Atr.Style, afsMisSpelled);
      Include(Atr.Style, afsWasChecked);
{$ENDIF}
    end;
  finally
    list.Free;
{$IFDEF WPTOOLS5}
    TWPCustomRtfEdit(Sender).TextCursor.DisableTextSelection := FALSE;
{$ENDIF}
  end;
end;

procedure TWPSpellCheckInterface.DoWordPopupClick(Sender: TObject);
begin
  FChanged := TRUE;
  FCheckedWord := (Sender as TMenuItem).Caption;
end;

procedure TWPSpellCheckInterface.DoWordPopupIgnoreClick(Sender: TObject);
begin
  FIsOK := TRUE;
  {$IFDEF WPTOOLS5}
  FCurrEdit.Spell_IgnoreWord(FCheckedWord, true);
  {$ENDIF}
end;


initialization
  WPSpellCheckInterface := TWPSpellCheckInterface.Create;
  // This is a global event triggered by WPTools
{$IFDEF WPTOOLS5}
  if (GlobalWPToolsCustomEnviroment <> nil) and
    (GlobalWPToolsCustomEnviroment is TWPToolsEnviroment) then
  begin
    TWPToolsEnviroment(GlobalWPToolsCustomEnviroment).SpellEngine := WPSpellCheckInterface;
    TWPToolsEnviroment(GlobalWPToolsCustomEnviroment).SpellEngine_OnStartSpellcheck
      := WPSpellCheckInterface.DoSpellCheck;
  end;
{$ELSE}
  WPONStartSpellcheck := WPSpellCheckInterface.DoSpellCheck;
{$ENDIF}

finalization
{$IFDEF WPTOOLS5}
  if (GlobalWPToolsCustomEnviroment <> nil) and
    (GlobalWPToolsCustomEnviroment is TWPToolsEnviroment) then
  begin
    TWPToolsEnviroment(GlobalWPToolsCustomEnviroment).SpellEngine := nil;
    TWPToolsEnviroment(GlobalWPToolsCustomEnviroment).SpellEngine_OnStartSpellcheck := nil;
  end;
{$ELSE}
  WPONStartSpellcheck := nil;
{$ENDIF}
  WPSpellCheckInterface.Free;
  WPSpellCheckInterface := nil;
end.