source: cprs/branches/HealthSevak-CPRS/CPRS-Lib/Hans SpellCheck/Demo/fGUIforSpellCheck.pas@ 1712

Last change on this file since 1712 was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch

File size: 8.8 KB
Line 
1unit fGUIforSpellCheck;
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
33interface
34
35uses
36 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
37 StdCtrls, ComCtrls, RichEdit, Buttons, ExtCtrls, ShellAPI,
38 skaSpellCheck,
39 VA508AccessibilityManager, fBase508Form;
40
41type
42 TfrmGUIforSpellCheck = class(TForm)
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 private
87 { Private declarations }
88 NoEngineOpted: Boolean;
89 FSourceControl: TCustomMemo;
90 WaitForUser: Boolean;
91 procedure GoToURL(const aURL: String);
92 public
93 { Public declarations }
94 Showhighlight:boolean;
95 highlightcolor:TColor;
96 HighLightList:TStringlist;
97 OldRichEditWndProc: {integer}pointer;
98 PRichEditWndProc:pointer;
99 class function DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult; static;
100 end;
101
102 var
103 frmGUIforSpellCheck: TfrmGUIforSpellCheck;
104
105implementation
106{$R *.DFM}
107
108 uses uSpell, VAUtils;
109
110class function TfrmGUIforSpellCheck.DoHunSpellCheck(AnEditControl: TCustomMemo): TModalResult;
111var
112 frm: TfrmGUIforSpellCheck;
113begin
114 Result := mrCancel;
115 frm:= TfrmGUIforSpellCheck.create(Application);
116 try
117 frm.RichEdit1.Text:= AnEditControl.Text;
118 frm.FSourceControl := AnEditControl;
119 Result := frm.ShowModal;
120 finally
121 frm.Free;
122 end;
123end;
124
125 {************ HighLight ***********888}
126 procedure TfrmGUIforSpellCheck.FormShow(Sender: TObject);
127begin
128 if SpellCheck1.SpellCheckState = ssNotStarted then
129 SpellCheck1.CheckSpelling;
130
131 try
132 if lstSuggestions.Count > 0 then
133 btnChange.SetFocus;
134 except
135
136 end;
137end;
138
139procedure TfrmGUIforSpellCheck.GoToURL(const aURL: String);
140begin
141if length(trim(aURL)) > 4 then
142 ShellExecute(Handle, 'open', PChar(aURL), '', '', SW_NORMAL);
143end;
144
145procedure TfrmGUIforSpellCheck.lblOpenMedURLClick(Sender: TObject);
146begin
147 inherited;
148 GoToURL(TLabel(sender).Caption);
149end;
150
151{************* FormCreate **********}
152procedure TfrmGUIforSpellCheck.btnAboutClick(Sender: TObject);
153begin
154 inherited;
155 pnlAbout.Show;
156 pnlAbout.BringToFront;
157end;
158
159procedure TfrmGUIforSpellCheck.btnAddToDictionaryClick(Sender: TObject);
160begin
161 SpellCheck1.AddCustomWord;
162end;
163
164procedure TfrmGUIforSpellCheck.btnReplaceWithClick(Sender: TObject);
165begin
166 SpellCheck1.CorrectWithMyWord;
167end;
168
169procedure TfrmGUIforSpellCheck.btnCancelClick(Sender: TObject);
170begin
171//popup 508 compliant confirmation/warning box if isModified
172 if SpellCheck1.AbortSpellCheck(False) then
173 begin
174 Close;
175 ModalResult := mrCancel;
176 end;
177end;
178
179procedure TfrmGUIforSpellCheck.btnChangeAllClick(Sender: TObject);
180begin
181 SpellCheck1.ChangeAll;
182end;
183
184procedure TfrmGUIforSpellCheck.btnChangeClick(Sender: TObject);
185begin
186 SpellCheck1.Change;
187end;
188
189procedure TfrmGUIforSpellCheck.btnCloseClick(Sender: TObject);
190begin
191 close;
192end;
193
194procedure TfrmGUIforSpellCheck.btnIgnoreAllClick(Sender: TObject);
195begin
196 SpellCheck1.IgnoreAll;
197end;
198
199procedure TfrmGUIforSpellCheck.btnIgnoreOnceClick(Sender: TObject);
200begin
201 SpellCheck1.IgnoreOnce;
202end;
203
204procedure TfrmGUIforSpellCheck.btnSelectDictClick(Sender: TObject);
205var
206 aff: String;
207begin
208 if OpenDialog1.Execute then
209 begin
210 if SpellCheck1.DictionaryFileName = OpenDialog1.FileName then
211 exit;
212
213 aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
214 if not FileExists(aff) then
215 begin
216 ShowMessage('Correspong AFF file named "'+ aff + '" not found!' + #13 + ' Specify dictionary file whose *.aff is also present in same directory.');
217 OpenDialog1.FileName := '';
218 btnSelectDictClick(self);
219 end
220 else
221 begin
222 if SpellCheck1.SpellCheckState = ssChecking then
223 SpellCheck1.AbortSpellCheck(False);
224 Edit1.Text := OpenDialog1.FileName;
225 SpellCheck1.DictionaryFileName := OpenDialog1.FileName;
226 SpellCheck1.AffixFileName := aff;
227 SpellCheck1.Open;
228 WaitForUser := False;
229 SpellCheck1.CheckSpelling;
230 end;
231 end;
232end;
233
234procedure TfrmGUIforSpellCheck.btnUndoClick(Sender: TObject);
235begin
236 inherited;
237 SpellCheck1.Undo;
238end;
239
240procedure TfrmGUIforSpellCheck.Button1Click(Sender: TObject);
241begin
242 inherited;
243 pnlAbout.hide;
244end;
245
246procedure TfrmGUIforSpellCheck.Edit1Enter(Sender: TObject);
247begin
248 btnSelectDict.SetFocus;
249end;
250
251procedure TfrmGUIforSpellCheck.FormActivate(Sender: TObject);
252begin
253 if ( not SpellCheck1.Active) and (not NoEngineOpted) then
254 begin
255 btnSelectDictClick(self);
256 NoEngineOpted := True;
257 end;
258end;
259
260procedure TfrmGUIforSpellCheck.FormClose(Sender: TObject; var Action: TCloseAction);
261begin
262 if SpellCheck1.SpellCheckState = ssCompleted then
263 begin
264 ShowMsg(TX_SPELL_COMPLETE, TShow508MessageIcon(1), smbOK) ;
265 if Assigned(FSourceControl) then
266 FSourceControl.Text := RichEdit1.Text;
267 end
268 else
269 ShowMsg(TX_SPELL_CANCELLED + CRLF + TX_NO_CORRECTIONS,TShow508MessageIcon(1), smbOK) ;
270end;
271
272procedure TfrmGUIforSpellCheck.FormCreate(Sender: TObject);
273begin
274 if FileExists(ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.dic')
275 and FileExists(ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.aff') then
276 begin
277 SpellCheck1.AffixFileName := ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.aff';
278 SpellCheck1.DictionaryFileName := ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.dic';
279 Edit1.Text := SpellCheck1.DictionaryFileName;
280 SpellCheck1.Active := True;
281 end
282 else
283 Edit1.Text := 'Dictionary File for SpellCheck Engine not found!';
284
285 SpellCheck1.SourceTextControl := RichEdit1;
286 SpellCheck1.SuggestionList := lstSuggestions;
287 SpellCheck1.MisSpeltWord := Edit2;
288 SpellCheck1.btnClose := btnClose;
289end;
290
291
292
293end.
Note: See TracBrowser for help on using the repository browser.