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 | VA508AccessibilityManager, fBase508Form;
|
---|
40 |
|
---|
41 | type
|
---|
42 | TfrmHunSpell = class(TfrmBase508Form)
|
---|
43 | lblDictionary: TLabel;
|
---|
44 | btnClose: TButton;
|
---|
45 | OpenDialog1: TOpenDialog;
|
---|
46 | SpellCheck1: TskaHunSpellChecker;
|
---|
47 | Edit1: TEdit;
|
---|
48 | btnSelectDict: TBitBtn;
|
---|
49 | lblOpenMedURL: TLabel;
|
---|
50 | lblDictionariesURL: TLabel;
|
---|
51 | RichEdit1: TRichEdit;
|
---|
52 | pnlMisSpelled: TPanel;
|
---|
53 | Label1: TLabel;
|
---|
54 | lstSuggestions: TListBox;
|
---|
55 | Label4: TLabel;
|
---|
56 | Edit2: TEdit;
|
---|
57 | btnReplaceWith: TButton;
|
---|
58 | btnChangeAll: TButton;
|
---|
59 | btnChange: TButton;
|
---|
60 | btnAddToDictionary: TButton;
|
---|
61 | btnIgnoreAll: TButton;
|
---|
62 | btnIgnoreOnce: TButton;
|
---|
63 | btnCancel: TButton;
|
---|
64 | btnAbout: TButton;
|
---|
65 | pnlAbout: TPanel;
|
---|
66 | Button1: TButton;
|
---|
67 | btnUndo: TButton;
|
---|
68 | procedure FormCreate(Sender: TObject);
|
---|
69 | procedure btnIgnoreOnceClick(Sender: TObject);
|
---|
70 | procedure btnIgnoreAllClick(Sender: TObject);
|
---|
71 | procedure btnChangeClick(Sender: TObject);
|
---|
72 | procedure btnChangeAllClick(Sender: TObject);
|
---|
73 | procedure btnCloseClick(Sender: TObject);
|
---|
74 | procedure FormActivate(Sender: TObject);
|
---|
75 | procedure btnSelectDictClick(Sender: TObject);
|
---|
76 | procedure Edit1Enter(Sender: TObject);
|
---|
77 | procedure btnReplaceWithClick(Sender: TObject);
|
---|
78 | procedure btnAddToDictionaryClick(Sender: TObject);
|
---|
79 | procedure FormShow(Sender: TObject);
|
---|
80 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
81 | procedure btnCancelClick(Sender: TObject);
|
---|
82 | procedure lblOpenMedURLClick(Sender: TObject);
|
---|
83 | procedure btnAboutClick(Sender: TObject);
|
---|
84 | procedure Button1Click(Sender: TObject);
|
---|
85 | procedure btnUndoClick(Sender: TObject);
|
---|
86 | procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
|
---|
87 | Shift: TShiftState);
|
---|
88 | procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
|
---|
89 | Shift: TShiftState);
|
---|
90 | private
|
---|
91 | { Private declarations }
|
---|
92 | NoEngineOpted: Boolean;
|
---|
93 | FSourceControl: TCustomMemo;
|
---|
94 | WaitForUser: Boolean;
|
---|
95 | procedure GoToURL(const aURL: String);
|
---|
96 | public
|
---|
97 | { Public declarations }
|
---|
98 | Showhighlight:boolean;
|
---|
99 | highlightcolor:TColor;
|
---|
100 | HighLightList:TStringlist;
|
---|
101 | OldRichEditWndProc: {integer}pointer;
|
---|
102 | PRichEditWndProc:pointer;
|
---|
103 | class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult; static;
|
---|
104 | end;
|
---|
105 |
|
---|
106 | var
|
---|
107 | frmHunSpell: TfrmHunSpell;
|
---|
108 |
|
---|
109 | implementation
|
---|
110 | {$R *.DFM}
|
---|
111 |
|
---|
112 | uses uSpell, VAUtils;
|
---|
113 |
|
---|
114 | class function TfrmHunSpell.DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
|
---|
115 | var
|
---|
116 | frm: TfrmHunSpell;
|
---|
117 | begin
|
---|
118 | Result := mrCancel;
|
---|
119 | frm:= TfrmHunSpell.create(Application);
|
---|
120 | try
|
---|
121 | frm.RichEdit1.Text:= AnEditControl.Text;
|
---|
122 | frm.FSourceControl := AnEditControl;
|
---|
123 | Result := frm.ShowModal;
|
---|
124 | finally
|
---|
125 | frm.Free;
|
---|
126 | end;
|
---|
127 | end;
|
---|
128 |
|
---|
129 | {************ HighLight ***********888}
|
---|
130 | procedure TfrmHunSpell.FormShow(Sender: TObject);
|
---|
131 | begin
|
---|
132 | if SpellCheck1.SpellCheckState = ssNotStarted then
|
---|
133 | SpellCheck1.CheckSpelling;
|
---|
134 |
|
---|
135 | try
|
---|
136 | if lstSuggestions.Count > 0 then
|
---|
137 | btnChange.SetFocus;
|
---|
138 | except
|
---|
139 |
|
---|
140 | end;
|
---|
141 | end;
|
---|
142 |
|
---|
143 | procedure TfrmHunSpell.GoToURL(const aURL: String);
|
---|
144 | begin
|
---|
145 | if length(trim(aURL)) > 4 then
|
---|
146 | ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
|
---|
147 | end;
|
---|
148 |
|
---|
149 | procedure TfrmHunSpell.lblOpenMedURLClick(Sender: TObject);
|
---|
150 | begin
|
---|
151 | inherited;
|
---|
152 | GoToURL(TLabel(sender).Caption);
|
---|
153 | end;
|
---|
154 |
|
---|
155 | procedure TfrmHunSpell.RichEdit1KeyDown(Sender: TObject; var Key: Word;
|
---|
156 | Shift: TShiftState);
|
---|
157 | begin
|
---|
158 | inherited;
|
---|
159 | SpellCheck1.ManualChangeStart;
|
---|
160 | end;
|
---|
161 |
|
---|
162 | procedure TfrmHunSpell.RichEdit1KeyUp(Sender: TObject; var Key: Word;
|
---|
163 | Shift: TShiftState);
|
---|
164 | begin
|
---|
165 | inherited;
|
---|
166 | SpellCheck1.ManualChangeDone;
|
---|
167 | end;
|
---|
168 |
|
---|
169 | {************* FormCreate **********}
|
---|
170 | procedure TfrmHunSpell.btnAboutClick(Sender: TObject);
|
---|
171 | begin
|
---|
172 | inherited;
|
---|
173 | pnlAbout.Show;
|
---|
174 | pnlAbout.BringToFront;
|
---|
175 | end;
|
---|
176 |
|
---|
177 | procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
|
---|
178 | begin
|
---|
179 | SpellCheck1.AddCustomWord;
|
---|
180 | end;
|
---|
181 |
|
---|
182 | procedure TfrmHunSpell.btnReplaceWithClick(Sender: TObject);
|
---|
183 | begin
|
---|
184 | SpellCheck1.CorrectWithMyWord;
|
---|
185 | end;
|
---|
186 |
|
---|
187 | procedure TfrmHunSpell.btnCancelClick(Sender: TObject);
|
---|
188 | begin
|
---|
189 | //popup 508 compliant confirmation/warning box if isModified
|
---|
190 | if SpellCheck1.AbortSpellCheck(False) then
|
---|
191 | begin
|
---|
192 | Close;
|
---|
193 | ModalResult := mrCancel;
|
---|
194 | end;
|
---|
195 | end;
|
---|
196 |
|
---|
197 | procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
|
---|
198 | begin
|
---|
199 | SpellCheck1.ChangeAll;
|
---|
200 | end;
|
---|
201 |
|
---|
202 | procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
|
---|
203 | begin
|
---|
204 | SpellCheck1.Change;
|
---|
205 | end;
|
---|
206 |
|
---|
207 | procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
|
---|
208 | begin
|
---|
209 | close;
|
---|
210 | end;
|
---|
211 |
|
---|
212 | procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
|
---|
213 | begin
|
---|
214 | SpellCheck1.IgnoreAll;
|
---|
215 | end;
|
---|
216 |
|
---|
217 | procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
|
---|
218 | begin
|
---|
219 | SpellCheck1.IgnoreOnce;
|
---|
220 | end;
|
---|
221 |
|
---|
222 | procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
|
---|
223 | var
|
---|
224 | aff: String;
|
---|
225 | begin
|
---|
226 | if OpenDialog1.Execute then
|
---|
227 | begin
|
---|
228 | if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
|
---|
229 | exit;
|
---|
230 |
|
---|
231 | aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
|
---|
232 | if not FileExists(aff) then
|
---|
233 | begin
|
---|
234 | ShowMessage('Correspong AFF file named "'+ aff + '" not found!' + #13 + ' Specify dictionary file whose *.aff is also present in same directory.');
|
---|
235 | OpenDialog1.FileName := '';
|
---|
236 | btnSelectDictClick(self);
|
---|
237 | end
|
---|
238 | else
|
---|
239 | begin
|
---|
240 | if SpellCheck1.SpellCheckState = ssChecking then
|
---|
241 | SpellCheck1.AbortSpellCheck(False);
|
---|
242 | Edit1.Text := OpenDialog1.FileName;
|
---|
243 | SpellCheck1.DictionaryFileName := OpenDialog1.FileName;
|
---|
244 | SpellCheck1.AffixFileName := aff;
|
---|
245 | SpellCheck1.Open;
|
---|
246 | WaitForUser := False;
|
---|
247 | SpellCheck1.CheckSpelling;
|
---|
248 | end;
|
---|
249 | end;
|
---|
250 | end;
|
---|
251 |
|
---|
252 | procedure TfrmHunSpell.btnUndoClick(Sender: TObject);
|
---|
253 | begin
|
---|
254 | inherited;
|
---|
255 | SpellCheck1.Undo;
|
---|
256 | end;
|
---|
257 |
|
---|
258 | procedure TfrmHunSpell.Button1Click(Sender: TObject);
|
---|
259 | begin
|
---|
260 | inherited;
|
---|
261 | pnlAbout.hide;
|
---|
262 | end;
|
---|
263 |
|
---|
264 | procedure TfrmHunSpell.Edit1Enter(Sender: TObject);
|
---|
265 | begin
|
---|
266 | btnSelectDict.SetFocus;
|
---|
267 | end;
|
---|
268 |
|
---|
269 | procedure TfrmHunSpell.FormActivate(Sender: TObject);
|
---|
270 | begin
|
---|
271 | if ( not SpellCheck1.Active) and (not NoEngineOpted) then
|
---|
272 | begin
|
---|
273 | btnSelectDictClick(self);
|
---|
274 | NoEngineOpted := True;
|
---|
275 | end;
|
---|
276 | end;
|
---|
277 |
|
---|
278 | procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
279 | begin
|
---|
280 | if SpellCheck1.SpellCheckState = ssCompleted then
|
---|
281 | begin
|
---|
282 | ShowMsg(TX_SPELL_COMPLETE, TShow508MessageIcon(1), smbOK) ;
|
---|
283 | if Assigned(FSourceControl) then
|
---|
284 | FSourceControl.Text := RichEdit1.Text;
|
---|
285 | end
|
---|
286 | else
|
---|
287 | ShowMsg(TX_SPELL_CANCELLED + CRLF + TX_NO_CORRECTIONS,TShow508MessageIcon(1), smbOK) ;
|
---|
288 | end;
|
---|
289 |
|
---|
290 | procedure TfrmHunSpell.FormCreate(Sender: TObject);
|
---|
291 | begin
|
---|
292 | if FileExists(ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.dic')
|
---|
293 | and FileExists(ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.aff') then
|
---|
294 | begin
|
---|
295 | SpellCheck1.AffixFileName := ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.aff';
|
---|
296 | SpellCheck1.DictionaryFileName := ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.dic';
|
---|
297 | Edit1.Text := SpellCheck1.DictionaryFileName;
|
---|
298 | SpellCheck1.Active := True;
|
---|
299 | end
|
---|
300 | else
|
---|
301 | Edit1.Text := 'Dictionary File for SpellCheck Engine not found!';
|
---|
302 |
|
---|
303 | SpellCheck1.SourceTextControl := RichEdit1;
|
---|
304 | SpellCheck1.SuggestionList := lstSuggestions;
|
---|
305 | SpellCheck1.MisSpeltWord := Edit2;
|
---|
306 | SpellCheck1.btnClose := btnClose;
|
---|
307 | end;
|
---|
308 |
|
---|
309 |
|
---|
310 |
|
---|
311 | end.
|
---|