source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fHanSpell.pas@ 1722

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 6.2 KB
Line 
1unit fHanSpell;
2{Copyright © 2008, Gary Darby, www.DelphiForFun.org
3 This program may be used or modified for any non-commercial purpose
4 so long as this original notice remains in place.
5 All other rights are reserved
6 }
7
8{A program to quickly highlight a predefined set of words with specified colors
9in a RichEdit control. Technique to intercept WindowProc is converted from
10Basic code provided by Emile Tredoux to Delphi.
11}
12
13interface
14
15uses
16 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
17 StdCtrls, ComCtrls, RichEdit, Buttons, ExtCtrls, ShellAPI,
18 skaSpellCheck,
19 VA508AccessibilityManager, fBase508Form;
20
21type
22 TfrmHunSpell = class(TfrmBase508Form)
23 lblDictionary: TLabel;
24 btnClose: TButton;
25 OpenDialog1: TOpenDialog;
26 SpellCheck1: TskaHunSpellChecker;
27 Edit1: TEdit;
28 btnSelectDict: TBitBtn;
29 Label3: TLabel;
30 Label2: TLabel;
31 RichEdit1: TRichEdit;
32 pnlMisSpelled: TPanel;
33 Label1: TLabel;
34 lstSuggestions: TListBox;
35 Label4: TLabel;
36 Edit2: TEdit;
37 btnAutoCorrect: TButton;
38 btnChangeAll: TButton;
39 btnChange: TButton;
40 btnAddToDictionary: TButton;
41 btnIgnoreAll: TButton;
42 btnIgnoreOnce: TButton;
43 btnCancel: TButton;
44 procedure FormCreate(Sender: TObject);
45 procedure btnIgnoreOnceClick(Sender: TObject);
46 procedure btnIgnoreAllClick(Sender: TObject);
47 procedure btnChangeClick(Sender: TObject);
48 procedure btnChangeAllClick(Sender: TObject);
49 procedure btnCloseClick(Sender: TObject);
50 procedure FormActivate(Sender: TObject);
51 procedure btnSelectDictClick(Sender: TObject);
52 procedure Edit1Enter(Sender: TObject);
53 procedure btnAutoCorrectClick(Sender: TObject);
54 procedure btnAddToDictionaryClick(Sender: TObject);
55 procedure FormShow(Sender: TObject);
56 procedure FormClose(Sender: TObject; var Action: TCloseAction);
57 procedure btnCancelClick(Sender: TObject);
58 private
59 { Private declarations }
60 NoEngineOpted: Boolean;
61 FSourceControl: TCustomMemo;
62 WaitForUser: Boolean;
63
64 public
65 { Public declarations }
66 Showhighlight:boolean;
67 highlightcolor:TColor;
68 HighLightList:TStringlist;
69 OldRichEditWndProc: {integer}pointer;
70 PRichEditWndProc:pointer;
71 class function DoHanSpellCheck(AnEditControl: TCustomMemo): TModalResult; static;
72 end;
73
74 var
75 frmHunSpell: TfrmHunSpell;
76
77implementation
78{$R *.DFM}
79
80 uses uSpell, VAUtils;
81
82class function TfrmHunSpell.DoHanSpellCheck(AnEditControl: TCustomMemo): TModalResult;
83var
84 frm: TfrmHunSpell;
85begin
86 Result := mrCancel;
87 frm:= TfrmHunSpell.create(Application);
88 try
89 frm.RichEdit1.Text:= AnEditControl.Text;
90 frm.FSourceControl := AnEditControl;
91 Result := frm.ShowModal;
92 finally
93 frm.Free;
94 end;
95end;
96
97 {************ HighLight ***********888}
98 procedure TfrmHunSpell.FormShow(Sender: TObject);
99begin
100 if SpellCheck1.SpellCheckState = ssNotStarted then
101 SpellCheck1.CheckSpelling;
102end;
103
104{************* FormCreate **********}
105procedure TfrmHunSpell.btnAddToDictionaryClick(Sender: TObject);
106begin
107 SpellCheck1.AddCustomWord;
108end;
109
110procedure TfrmHunSpell.btnAutoCorrectClick(Sender: TObject);
111begin
112 SpellCheck1.CorrectWithMyWord;
113end;
114
115procedure TfrmHunSpell.btnCancelClick(Sender: TObject);
116begin
117 if SpellCheck1.AbortSpellCheck(True) then
118 Close;
119end;
120
121procedure TfrmHunSpell.btnChangeAllClick(Sender: TObject);
122begin
123 SpellCheck1.ChangeAll;
124end;
125
126procedure TfrmHunSpell.btnChangeClick(Sender: TObject);
127begin
128 SpellCheck1.Change;
129end;
130
131procedure TfrmHunSpell.btnCloseClick(Sender: TObject);
132begin
133 close;
134end;
135
136procedure TfrmHunSpell.btnIgnoreAllClick(Sender: TObject);
137begin
138 SpellCheck1.IgnoreAll;
139end;
140
141procedure TfrmHunSpell.btnIgnoreOnceClick(Sender: TObject);
142begin
143 SpellCheck1.IgnoreOnce;
144end;
145
146procedure TfrmHunSpell.btnSelectDictClick(Sender: TObject);
147var
148 aff: String;
149begin
150 if OpenDialog1.Execute then
151 begin
152 if SpellCheck1.DictFileName = OpenDialog1.FileName then
153 exit;
154
155 aff := ChangeFileExt(OpenDialog1.FileName, '.aff');
156 if not FileExists(aff) then
157 begin
158 ShowMessage('Correspong AFF file named "'+ aff + '" not found!' + #13 + ' Specify dictionary file whose *.aff is also present in same directory.');
159 OpenDialog1.FileName := '';
160 btnSelectDictClick(self);
161 end
162 else
163 begin
164 if SpellCheck1.SpellCheckState = ssChecking then
165 SpellCheck1.AbortSpellCheck(False);
166 Edit1.Text := OpenDialog1.FileName;
167 SpellCheck1.DictFileName := OpenDialog1.FileName;
168 SpellCheck1.AffFileName := aff;
169 SpellCheck1.Open;
170 WaitForUser := False;
171 SpellCheck1.CheckSpelling;
172 end;
173 end;
174end;
175
176procedure TfrmHunSpell.Edit1Enter(Sender: TObject);
177begin
178 btnSelectDict.SetFocus;
179end;
180
181procedure TfrmHunSpell.FormActivate(Sender: TObject);
182begin
183 if ( not SpellCheck1.Active) and (not NoEngineOpted) then
184 begin
185 btnSelectDictClick(self);
186 NoEngineOpted := True;
187 end;
188end;
189
190procedure TfrmHunSpell.FormClose(Sender: TObject; var Action: TCloseAction);
191begin
192 if SpellCheck1.SpellCheckState = ssCompleted then
193 begin
194 ShowMsg(TX_SPELL_COMPLETE, TShow508MessageIcon(1), smbOK) ;
195 if Assigned(FSourceControl) then
196 FSourceControl.Text := RichEdit1.Text;
197 end
198 else
199 ShowMsg(TX_SPELL_CANCELLED + CRLF + TX_NO_CORRECTIONS,TShow508MessageIcon(1), smbOK) ;
200end;
201
202procedure TfrmHunSpell.FormCreate(Sender: TObject);
203begin
204 if FileExists(ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.dic')
205 and FileExists(ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.aff') then
206 begin
207 SpellCheck1.AffFileName := ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.aff';
208 SpellCheck1.DictFileName := ExtractFilePath(Application.ExeName)+'\dict\en-US-OpenMedSpel.dic';
209 Edit1.Text := SpellCheck1.DictFileName;
210 SpellCheck1.Active := True;
211 end
212 else
213 Edit1.Text := 'Dictionary File for SpellCheck Engine not found!';
214 SpellCheck1.SourceTextControl := RichEdit1;
215 SpellCheck1.SuggestionList := lstSuggestions;
216 SpellCheck1.HighlightEditControl := Edit2;
217 SpellCheck1.btnClose := btnClose;
218end;
219
220
221
222end.
Note: See TracBrowser for help on using the repository browser.