[1715] | 1 | unit fHunSpell;
|
---|
| 2 | (* ***************************** BEGIN LICENSE BLOCK **********************
|
---|
| 3 | *
|
---|
| 4 | * Copyright (C) 2015
|
---|
| 5 | * Sunil Kumar Arora (digitiger@gmail.com sunil@healthsevak.com)
|
---|
| 6 | * All Rights Reserved.
|
---|
| 7 | * Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
---|
| 8 | *
|
---|
| 9 | * The contents of this file are subject to the Mozilla Public License Version
|
---|
| 10 | * 1.1 (the "License"); you may not use this file except in compliance with
|
---|
| 11 | * the License. You may obtain a copy of the License at
|
---|
| 12 | * http://www.mozilla.org/MPL/
|
---|
| 13 | *
|
---|
| 14 | * Software distributed under the License is distributed on an "AS IS" basis,
|
---|
| 15 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
---|
| 16 | * for the specific language governing rights and limitations under the
|
---|
| 17 | * License.
|
---|
| 18 | *
|
---|
| 19 | * Alternatively, the content of this file maybe used under the terms of either
|
---|
| 20 | * the GNU General Public License Version 2 or later (the "GPL"), or the GNU
|
---|
| 21 | * Lesser General Public License Version 2.1 or later (the "LGPL"), in which
|
---|
| 22 | * case the provisions of the GPL or the LGPL are applicable instead of those
|
---|
| 23 | * above. If you wish to allow use of your version of this file only under the
|
---|
| 24 | * terms of either the GPL or the LGPL, and not to allow others to use your
|
---|
| 25 | * version of this file under the terms of the MPL, indicate your division by
|
---|
| 26 | * deleting the provisions above and replace them with the notice and other
|
---|
| 27 | * provisions required by the GPL or LGPL. If you do not delete the provisions
|
---|
| 28 | * above, a recipient may use your version of this file under the terms of any
|
---|
| 29 | * one of the MPL, the GPL or the LGPL.
|
---|
| 30 | *
|
---|
| 31 | * *********************** END LICENSE BLOCK *********************************)
|
---|
| 32 |
|
---|
| 33 | interface
|
---|
| 34 |
|
---|
| 35 | uses
|
---|
| 36 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 37 | StdCtrls, ComCtrls, RichEdit, Buttons, ExtCtrls, ShellAPI,
|
---|
| 38 | skaSpellCheck;
|
---|
| 39 |
|
---|
| 40 | type
|
---|
| 41 | TfrmHunSpell = class(TForm)
|
---|
| 42 | lblDictionary: TLabel;
|
---|
| 43 | btnClose: TButton;
|
---|
| 44 | OpenDialog1: TOpenDialog;
|
---|
| 45 | SpellCheck1: TskaHunSpellChecker;
|
---|
| 46 | edtDictionary: TEdit;
|
---|
| 47 | btnSelectDict: TBitBtn;
|
---|
| 48 | lblDictionariesURL: TLabel;
|
---|
| 49 | RichEdit1: TRichEdit;
|
---|
| 50 | btnStart: TButton;
|
---|
| 51 | pnlMisSpelled: TPanel;
|
---|
| 52 | Label1: TLabel;
|
---|
| 53 | Label4: TLabel;
|
---|
| 54 | lstSuggestions: TListBox;
|
---|
| 55 | edtMisSpeltWordForExtraHint: TEdit; //required for screenreaders which are MOSTLY colour blind
|
---|
| 56 | btnReplaceWith: TButton;
|
---|
| 57 | btnChangeAll: TButton;
|
---|
| 58 | btnChange: TButton;
|
---|
| 59 | btnAddToDictionary: TButton;
|
---|
| 60 | btnIgnoreAll: TButton;
|
---|
| 61 | btnIgnoreOnce: TButton;
|
---|
| 62 | btnAbort: TButton;
|
---|
| 63 | btnUndo: TButton;
|
---|
[1718] | 64 | cbIgnoreAllCaps: TCheckBox;
|
---|
| 65 | cbIgnoreDigit: TCheckBox;
|
---|
[1715] | 66 | procedure FormCreate(Sender: TObject);
|
---|
| 67 | procedure btnIgnoreOnceClick(Sender: TObject);
|
---|
| 68 | procedure btnIgnoreAllClick(Sender: TObject);
|
---|
| 69 | procedure btnChangeClick(Sender: TObject);
|
---|
| 70 | procedure btnChangeAllClick(Sender: TObject);
|
---|
| 71 | procedure btnCloseClick(Sender: TObject);
|
---|
| 72 | procedure FormActivate(Sender: TObject);
|
---|
| 73 | procedure btnSelectDictClick(Sender: TObject);
|
---|
| 74 | procedure edtDictionaryEnter(Sender: TObject);
|
---|
| 75 | procedure btnReplaceWithClick(Sender: TObject);
|
---|
| 76 | procedure btnAddToDictionaryClick(Sender: TObject);
|
---|
| 77 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 78 | procedure btnAbortClick(Sender: TObject);
|
---|
| 79 | procedure btnStartClick(Sender: TObject);
|
---|
| 80 | procedure btnUndoClick(Sender: TObject);
|
---|
| 81 | procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
|
---|
| 82 | Shift: TShiftState);
|
---|
| 83 | procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
|
---|
| 84 | Shift: TShiftState);
|
---|
| 85 | procedure UpdateGUI;
|
---|
| 86 | procedure SpellCheck1Abort(Sender: TObject);
|
---|
| 87 | procedure SpellCheck1Start(Sender: TObject);
|
---|
| 88 | procedure SpellCheck1StateChange(const Sender: TObject;
|
---|
| 89 | const State: TSpellState);
|
---|
| 90 | procedure lblDictionariesURLClick(Sender: TObject);
|
---|
| 91 | procedure lstSuggestionsDblClick(Sender: TObject);
|
---|
[1718] | 92 | procedure cbIgnoreAllCapsClick(Sender: TObject);
|
---|
| 93 | procedure cbIgnoreDigitClick(Sender: TObject);
|
---|
| 94 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
[1715] | 95 | private
|
---|
| 96 | { Private declarations }
|
---|
| 97 | NoEngineOpted: Boolean;
|
---|
| 98 | FSourceControl: TCustomMemo;
|
---|
| 99 | procedure GoToURL(const aURL: String);
|
---|
| 100 | public
|
---|
| 101 | { Public declarations }
|
---|
| 102 | Showhighlight:boolean;
|
---|
| 103 | highlightcolor:TColor;
|
---|
| 104 | HighLightList:TStringlist;
|
---|
| 105 | OldRichEditWndProc: {integer}pointer;
|
---|
| 106 | PRichEditWndProc:pointer;
|
---|
| 107 | class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
|
---|
| 108 | static;
|
---|
| 109 | end;
|
---|
| 110 |
|
---|
| 111 | Resourcestring
|
---|
| 112 | TX_AFF_NOT_FOUND = 'Correspong AFF file named not found!'
|
---|
| 113 | + #13
|
---|
| 114 | + ' Specify dictionary file whose *.aff is also '
|
---|
| 115 | + 'present in same directory.' ;
|
---|
| 116 | TX_DIC_FILE_NOT_FOUND = 'Dictionary File for SpellCheck Engine not found!';
|
---|
| 117 | TX_SPELL_COMPLETE = 'Spell Check Complete';
|
---|
| 118 | TX_SPELL_CANCELLED = 'Spell Check Aborted'
|
---|
| 119 | + #13
|
---|
| 120 | + 'No Changes applied to the original text!';
|
---|
| 121 |
|
---|
| 122 | Const
|
---|
| 123 | DefaultDicFile = 'dict\en_GB.dic';// 'dict\en-US-OpenMedSpel.dic';
|
---|
| 124 | var
|
---|
| 125 | frmHunSpell: TfrmHunSpell;
|
---|
| 126 |
|
---|
| 127 | implementation
|
---|
| 128 | {$R *.DFM}
|
---|
| 129 |
|
---|
| 130 |
|
---|
| 131 | class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo):
|
---|
| 132 | TModalResult;
|
---|
| 133 | {This function could be invoked from some other form by using this as modalform
|
---|
| 134 | without creating the instance of this form in advance}
|
---|
| 135 | var
|
---|
| 136 | frm: TfrmHunSpell;
|
---|
| 137 | begin
|
---|
| 138 | Result := mrCancel;
|
---|
| 139 | frm:= TfrmHunSpell.create(Application);
|
---|
| 140 | try
|
---|
| 141 | frm.RichEdit1.Text:= AnEditControl.Text;
|
---|
| 142 | frm.FSourceControl := AnEditControl;
|
---|
| 143 | Result := frm.ShowModal;
|
---|
| 144 | finally
|
---|
| 145 | frm.Free;
|
---|
| 146 | end;
|
---|
| 147 | end;
|
---|
| 148 |
|
---|
| 149 | {************ HighLight ***********888}
|
---|
| 150 | procedure TfrmHunSpell.GoToURL(const aURL: String);
|
---|
| 151 | begin
|
---|
| 152 | if length(trim(aURL)) > 4 then
|
---|
| 153 | ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
|
---|
| 154 | end;
|
---|
| 155 |
|
---|
| 156 | procedure TfrmHunSpell.lblDictionariesURLClick(Sender: TObject);
|
---|
| 157 | begin
|
---|
| 158 | GoToURL(TLabel(sender).Caption);
|
---|
| 159 | end;
|
---|
| 160 |
|
---|
| 161 | procedure TfrmHunSpell.lstSuggestionsDblClick(Sender: TObject);
|
---|
| 162 | begin
|
---|
| 163 | if lstSuggestions.ItemIndex >= 0 then
|
---|
| 164 | btnChangeClick(Self);
|
---|
| 165 | end;
|
---|
| 166 |
|
---|
| 167 | procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
|
---|
| 168 | Shift: TShiftState);
|
---|
| 169 | begin
|
---|
| 170 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
| 171 | SpellCheck1.ManualChangeStart;
|
---|
| 172 | end;
|
---|
| 173 |
|
---|
| 174 | procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
|
---|
| 175 | Shift: TShiftState);
|
---|
| 176 | begin
|
---|
| 177 | if SpellCheck1.SpellCheckState in [ssCancelled, ssCompleted] then
|
---|
| 178 | SpellCheck1.Reopen;
|
---|
| 179 |
|
---|
| 180 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
| 181 | SpellCheck1.ManualChangeDone;
|
---|
| 182 | end;
|
---|
| 183 |
|
---|
| 184 | procedure TfrmHunSpell.SpellCheck1Abort(Sender: TObject);
|
---|
| 185 | begin
|
---|
| 186 | UpdateGUI;
|
---|
| 187 | end;
|
---|
| 188 |
|
---|
| 189 | procedure TfrmHunSpell.SpellCheck1Start(Sender: TObject);
|
---|
| 190 | begin
|
---|
| 191 | UpdateGUI;
|
---|
| 192 | end;
|
---|
| 193 |
|
---|
| 194 | procedure TfrmHunSpell.SpellCheck1StateChange(const Sender: TObject;
|
---|
| 195 | const State: TSpellState);
|
---|
| 196 | begin
|
---|
| 197 | if State = ssCompleted then
|
---|
| 198 | ShowMessage(TX_SPELL_COMPLETE);
|
---|
| 199 | UpdateGUI;
|
---|
| 200 | end;
|
---|
| 201 |
|
---|
| 202 | procedure TfrmHunSpell.UpdateGUI;
|
---|
| 203 | var
|
---|
| 204 | Checking: Boolean;
|
---|
| 205 | begin
|
---|
| 206 | if csDestroying in componentstate then
|
---|
| 207 | exit;
|
---|
| 208 | btnStart.Enabled := (SpellCheck1.SpellCheckState in [ssReady, ssCancelled])
|
---|
| 209 | and (trim(RichEdit1.Text) <> '');
|
---|
| 210 |
|
---|
| 211 | Checking := SpellCheck1.SpellCheckState = ssChecking;
|
---|
| 212 | pnlMisSpelled.Visible := Checking;
|
---|
| 213 | pnlMisSpelled.Enabled := Checking;
|
---|
| 214 | btnClose.Visible := not Checking;
|
---|
| 215 | end;
|
---|
| 216 |
|
---|
| 217 | {************* FormCreate **********}
|
---|
| 218 | procedure TfrmHunSpell.btnStartClick(Sender: TObject);
|
---|
| 219 | begin
|
---|
| 220 | if SpellCheck1.SpellCheckState <> ssChecking then
|
---|
| 221 | SpellCheck1.CheckSpelling;
|
---|
| 222 |
|
---|
| 223 | UpdateGUI;
|
---|
| 224 | if (lstSuggestions.Count > 0) and btnChange.Visible and btnChange.Enabled then
|
---|
| 225 | btnChange.SetFocus;
|
---|
| 226 | end;
|
---|
| 227 |
|
---|
| 228 | procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
|
---|
| 229 | begin
|
---|
| 230 | SpellCheck1.AddCustomWord;
|
---|
| 231 | end;
|
---|
| 232 |
|
---|
| 233 | procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
|
---|
| 234 | begin
|
---|
| 235 | SpellCheck1.CorrectWithMyWord;
|
---|
| 236 | end;
|
---|
| 237 |
|
---|
| 238 | procedure TfrmHunSpell.btnAbortClick(Sender: TObject);
|
---|
| 239 | begin
|
---|
| 240 | if SpellCheck1.AbortSpellCheck(False) then
|
---|
| 241 | UpdateGUI;
|
---|
| 242 | end;
|
---|
| 243 |
|
---|
| 244 | procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
|
---|
| 245 | begin
|
---|
| 246 | SpellCheck1.ChangeAll;
|
---|
| 247 | end;
|
---|
| 248 |
|
---|
| 249 | procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
|
---|
| 250 | begin
|
---|
| 251 | SpellCheck1.Change;
|
---|
| 252 | end;
|
---|
| 253 |
|
---|
| 254 | procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
|
---|
| 255 | begin
|
---|
| 256 | close;
|
---|
| 257 | end;
|
---|
| 258 |
|
---|
| 259 | procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
|
---|
| 260 | begin
|
---|
| 261 | SpellCheck1.IgnoreAll;
|
---|
| 262 | end;
|
---|
| 263 |
|
---|
| 264 | procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
|
---|
| 265 | begin
|
---|
| 266 | SpellCheck1.IgnoreOnce;
|
---|
| 267 | end;
|
---|
| 268 |
|
---|
| 269 | procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
|
---|
| 270 | var
|
---|
| 271 | aff: String;
|
---|
| 272 | begin
|
---|
| 273 | if OpenDialog1.Execute then
|
---|
| 274 | begin
|
---|
| 275 | if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
|
---|
| 276 | exit;
|
---|
| 277 |
|
---|
| 278 | aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
|
---|
| 279 | if not FileExists(aff) then
|
---|
| 280 | begin
|
---|
| 281 | ShowMessage(TX_AFF_NOT_FOUND);
|
---|
| 282 | OpenDialog1.FileName := '';
|
---|
| 283 | btnSelectDictClick(self);
|
---|
| 284 | end
|
---|
| 285 | else
|
---|
| 286 | begin
|
---|
| 287 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
| 288 | SpellCheck1.AbortSpellCheck(False);
|
---|
| 289 | edtDictionary.Text := OpenDialog1.FileName;
|
---|
| 290 | SpellCheck1.DictionaryFileName := edtDictionary.Text;
|
---|
| 291 | SpellCheck1.AffixFileName := aff;
|
---|
| 292 | SpellCheck1.Open;
|
---|
| 293 | end;
|
---|
| 294 | end;
|
---|
| 295 | end;
|
---|
| 296 |
|
---|
| 297 | procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
|
---|
| 298 | begin
|
---|
| 299 | inherited;
|
---|
| 300 | SpellCheck1.Undo;
|
---|
| 301 | end;
|
---|
| 302 |
|
---|
[1718] | 303 | procedure TfrmHunSpell.cbIgnoreAllCapsClick(Sender: TObject);
|
---|
| 304 | begin
|
---|
| 305 | if SpellCheck1.IgnoreAllCaps <> cbIgnoreAllCaps.Checked then
|
---|
| 306 | SpellCheck1.IgnoreAllCaps := cbIgnoreAllCaps.Checked;
|
---|
| 307 | end;
|
---|
| 308 |
|
---|
| 309 | procedure TfrmHunSpell.cbIgnoreDigitClick(Sender: TObject);
|
---|
| 310 | begin
|
---|
| 311 | if SpellCheck1.IgnoreWordWithDigits <> cbIgnoreDigit.Checked then
|
---|
| 312 | SpellCheck1.IgnoreWordWithDigits := cbIgnoreDigit.Checked;
|
---|
| 313 | end;
|
---|
| 314 |
|
---|
[1715] | 315 | procedure TfrmHunSpell.edtDictionaryEnter(Sender: TObject);
|
---|
| 316 | begin
|
---|
| 317 | btnSelectDict.SetFocus;
|
---|
| 318 | end;
|
---|
| 319 |
|
---|
| 320 | procedure TfrmHunSpell.FormActivate(Sender: TObject);
|
---|
| 321 | begin
|
---|
| 322 | if ( not SpellCheck1.Active) and (not NoEngineOpted) then
|
---|
| 323 | begin
|
---|
| 324 | btnSelectDictClick(self);
|
---|
| 325 | NoEngineOpted := True;
|
---|
| 326 | end;
|
---|
[1718] | 327 |
|
---|
| 328 | if cbIgnoreAllCaps.Checked <> SpellCheck1.IgnoreAllCaps then
|
---|
| 329 | cbIgnoreAllCaps.Checked := SpellCheck1.IgnoreAllCaps;
|
---|
| 330 |
|
---|
| 331 | if cbIgnoreDigit.Checked <> SpellCheck1.IgnoreWordWithDigits then
|
---|
| 332 | cbIgnoreDigit.Checked := SpellCheck1.IgnoreWordWithDigits;
|
---|
[1715] | 333 | end;
|
---|
| 334 |
|
---|
| 335 | procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 336 | begin
|
---|
| 337 | { if SpellCheck1.SpellCheckState = ssCompleted then
|
---|
| 338 | begin
|
---|
| 339 | ShowMessage(TX_SPELL_COMPLETE) ;
|
---|
| 340 | if Assigned(FSourceControl) then
|
---|
| 341 | FSourceControl.Text := RichEdit1.Text;
|
---|
| 342 | end
|
---|
| 343 | else
|
---|
| 344 | ShowMessage(TX_SPELL_CANCELLED) ; }
|
---|
| 345 | end;
|
---|
| 346 |
|
---|
[1718] | 347 | procedure TfrmHunSpell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
| 348 | begin
|
---|
| 349 | CanClose := (SpellCheck1.SpellCheckState <> ssChecking)
|
---|
| 350 | or (SpellCheck1.AbortSpellCheck(True));
|
---|
| 351 | if CanClose then
|
---|
| 352 | ModalResult := mrCancel;
|
---|
| 353 | end;
|
---|
| 354 |
|
---|
[1715] | 355 | procedure TfrmHunSpell.FormCreate(Sender: TObject);
|
---|
| 356 | var
|
---|
| 357 | dicFile: String;
|
---|
| 358 | function affFile: String;
|
---|
| 359 | begin
|
---|
| 360 | Result := ChangeFileExt(dicFile, '.aff');
|
---|
| 361 | end;
|
---|
| 362 | begin
|
---|
| 363 | if (SpellCheck1.DictionaryFileName <> '') then
|
---|
| 364 | dicFile := SpellCheck1.DictionaryFileName
|
---|
| 365 | else
|
---|
| 366 | dicFile := ExtractFilePath(Application.ExeName)+ DefaultDicFile;
|
---|
| 367 |
|
---|
| 368 | if (FileExists(dicFile)) and (FileExists(affFile)) then
|
---|
| 369 | begin
|
---|
| 370 | SpellCheck1.AffixFileName := affFile;
|
---|
| 371 | edtDictionary.Text := SpellCheck1.DictionaryFileName;
|
---|
| 372 | end
|
---|
| 373 | else
|
---|
| 374 | edtDictionary.Text := TX_Dic_File_Not_Found;
|
---|
| 375 |
|
---|
| 376 | if edtDictionary.Text = TX_Dic_File_Not_Found then
|
---|
| 377 | btnSelectDictClick(self);
|
---|
| 378 | // SpellCheck1.SourceTextControl := RichEdit1;
|
---|
| 379 | // SpellCheck1.SuggestionList := lstSuggestions;
|
---|
| 380 | //SpellCheck1.MisSpeltWord := Edit2;
|
---|
| 381 | SpellCheck1.Active := (SpellCheck1.DictionaryFileName <> '')
|
---|
| 382 | and FileExists(dicFile);
|
---|
| 383 | UpdateGUI;
|
---|
| 384 | end;
|
---|
| 385 |
|
---|
| 386 |
|
---|
| 387 |
|
---|
| 388 | end.
|
---|
| 389 |
|
---|