source: cprs/branches/HealthSevak-CPRS/CPRS-Lib/Hans SpellCheck/skaSpellCheck.pas@ 1713

unit skaSpellCheck;
(* ***************************** BEGIN LICENSE BLOCK **********************
 *
 * Copyright (C) 2015
 * Sunil Kumar Arora (digitiger@gmail.com        sunil@healthsevak.com)
 * All Rights Reserved.
 * Version: MPL 1.1/GPL 2.0/LGPL 2.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * Alternatively, the content of this file maybe used under the terms of either
 * the GNU General Public License Version 2 or later (the "GPL"), or the GNU
 * Lesser General Public License Version 2.1 or later (the "LGPL"), in which
 * case the provisions of the GPL or the LGPL are applicable instead of those
 * above. If you wish to allow use of your version of this file only under the
 * terms of either the GPL or the LGPL, and not to allow others to use your
 * version of this file under the terms of the MPL, indicate your division by
 * deleting the provisions above and replace them with the notice and other
 * provisions required by the GPL or LGPL. If you do not delete the provisions
 * above, a recipient may use your version of this file under the terms of any
 * one of the MPL, the GPL or the LGPL.
 *
 * *********************** END LICENSE BLOCK *********************************)

interface

uses
  Windows, Classes, SysUtils, ComCtrls, StdCtrls, Graphics;

  const
    AboutThis = 'A wrapper component developed by Sunil K Arora (digitiger@gmail.com) of HealthSevak using OpenSource HanSpell engine';
type
  TSpellState = (ssNotStarted, ssChecking, ssCancelled, ssCompleted);

  TskaHunSpellChecker = class(TComponent)
  private
    FActiveOrLoaded: Boolean;
    FpointerHunLib: Pointer;
    FSourceEdit: TRichEdit;
    FSuggestionList: TListbox;

    FAffixFileName: string;
    FDictFileName: string;
    CurrentWord: String;
    CurrentText: String;
    FoundAt: Integer;
    PosOfFirstCharInCurrentLine: integer;
    CurrentLine: Integer;
    FIgnore: TStringList;
    WaitForUser: Boolean;
    WordLength:integer;
    WordPos: Integer;
    PREditorWndProc:pointer;
    FHighlightColor: TColor;
    FShowCompletion: Boolean;
    FpointerSpellComplete: String;
    FStatus: TSpellState;
    FUndoList: TStringList;
    FCustDict: TStringList;
    FCustom: String;
    FModified: Boolean;
    FHighlightEdit: TEdit;
    FbtnClose: TButton;
    FTxtBeforeManualEdit: String;
    function AddCustomWord(aWord: String; isInternal: Boolean = False): Boolean;
                                                            overload; virtual;
    Function CurrentWordDetail(WithPosition: Boolean= True): String;
    function GetActive: Boolean;
    function GetStatus: TSpellState;
    procedure Initialize;
    procedure SetActive(const Value: Boolean);
    procedure SetAffixFileName(const Value: string);
    procedure SetbtnClose(const Value: TButton);
    procedure SetCustomDict(const Value: String);
    procedure SetDictFileName(const Value: string);
    procedure SetHighLightEdit(const Value: TEdit);
    procedure SetSourceEdit(const Value: TRichEdit);
    Function ShowMisSpelledWord:boolean;
    procedure Loaded; override;
    procedure ReplaceCurrentWordWith(const aNewWord: String);
    function GetAboutThis: String;
    procedure SaveForUndo(const Ignoring: Boolean=False);
    procedure ShowBtnClose(const ShowIt: Boolean = True);
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; SourceTextRichEdit: TRichedit;
                               SuggestList: TListbox); ReIntroduce; overload;
    destructor Destroy; override;

    function AbortSpellCheck(Verbose: Boolean = True):Boolean;
    function AddCustomWord: Boolean; overload; virtual;
    procedure Change;
    procedure ChangeAll;
    procedure CheckSpelling;
    procedure Close; virtual;
    procedure CorrectWithMyWord;
    procedure GetSuggestions(const aMisSpeltWord: string;
                                      const SuggestionList: TStrings); dynamic;
    procedure IgnoreAll;
    procedure IgnoreOnce;
    function IsMisspelled(const AWord: string): Boolean; dynamic;
    procedure ManualChangeStart;
    procedure ManualChangeDone;
    function Open:Boolean; virtual;
    function ReStart: Boolean; virtual;

    function Undo: Boolean;


    property SpellCheckState: TSpellState read GetStatus default ssNotStarted;
  published
    property About: String read GetAboutThis;
    property Active: Boolean read GetActive write SetActive;
    property AffixFileName: string read FAffixFileName write SetAffixFileName;
    property btnClose: TButton read FbtnClose write SetbtnClose;
    property CustDictionaryFile: String read FCustom write SetCustomDict;
    property DictionaryFileName:string read FDictFileName write SetDictFileName;
    property ColorForMisspelled: TColor read FHighlightColor write FHighlightColor default clRed;
    property MisSpeltWord: TEdit read FHighlightEdit write SetHighLightEdit;
    property IsModified: Boolean read FModified;
    property ShowCompletionMessage: Boolean read FShowCompletion write FShowCompletion default True;
    property SourceTextControl: TRichEdit read FSourceEdit write SetSourceEdit;
    property SpellCheckCompletionMessage: String read FpointerSpellComplete write FpointerSpellComplete; 
    property SuggestionList: TListbox read FSuggestionList write FSuggestionList;

  end;

  procedure Register;

  Const
    CompletionMessage = 'Spell Check Complete.';
    CaptionForNewWord = 'New Word Suggestion';
    ConfirmAbort = 'Really abort?';
    PromptForNewWord = 'Specify the replacement for current mis-spelt word:';
    DLLNotLoaded = 'Failed to load SpellCheck Engine DLL.';
    MisSpeltReplacement = 'The new word specified by you "%s" looks mis-spelt!'
                          +' Would you want to still use it?   Click NO button '
                          +'to specify better replacement word.';
  var
    OldRichEditWndProc: {integer}pointer;
    CurrentMe: TskaHunSpellChecker;
implementation
   uses messages, Dialogs, RichEdit, SHFolder, Forms, uHunSpellLib;

procedure Register;
begin
  RegisterComponentsProc('SkA Utility', [TskaHunSpellChecker]);
end;

{ TskaHunSpellChecker }

function TskaHunSpellChecker.AbortSpellCheck(Verbose: Boolean = True): Boolean;
begin
  if FStatus <> ssChecking then
  begin
    FStatus := ssCancelled;
    Close;
    exit;
  end;

  Result := (not isModified)  or
            (not Verbose) or (MessageDlg(ConfirmAbort, mtConfirmation,
                                                  [mbYes, mbNo],0, mbNo) = 6);

  if Result then
    FStatus := ssCancelled;

  ShowBtnClose;
end;

function TskaHunSpellChecker.AddCustomWord(aWord: String; isInternal: Boolean = False): Boolean;
begin
  Result := False;
  if (trim(aWord) = '') or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     

  Result := False;
  if (not Active) then Exit;
  uHunSpellLib.hunspell_put_word(FpointerHunLib, PAnsiChar(AnsiString(aWord)));
  Result := True;
end;

procedure TskaHunSpellChecker.ChangeAll;
begin
  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     exit;
  SaveForUndo;
  SourceTextControl.Text := StringReplace(SourceTextControl.Text,
                    CurrentWord, SuggestionList.Items[SuggestionList.ItemIndex],
                    [rfReplaceAll,rfIgnoreCase]);
  WaitForUser := False;
  FModified := True;
  SourceTextControl.Invalidate;

end;

function TskaHunSpellChecker.AddCustomWord: Boolean;
begin
  Result := AddCustomWord(CurrentWord, False);
  FCustdict.Add(CurrentWord);
  WaitForUser := False;
  AbortSpellCheck(False);
  Initialize;
  CheckSpelling;
  ShowMisSpelledWord;
end;

procedure TskaHunSpellChecker.ReplaceCurrentWordWith(const aNewWord: String);
var
  full: String;
  prefix: string;
  suffix: string;
begin
  full := SourceTextControl.Lines[CurrentLine];
  prefix := copy(CurrentText, 2, WordPos-2);    //remember there is one extra space at the start of the line prefixed while populating this variable
  Suffix :=  copy(CurrentText, WordPos+WordLength,
                           length(CurrentText));
  SaveForUndo;
  SourceTextControl.Lines[CurrentLine] :=prefix + aNewWord + suffix;
  WaitForUser := False;
  FStatus := ssChecking;
  FModified := True;
  SourceTextControl.Invalidate;
end;

function TskaHunSpellChecker.ReStart: Boolean;
begin
  Close;
  Result := Open;
  Initialize;
  WaitForUser := False;
  FStatus := ssChecking;
  SourceTextControl.Invalidate;
  Result := not WaitForUser;
end;

procedure TskaHunSpellChecker.Change;

begin
  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     exit;
  ReplaceCurrentWordWith(SuggestionList.Items[SuggestionList.ItemIndex]);
end;

procedure TskaHunSpellChecker.CheckSpelling;
begin
 if (SpellCheckState = ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     exit;

 Initialize;
 FUndoList.Clear;
 WaitForUser := False;
 FStatus := ssChecking;
 SourceTextControl.Invalidate;
 //SourceTextControl.Invalidate;
 ShowBtnClose(False);
end;

procedure TskaHunSpellChecker.Close;
begin
  if not Active then Exit;
  uHunSpellLib.hunspell_uninitialize(FpointerHunLib);
  FpointerHunLib := nil;
end;


procedure TskaHunSpellChecker.CorrectWithMyWord;
var
  NewWord: String;
  GotIt: Boolean;
begin
  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     exit;

  if SuggestionList.Count > 0 then
    NewWord := SuggestionList.Items[0]
  else
    NewWord := CurrentWord;

  GotIt := False;
  while not GotIt do
  begin
    if not InputQuery(CaptionForNewWord, PromptForNewWord, NewWord)  then
      exit;

    GotIt := (not IsMisspelled(NewWord))
          or (MessageDlg(Format(MisSpeltReplacement,[NewWord]),
                                        mtWarning, [mbYes, mbNo],0, mbNo) =6) ;
  end;

  if IsMisspelled(NewWord) then
    AddCustomWord(NewWord, True);
    
  ReplaceCurrentWordWith(NewWord);
end;

constructor TskaHunSpellChecker.Create(AOwner: TComponent);
    function GetSpecialFolderPath(folder : integer) : string;
      var
        path: array [0..MAX_PATH] of char;
    begin
      if SUCCEEDED(SHGetFolderPath(0,folder,0,0,@path[0])) then
        Result := path
      else
        Result := '';
    end;
begin
  inherited;

   ColorForMisspelled := clRed;
   ShowCompletionMessage := True;
   SpellCheckCompletionMessage := CompletionMessage;



   CurrentMe := Self;
   FIgnore := TStringList.Create;
   FCustDict := TStringList.Create;

   CustDictionaryFile := IncludeTrailingPathDelimiter(GetSpecialFolderPath(CSIDL_PERSONAL)) + 'CustomDictionary.txt';
   if FileExists(CustDictionaryFile) then
    try
      FCustDict.LoadFromFile(CustDictionaryFile);
    except
    end;

   FUndoList := TStringList.Create;

   FStatus := ssNotStarted;
   WaitForUser := False;
   WordPos := 0;
end;

constructor TskaHunSpellChecker.Create(AOwner: TComponent;
  SourceTextRichEdit: TRichedit; SuggestList: TListbox);
begin
   create(AOwner);
   SourceTextControl := SourceTextRichEdit;
   SuggestionList := SuggestList;
end;

function TskaHunSpellChecker.CurrentWordDetail(WithPosition: Boolean): String;
begin
  Result := '$$' + CurrentWord + '$$';
  if WithPosition then
    Result := '$$' + IntToStr(FoundAt+1) + Result;
end;

destructor TskaHunSpellChecker.Destroy;
begin
  Close;
  FIgnore.clear;
  FreeAndNil(FIgnore);
  FreeAndNil(FUndoList);
  if not (csDesigning in ComponentState) then
  try
    if FCustDict.Count > 0 then
    try
      FCustDict.SaveToFile(CustDictionaryFile);
    except
    end;
  finally
    FCustDict.Free;
  end;
  inherited;
end;

function TskaHunSpellChecker.GetAboutThis: String;
begin
  Result := AboutThis;
end;

function TskaHunSpellChecker.GetActive: Boolean;
begin
  Result := (FpointerHunLib <> nil);
end;

function TskaHunSpellChecker.GetStatus: TSpellState;
begin
  Result := FStatus;
end;

procedure TskaHunSpellChecker.GetSuggestions(const aMisSpeltWord: string;
                                                const SuggestionList: TStrings);
var
  i: Integer;
  pMisSpelt: PAnsiChar;
  suggestions: PPAnsiChar;
  Results: PPAnsiChar;
  Count: Integer;
begin
  if (not Active) or (not Assigned(SuggestionList)) then
    exit;

  pMisSpelt := PAnsiChar(AnsiString(aMisSpeltWord));

  if not uHunSpellLib.hunspell_spell(FpointerHunLib, pMisSpelt) then
    uHunSpellLib.hunspell_suggest_auto(FpointerHunLib, pMisSpelt, suggestions);
  begin
    Count := uHunSpellLib.hunspell_suggest(FpointerHunLib, pMisSpelt, suggestions);
    Results := suggestions;
    for i := 1 to Count do
    begin
      SuggestionList.Add(Results^);
      Inc(Integer(Results), SizeOf(Pointer));
    end;
    uHunSpellLib.hunspell_suggest_free(FpointerHunLib, suggestions, Count);
  end; 
end;

procedure TskaHunSpellChecker.ShowBtnClose(const ShowIt: Boolean);
begin
  if Assigned(btnClose) then
  begin
   btnClose.Enabled := ShowIt;
   btnClose.Visible := ShowIt;
   if ShowIt then
   begin
     btnClose.BringToFront;
     btnClose.SetFocus;
   end;
  end;
end;

function TskaHunSpellChecker.ShowMisSpelledWord: boolean;
var
   I , l :integer;
   CharPosion:integer;
   FirstVisibleLine, LastVisibleLine:integer;

   hndl: hwnd;
   dcForHndl: THandle;
   visrect:Trect;
   vispoint:TPoint;
   procedure ShowMisSpelletWord;
   begin
     if Assigned(FHighlightEdit) then
     begin
       FHighlightEdit.Font.Color := ColorForMisspelled;
       FHighlightEdit.Text := CurrentWord;
       FHighlightEdit.Show;
     end ;

     if ((PosOfFirstCharInCurrentLine + FoundAt) < 1) then
        exit;

     SendMessage (SourceTextControl.Handle, EM_POSFROMCHAR, integer(@VisPoint), PosOfFirstCharInCurrentLine + FoundAt-1);
     SetTextColor(dcForHndl, ColorForMisspelled);
     TextOut(dcForHndl,  VisPoint.x,  VisPoint.y,  pchar(CurrentWord), WordLength);
   end;
begin
  Result := False;
  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl))
     or (not assigned(SuggestionList)) then
     exit;

  hndl:=SourceTextControl.Handle;

  result:= SendMessage (hndl, EM_GETRECT, 0, integer(@visrect))=0;

  dcForHndl := getdc(hndl);

  if result then
  begin
   // VisPoint := visrect.BottomRight;
    vispoint.Y := visrect.Bottom;
    vispoint.X := visrect.Right;
    CharPosion       := SendMessage (hndl, EM_CHARFROMPOS, 0, integer(@VisPoint));
    LASTVISIBLELINE  := SendMessage (hndl, EM_LINEFROMCHAR, CharPosion, 0);
    FIRSTVISIBLELINE := SendMessage (hndl, EM_GETFIRSTVISIBLELINE, 0, 0);

    SetBkMode (dcForHndl, TRANSPARENT);
    SelectObject(dcForHndl, SourceTextControl.font.Handle);
    i := 0;

    if WaitForUser then
    begin
      ShowMisSpelletWord;
      exit;
    end;

    For l := 0 to SourceTextControl.Lines.Count -1  do
    begin
    {$R-}
      CurrentLine := l;
      if trim(SourceTextControl.Lines[CurrentLine]) = '' then
        continue;

      CurrentText := ' ' + SourceTextControl.Lines[CurrentLine];
      PosOfFirstCharInCurrentLine := SendMessage (SourceTextControl.Handle, EM_LINEINDEX, CurrentLine, 0);
      i := 0;

      While i <= LENgth(CurrentText) do
      begin
        FoundAt := i -1;
        if Assigned(FHighlightEdit) then
          FHighlightEdit.Hide;


        //SuggestionList.Clear;
        {Any character except these will count as a word delimiter}
        While CurrentText[i] in ['A'..'Z','a'..'z','0'..'9'] do inc(i);

        WordLength        := i- FoundAt -1;
        WordPos           := i-WordLength;
        CurrentWord          := copy(CurrentText, WordPos, WordLength);
        If ((FIgnore.IndexOf(CurrentWordDetail(True))< 0)  //SingelIgnore
              and (FIgnore.IndexOf(CurrentWordDetail(False))< 0) //IgnoreAll
              and (IsMisspelled(CurrentWord))) Then
        begin
           GetSuggestions(CurrentWord, SuggestionList.Items);
           if SuggestionList.Count > 0 then
             SuggestionList.ItemIndex := 0;
          ShowMisSpelletWord;
          if CurrentLine > LastVisibleLine then
            SendMessage(SourceTextControl.Handle, EM_LINESCROLL, 0, (CurrentLine - lastvisibleLine)+5);
          WaitForUser := True;
          exit;
        End
        else
           SuggestionList.Clear;
        inc(i);
      end;
    end;
    if (CurrentLine >= SourceTextControl.Lines.Count-1) and (i >= length(CurrentText) +1) then
    begin
      FStatus := ssCompleted;
      if ShowCompletionMessage then
        ShowMessage(CompletionMessage);
      ShowBtnClose;
    end;
    {$R+}
  end;
  ReleaseDC(SourceTextControl.Handle, dcForHndl);

End;

function TskaHunSpellChecker.Undo: Boolean;
var
  tmpStr: String;
  tmpCount: Integer;
begin
  if FUndoList.Count > 0 then
  try
    tmpStr := FUndoList.Strings[FUndoList.Count-1];
   { showmessage(inttostr(AnsiPos('$$',tmpStr)) + #13 + inttostr(length(tmpstr)) + #13 +
                                        copy(tmpStr,length(tmpStr)-2,2));  }
    if (AnsiPos('$$',tmpStr)=1) and (copy(tmpStr,length(tmpStr)-1,2) = '$$')then
    begin
      tmpCount := strtoInt(StringReplace(tmpStr,'$$','',[rfReplaceAll]));
      while FIgnore.Count > tmpCount do
        FIgnore.Delete(FIgnore.Count -1);
    end
    else
    SourceTextControl.Text := tmpStr;

    Result := True;
    FUndoList.Delete(FUndoList.Count-1);
    ReStart;
  except
    Result := False;
  end;
end;

procedure TskaHunSpellChecker.IgnoreAll;
begin
  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     exit;
  SaveForUndo(True);
  FIgnore.Add(CurrentWordDetail(False)) ;
  WaitForUser := False;
  SourceTextControl.Invalidate;
end;

procedure TskaHunSpellChecker.IgnoreOnce;
begin
  if (SpellCheckState <> ssChecking) or (not assigned(SourceTextControl)) or (not assigned(SuggestionList)) then
     exit;
  if trim(CurrentWord) <> '' then
  begin
    SaveForUndo(True);
    FIgnore.Add(CurrentWordDetail(True)) ;
  end;
  WaitForUser := False;
  SourceTextControl.Invalidate;
end;

procedure TskaHunSpellChecker.Initialize;
begin
  CurrentWord := '';
  WordLength := 0;
  FoundAt := -1;
  CurrentLine := 0;
  WordPos := 0;
  SuggestionList.Clear;
end;

function TskaHunSpellChecker.IsMisspelled(const AWord: string): Boolean;
begin
  if (not Active) then
    Result := True
  else
    Result := not uHunSpellLib.hunspell_spell(FpointerHunLib, PAnsiChar(AnsiString(AWord)));
end;

procedure TskaHunSpellChecker.Loaded;
begin
  inherited;
  SetActive(FActiveOrLoaded);
end;

procedure TskaHunSpellChecker.ManualChangeDone;
begin
  if trim(FTxtBeforeManualEdit) = '' then
    exit;
  FUndoList.Add(FTxtBeforeManualEdit);
  ReStart;
end;

procedure TskaHunSpellChecker.ManualChangeStart;
begin
  FTxtBeforeManualEdit := FSourceEdit.Text;
end;

function TskaHunSpellChecker.Open: Boolean;
var
  CurrentLine: integer;
begin
  Result := True;
  if Active then Exit;
  Result := False;
  FpointerHunLib := Nil;
  if not uHunSpellLib.LoadLibHunspell('') then
  begin
     MessageDlg(DLLNotLoaded, mtError, [mbOK],0);
     Exit;
  end;
  FpointerHunLib := uHunSpellLib.hunspell_initialize(PAnsiChar(AnsiString(FAffixFileName)), PAnsiChar(AnsiString(FDictFileName)));
  Result := Assigned(FpointerHunLib);

  if (Result) and (assigned(FCustDict)) then
     for CurrentLine := 0 to FCustDict.Count - 1 do
       AddCustomWord(FCustDict[CurrentLine], True);
end;

procedure TskaHunSpellChecker.SaveForUndo(const Ignoring: Boolean = False);
begin
  if Ignoring then
    FUndoList.Add('$$'+ IntToStr(FIgnore.Count)+'$$')
  else
    FUndoList.Add(SourceTextControl.Text);
end;

procedure TskaHunSpellChecker.SetActive(const Value: Boolean);
begin
  if (csDesigning in ComponentState) or (csLoading in ComponentState) then
    FActiveOrLoaded := Value
  else
    if Value then
      FActiveOrLoaded := Open
    else
      Close;
end;

procedure TskaHunSpellChecker.SetAffixFileName(const Value: string);
begin
  Close;
  FAffixFileName := Value;
end;

procedure TskaHunSpellChecker.SetbtnClose(const Value: TButton);
begin
  if btnClose = Value then
     exit;
  FbtnClose := Value;
  FbtnClose.ModalResult := 1; //mrOK
end;

procedure TskaHunSpellChecker.SetCustomDict(const Value: String);
begin
  FCustom := Value;
  if not (csDesigning in componentState) then
    if Active and (FileExists(Value)) then
      FCustDict.LoadFromFile(Value);
end;

procedure TskaHunSpellChecker.SetDictFileName(const Value: string);
begin
  Close;
  FDictFileName := Value;
end;

procedure TskaHunSpellChecker.SetHighLightEdit(const Value: TEdit);
begin
  if FHighlightEdit = Value then
    exit;

  FHighlightEdit := Value;

  if Active then
    FHighlightEdit.Text := CurrentWord;


end;

Function RichEditWndProc (handle:HWnd;uMsg,wParam,lParam:longint): longint stdcall;
begin
      Result := CallWindowProc(OldRichEditWndProc, handle, uMsg, wParam, lParam);
      if (uMsg=WM_PAINT) and assigned(CurrentMe) then CurrentMe.ShowMisSpelledWord;
End;

procedure TskaHunSpellChecker.SetSourceEdit(const Value: TRichEdit);
begin
  if FSourceEdit = Value then
    exit;

  FSourceEdit := Value;

  if csDesigning in ComponentState then
    exit;

  PREditorWndProc:=@RichEditWndProc;
  Value.perform(EM_EXLIMITTEXT, 0, 65535*32); //raise the limit of text which could be inserted into this Richedit
  OldRichEditWndProc := pointer(SetWindowLong(Value.handle, GWL_WNDPROC, longint(@RichEditWndProc)));

end;

end.