Author: Mike Heydon
VCL MS Word Spell Check and Thesaurus
Answer:
This is the VCL for Spell Checking and Synonyms using MS Word COM interface. It can
correct and replace words in a Text String,TMemo or TRichEdit using a built in
replacement editor, or can be controlled by user dialog. I see there are other
callable functions in the interface, which I have not implemented. Anyone see a use
for any of them ?.
They are ...
property PartOfSpeechList: OleVariant read Get_PartOfSpeechList;
property AntonymList: OleVariant read Get_AntonymList;
property RelatedExpressionList: OleVariant read Get_RelatedExpressionList;
property RelatedWordList: OleVariant read Get_RelatedWordList;
Example of checking and changing a Memo text ...
SpellCheck.CheckMemoTextSpelling(Memo1);
Properties
----------------
LetterChars - Characters considered to be letters. default is
['A'..'Z','a'..'z'] (English) but could be
changed to
['A'..'Z','a'..'z','á','é','í','ó','ú']
(Spanish)
Color - Backgound color of Default dialog Editbox and Listbox
CompletedMessage - Enable/Disable display of completed and count message dialog
Font - Font of Default dialog Editbox and Listbox
Language - Language used by GetSynonyms() method
ReplaceDialog - Use Default replace dialog or User defined (see events)
Active - Readonly, set at create time. Indicates if MS Word is
available
Methods
----------------
function GetSynonyms(StrWord : string; Synonyms : TStrings) : boolean;
True if synonyms found for StrWord. Synonyms List is
returned in TStrings (Synonyms).
function CheckWordSpelling(StrWord : string; Suggestions : TStrings) : boolean;
True if StrWord is spelt correctly. Suggested corrections
returned in TStrings (Suggestions)
procedure CheckTextSpelling(var StrText : string);
Proccesses string StrText and allows users to change
mispelt words via a Default replacement dialog or User
defined calls. Words are changed and returned in StrText.
Words in the text are changed automatically by the Default
editor. Use the events if you want to control the dialog
yourself. ie. Get the mispelt word, give a choice of
sugesstions (BeforeCorrection), Change the word to
corrected (OnCorrection) and possibly display "Was/Now"
(AfterCorrection)
procedure CheckRichTextSpelling(RichEdit : TRichEdit);
Corrects misspelt words directly in TRichEdit.Text.
Rich Format is maintained.
procedure CheckMemoTextSpelling(Memo : TMemo);
Corrects misspelt words directly into a TMemo.Text.
Events (Mainly used when ReplaceDialog = repUser)
--------------------------------------------------------------------------------
BeforeCorrection - Supplies the mispelt word along with a TStrings
var containing suggested corrections.
OnCorrection - Supplies the mispelt word as a VAR type allowing
user to change it to desired word. The word will be
replaced by this variable in the passed StrText.
AfterCorrection - Supplies the mispelt word and what it has been
changed to.
1 unit SpellChk;
2 interface
3
4 // =============================================================================
5 // MS Word COM Interface to Spell Check and Synonyms
6 // Mike Heydon Dec 2000
7 // mheydon@pgbison.co.za
8 // =============================================================================
9
10 uses Windows, SysUtils, Classes, ComObj, Dialogs, Forms, StdCtrls,
11 Controls, Buttons, Graphics, ComCtrls, Variants;
12
13 // Above uses Variants is for Delphi 6 - remove for Delphi 5 and less
14
15 type
16 // Event definitions
17 TSpellCheckBeforeCorrection = procedure(Sender: TObject;
18 MispeltWord: string;
19 Suggestions: TStrings) of object;
20
21 TSpellCheckAfterCorrection = procedure(Sender: TObject;
22 MispeltWord: string;
23 CorrectedWord: string) of object;
24
25 TSpellCheckOnCorrection = procedure(Sender: TObject;
26 var WordToCorrect: string) of object;
27
28 // Property types
29 TSpellCheckReplacement = (repDefault, repUser);
30 TSpellCheckLetters = set of char;
31
32 TSpellCheckLanguage = (wdLanguageNone, wdNoProofing, wdDanish, wdGerman,
33 wdSwissGerman, wdEnglishAUS, wdEnglishUK, wdEnglishUS,
34 wdEnglishCanadian, wdEnglishNewZealand,
35 wdEnglishSouthAfrica, wdSpanish, wdFrench,
36 wdFrenchCanadian, wdItalian, wdDutch, wdNorwegianBokmol,
37 wdNorwegianNynorsk, wdBrazilianPortuguese,
38 wdPortuguese, wdFinnish, wdSwedish, wdCatalan, wdGreek,
39 wdTurkish, wdRussian, wdCzech, wdHungarian, wdPolish,
40 wdSlovenian, wdBasque, wdMalaysian, wdJapanese, wdKorean,
41 wdSimplifiedChinese, wdTraditionalChinese,
42 wdSwissFrench, wdSesotho, wdTsonga, wdTswana, wdVenda,
43 wdXhosa, wdZulu, wdAfrikaans, wdArabic, wdHebrew,
44 wdSlovak, wdFarsi, wdRomanian, wdCroatian, wdUkrainian,
45 wdByelorussian, wdEstonian, wdLatvian, wdMacedonian,
46 wdSerbianLatin, wdSerbianCyrillic, wdIcelandic,
47 wdBelgianFrench, wdBelgianDutch, wdBulgarian,
48 wdMexicanSpanish, wdSpanishModernSort, wdSwissItalian);
49
50 // Main TSpellcheck Class
51 TSpellCheck = class(TComponent)
52 private
53 MsWordApp,
54 MsSuggestions: OleVariant;
55 FLetterChars: TSpellCheckLetters;
56 FFont: TFont;
57 FColor: TColor;
58 FReplaceDialog: TSpellCheckReplacement;
59 FCompletedMessage,
60 FActive: boolean;
61 FLanguage: TSpellCheckLanguage;
62 FForm: TForm;
63 FEbox: TEdit;
64 FLbox: TListBox;
65 FCancelBtn,
66 FChangeBtn: TBitBtn;
67 FBeforeCorrection: TSpellCheckBeforeCorrection;
68 FAfterCorrection: TSpellCheckAfterCorrection;
69 FOnCorrection: TSpellCheckOnCorrection;
70 procedure SetFFont(NewValue: TFont);
71 protected
72 procedure MakeForm;
73 procedure CloseForm;
74 procedure SuggestedClick(Sender: TObject);
75 public
76 constructor Create(AOwner: TComponent); override;
77 destructor Destroy; override;
78 function GetSynonyms(StrWord: string; Synonyms: TStrings): boolean;
79 function CheckWordSpelling(StrWord: string;
80 Suggestions: TStrings): boolean;
81 procedure CheckTextSpelling(var StrText: string);
82 procedure CheckRichTextSpelling(RichEdit: TRichEdit);
83 procedure CheckMemoTextSpelling(Memo: TMemo);
84 procedure Anagrams(const InString: string; StringList: TStrings);
85 property Active: boolean read FActive;
86 property LetterChars: TSpellCheckletters read FLetterChars write FLetterChars;
87 published
88 property Language: TSpellCheckLanguage read FLanguage
89 write FLanguage;
90 property CompletedMessage: boolean read FCompletedMessage
91 write FCompletedMessage;
92 property Color: TColor read FColor write FColor;
93 property Font: TFont read FFont write SetFFont;
94 property BeforeCorrection: TSpellCheckBeforeCorrection
95 read FBeforeCorrection
96 write FBeforeCorrection;
97 property AfterCorrection: TSpellCheckAfterCorrection
98 read FAfterCorrection
99 write FAfterCorrection;
100 property OnCorrection: TSpellCheckOnCorrection
101 read FOnCorrection
102 write FOnCorrection;
103 property ReplaceDialog: TSpellCheckReplacement
104 read FReplaceDialog
105 write FReplaceDialog;
106 end;
107
108 procedure register;
109
110 // -----------------------------------------------------------------------------
111 implementation
112
113 // Mapped Hex values for ord(FLanguage)
114 const
115
116 LanguageArray: array[0..63] of integer =
117 ($0, $400, $406, $407, $807, $C09, $809, $409,
118 $1009, $1409, $1C09, $40A, $40C, $C0C, $410,
119 $413, $414, $814, $416, $816, $40B, $41D, $403,
120 $408, $41F, $419, $405, $40E, $415, $424, $42D,
121 $43E, $411, $412, $804, $404, $100C, $430, $431,
122 $432, $433, $434, $435, $436, $401, $40D, $41B,
123 $429, $418, $41A, $422, $423, $425, $426, $42F,
124 $81A, $C1A, $40F, $80C, $813, $402, $80A, $C0A, $810);
125
126 // Change to Component Pallete of choice
127
128 procedure register;
129 begin
130 RegisterComponents('MahExtra', [TSpellCheck]);
131 end;
132
133 // TSpellCheck
134
135 constructor TSpellCheck.Create(AOwner: TComponent);
136 begin
137 inherited Create(AOwner);
138 // Defaults
139 FLetterChars := ['A'..'Z', 'a'..'z'];
140 FCompletedMessage := true;
141 FColor := clWindow;
142 FFont := TFont.Create;
143 FReplaceDialog := repDefault;
144 FLanguage := wdEnglishUS;
145
146 // Don't create an ole server at design time
147 if not (csDesigning in ComponentState) then
148 begin
149 try
150 MsWordApp := CreateOleObject('Word.Application');
151 FActive := true;
152 MsWordApp.Documents.Add;
153 except
154 on E: Exception do
155 begin
156 // MessageDlg('Cannot Connect to MS Word',mtError,[mbOk],0);
157 // Activate above if visual failure required
158 FActive := false;
159 end;
160 end;
161 end;
162 end;
163
164 destructor TSpellCheck.Destroy;
165 begin
166 FFont.Free;
167
168 if FActive and not (csDesigning in ComponentState) then
169 begin
170 MsWordApp.Quit;
171 MsWordApp := VarNull;
172 end;
173
174 inherited Destroy;
175 end;
176
177 // ======================================
178 // Property Get/Set methods
179 // ======================================
180
181 procedure TSpellCheck.SetFFont(NewValue: TFont);
182 begin
183 FFont.Assign(NewValue);
184 end;
185
186 // ===========================================
187 // Return a list of synonyms for single word
188 // ===========================================
189
190 function TSpellCheck.GetSynonyms(StrWord: string;
191 Synonyms: TStrings): boolean;
192 var
193 SynInfo: OleVariant;
194 i, j: integer;
195 TS: OleVariant;
196 Retvar: boolean;
197 begin
198 Synonyms.Clear;
199
200 if FActive then
201 begin
202 SynInfo := MsWordApp.SynonymInfo[StrWord,
203 LanguageArray[ord(FLanguage)]];
204 for i := 1 to SynInfo.MeaningCount do
205 begin
206 TS := SynInfo.SynonymList[i];
207 for j := VarArrayLowBound(TS, 1) to VarArrayHighBound(TS, 1) do
208 Synonyms.Add(TS[j]);
209 end;
210
211 RetVar := SynInfo.Found;
212 end
213 else
214 RetVar := false;
215
216 Result := RetVar;
217 end;
218
219 // =======================================
220 // Check the spelling of a single word
221 // Suggestions returned in TStrings
222 // =======================================
223
224 function TSpellCheck.CheckWordSpelling(StrWord: string;
225 Suggestions: TStrings): boolean;
226 var
227 Retvar: boolean;
228 i: integer;
229 begin
230 RetVar := false;
231 if Suggestions <> nil then
232 Suggestions.Clear;
233
234 if FActive then
235 begin
236 if MsWordApp.CheckSpelling(StrWord) then
237 RetVar := true
238 else
239 begin
240 if Suggestions <> nil then
241 begin
242 MsSuggestions := MsWordApp.GetSpellingSuggestions(StrWord);
243 for i := 1 to MsSuggestions.Count do
244 Suggestions.Add(MsSuggestions.Item(i));
245 MsSuggestions := VarNull;
246 end;
247 end;
248 end;
249
250 Result := RetVar;
251 end;
252
253 // ======================================================
254 // Check the spelling text of a string with option to
255 // Replace words. Correct string returned in var StrText
256 // ======================================================
257
258 procedure TSpellCheck.CheckTextSpelling(var StrText: string);
259 var
260 StartPos, CurPos,
261 WordsChanged: integer;
262 ChkWord, UserWord: string;
263 EoTxt: boolean;
264
265 procedure GetNextWordStart;
266 begin
267 ChkWord := '';
268 while (StartPos <= length(StrText)) and
269 (not (StrText[StartPos] in FLetterChars)) do
270 inc(StartPos);
271 CurPos := StartPos;
272 end;
273
274 begin
275 if FActive and (length(StrText) > 0) then
276 begin
277 MakeForm;
278 StartPos := 1;
279 EoTxt := false;
280 WordsChanged := 0;
281 GetNextWordStart;
282
283 while not EoTxt do
284 begin
285 // Is it a letter ?
286 if StrText[CurPos] in FLetterChars then
287 begin
288 ChkWord := ChkWord + StrText[CurPos];
289 inc(CurPos);
290 end
291 else
292 begin
293 // Word end found - check spelling
294 if not CheckWordSpelling(ChkWord, FLbox.Items) then
295 begin
296 if Assigned(FBeforeCorrection) then
297 FBeforeCorrection(self, ChkWord, FLbox.Items);
298
299 // Default replacement dialog
300 if FReplaceDialog = repDefault then
301 begin
302 FEbox.Text := ChkWord;
303 FForm.ShowModal;
304
305 if FForm.ModalResult = mrOk then
306 begin
307 // Change mispelt word
308 Delete(StrText, StartPos, length(ChkWord));
309 Insert(FEbox.Text, StrText, StartPos);
310 CurPos := StartPos + length(FEbox.Text);
311
312 if ChkWord <> FEbox.Text then
313 begin
314 inc(WordsChanged);
315 if Assigned(FAfterCorrection) then
316 FAfterCorrection(self, ChkWord, FEbox.Text);
317 end;
318 end
319 end
320 else
321 begin
322 // User defined replacemnt routine
323 UserWord := ChkWord;
324 if Assigned(FOnCorrection) then
325 FOnCorrection(self, UserWord);
326 Delete(StrText, StartPos, length(ChkWord));
327 Insert(UserWord, StrText, StartPos);
328 CurPos := StartPos + length(UserWord);
329
330 if ChkWord <> UserWord then
331 begin
332 inc(WordsChanged);
333 if Assigned(FAfterCorrection) then
334 FAfterCorrection(self, ChkWord, UserWord);
335 end;
336 end;
337 end;
338
339 StartPos := CurPos;
340 GetNextWordStart;
341 EoTxt := (StartPos > length(StrText));
342 end;
343 end;
344
345 CloseForm;
346 if FCompletedMessage then
347 MessageDlg('Spell Check Complete' + #13#10 +
348 IntToStr(WordsChanged) + ' words changed',
349 mtInformation, [mbOk], 0);
350 end
351 else if not FActive then
352 MessageDlg('Spell Check not Active', mtError, [mbOk], 0)
353 else if FCompletedMessage then
354 MessageDlg('Spell Check Complete' + #13#10 +
355 '0 words changed', mtInformation, [mbOk], 0);
356 end;
357
358 // =============================================================
359 // Check the spelling of RichText with option to
360 // Replace words (in situ replacement direct to RichEdit.Text)
361 // =============================================================
362
363 procedure TSpellCheck.CheckRichTextSpelling(RichEdit: TRichEdit);
364 var
365 StartPos, CurPos,
366 WordsChanged: integer;
367 StrText, ChkWord, UserWord: string;
368 SaveHide,
369 EoTxt: boolean;
370
371 procedure GetNextWordStart;
372 begin
373 ChkWord := '';
374 while (not (StrText[StartPos] in FLetterChars)) and
375 (StartPos <= length(StrText)) do
376 inc(StartPos);
377 CurPos := StartPos;
378 end;
379
380 begin
381 SaveHide := RichEdit.HideSelection;
382 RichEdit.HideSelection := false;
383 StrText := RichEdit.Text;
384 if FActive and (length(StrText) > 0) then
385 begin
386 MakeForm;
387 StartPos := 1;
388 EoTxt := false;
389 WordsChanged := 0;
390 GetNextWordStart;
391
392 while not EoTxt do
393 begin
394 // Is it a letter ?
395 if StrText[CurPos] in FLetterChars then
396 begin
397 ChkWord := ChkWord + StrText[CurPos];
398 inc(CurPos);
399 end
400 else
401 begin
402 // Word end found - check spelling
403 if not CheckWordSpelling(ChkWord, FLbox.Items) then
404 begin
405 if Assigned(FBeforeCorrection) then
406 FBeforeCorrection(self, ChkWord, FLbox.Items);
407
408 // Default replacement dialog
409 if FReplaceDialog = repDefault then
410 begin
411 FEbox.Text := ChkWord;
412 RichEdit.SelStart := StartPos - 1;
413 RichEdit.SelLength := length(ChkWord);
414 FForm.ShowModal;
415
416 if FForm.ModalResult = mrOk then
417 begin
418 // Change mispelt word
419 Delete(StrText, StartPos, length(ChkWord));
420 Insert(FEbox.Text, StrText, StartPos);
421 CurPos := StartPos + length(FEbox.Text);
422 RichEdit.SelText := FEbox.Text;
423
424 if ChkWord <> FEbox.Text then
425 begin
426 inc(WordsChanged);
427 if Assigned(FAfterCorrection) then
428 FAfterCorrection(self, ChkWord, FEbox.Text);
429 end;
430 end
431 end
432 else
433 begin
434 // User defined replacemnt routine
435 UserWord := ChkWord;
436 RichEdit.SelStart := StartPos - 1;
437 RichEdit.SelLength := length(ChkWord);
438 if Assigned(FOnCorrection) then
439 FOnCorrection(self, UserWord);
440 Delete(StrText, StartPos, length(ChkWord));
441 Insert(UserWord, StrText, StartPos);
442 CurPos := StartPos + length(UserWord);
443 RichEdit.SelText := UserWord;
444
445 if ChkWord <> UserWord then
446 begin
447 inc(WordsChanged);
448 if Assigned(FAfterCorrection) then
449 FAfterCorrection(self, ChkWord, UserWord);
450 end;
451 end;
452 end;
453
454 StartPos := CurPos;
455 GetNextWordStart;
456 EoTxt := (StartPos > length(StrText));
457 end;
458 end;
459
460 CloseForm;
461 RichEdit.HideSelection := SaveHide;
462 if FCompletedMessage then
463 MessageDlg('Spell Check Complete' + #13#10 +
464 IntToStr(WordsChanged) + ' words changed',
465 mtInformation, [mbOk], 0);
466 end
467 else if not FActive then
468 MessageDlg('Spell Check not Active', mtError, [mbOk], 0)
469 else if FCompletedMessage then
470 MessageDlg('Spell Check Complete' + #13#10 +
471 '0 words changed', mtInformation, [mbOk], 0);
472 end;
473
474 // =============================================================
475 // Check the spelling of Memo with option to
476 // Replace words (in situ replacement direct to Memo.Text)
477 // =============================================================
478
479 procedure TSpellCheck.CheckMemoTextSpelling(Memo: TMemo);
480 var
481 StartPos, CurPos,
482 WordsChanged: integer;
483 StrText, ChkWord, UserWord: string;
484 SaveHide,
485 EoTxt: boolean;
486
487 procedure GetNextWordStart;
488 begin
489 ChkWord := '';
490 while (not (StrText[StartPos] in FLetterChars)) and
491 (StartPos <= length(StrText)) do
492 inc(StartPos);
493 CurPos := StartPos;
494 end;
495
496 begin
497 SaveHide := Memo.HideSelection;
498 Memo.HideSelection := false;
499 StrText := Memo.Text;
500 if FActive and (length(StrText) > 0) then
501 begin
502 MakeForm;
503 StartPos := 1;
504 EoTxt := false;
505 WordsChanged := 0;
506 GetNextWordStart;
507
508 while not EoTxt do
509 begin
510 // Is it a letter ?
511 if StrText[CurPos] in FLetterChars then
512 begin
513 ChkWord := ChkWord + StrText[CurPos];
514 inc(CurPos);
515 end
516 else
517 begin
518 // Word end found - check spelling
519 if not CheckWordSpelling(ChkWord, FLbox.Items) then
520 begin
521 if Assigned(FBeforeCorrection) then
522 FBeforeCorrection(self, ChkWord, FLbox.Items);
523
524 // Default replacement dialog
525 if FReplaceDialog = repDefault then
526 begin
527 FEbox.Text := ChkWord;
528 Memo.SelStart := StartPos - 1;
529 Memo.SelLength := length(ChkWord);
530 FForm.ShowModal;
531
532 if FForm.ModalResult = mrOk then
533 begin
534 // Change mispelt word
535 Delete(StrText, StartPos, length(ChkWord));
536 Insert(FEbox.Text, StrText, StartPos);
537 CurPos := StartPos + length(FEbox.Text);
538 Memo.SelText := FEbox.Text;
539
540 if ChkWord <> FEbox.Text then
541 begin
542 inc(WordsChanged);
543 if Assigned(FAfterCorrection) then
544 FAfterCorrection(self, ChkWord, FEbox.Text);
545 end;
546 end
547 end
548 else
549 begin
550 // User defined replacemnt routine
551 UserWord := ChkWord;
552 Memo.SelStart := StartPos - 1;
553 Memo.SelLength := length(ChkWord);
554 if Assigned(FOnCorrection) then
555 FOnCorrection(self, UserWord);
556 Delete(StrText, StartPos, length(ChkWord));
557 Insert(UserWord, StrText, StartPos);
558 CurPos := StartPos + length(UserWord);
559 Memo.SelText := UserWord;
560
561 if ChkWord <> UserWord then
562 begin
563 inc(WordsChanged);
564 if Assigned(FAfterCorrection) then
565 FAfterCorrection(self, ChkWord, UserWord);
566 end;
567 end;
568 end;
569
570 StartPos := CurPos;
571 GetNextWordStart;
572 EoTxt := (StartPos > length(StrText));
573 end;
574 end;
575
576 Memo.HideSelection := SaveHide;
577 CloseForm;
578 if FCompletedMessage then
579 MessageDlg('Spell Check Complete' + #13#10 +
580 IntToStr(WordsChanged) + ' words changed',
581 mtInformation, [mbOk], 0);
582 end
583 else if not FActive then
584 MessageDlg('Spell Check not Active', mtError, [mbOk], 0)
585 else if FCompletedMessage then
586 MessageDlg('Spell Check Complete' + #13#10 +
587 '0 words changed', mtInformation, [mbOk], 0);
588 end;
589
590 // ======================================================================
591 // Return a list of Anagrams - Careful, long words generate HUGE lists
592 // ======================================================================
593
594 procedure TSpellCheck.Anagrams(const InString: string; StringList: TStrings);
595 var
596 WordsChecked, WordsFound: integer;
597
598 procedure RecursePerm(const StrA, StrB: string; Len: integer; SL: TStrings);
599 var
600 i: integer;
601 A, B: string;
602 begin
603 if (length(StrA) = Len) then
604 begin
605 inc(WordsChecked);
606 if (SL.IndexOf(StrA) = -1) and MsWordApp.CheckSpelling(StrA) then
607 begin
608 inc(WordsFound);
609 SL.Add(StrA);
610 Application.ProcessMessages;
611 end;
612 end;
613
614 for i := 1 to length(StrB) do
615 begin
616 A := StrB;
617 B := StrA + A[i];
618 delete(A, i, 1);
619 RecursePerm(B, A, Len, SL);
620 end;
621 end;
622
623 begin
624 if FActive then
625 begin
626 WordsChecked := 0;
627 WordsFound := 0;
628 StringList.Clear;
629 Application.ProcessMessages;
630 RecursePerm('', LowerCase(InString), length(InString), StringList);
631 if FCompletedMessage then
632 MessageDlg('Anagram Search Check Complete' + #13#10 +
633 IntToStr(WordsChecked) + ' words checked' + #13#10 +
634 IntToStr(WordsFound) + ' anagrams found',
635 mtInformation, [mbOk], 0);
636 end
637 else
638 MessageDlg('Spell Check not Active', mtError, [mbOk], 0);
639 end;
640
641 // =========================================
642 // Create default replacement form
643 // =========================================
644
645 procedure TSpellCheck.MakeForm;
646 begin
647 // Correction form container
648 FForm := TForm.Create(nil);
649 FForm.Position := poScreenCenter;
650 FForm.BorderStyle := bsDialog;
651 FForm.Height := 260; // 240 if no caption
652 FForm.Width := 210;
653
654 // Remove form's caption if desired
655 // SetWindowLong(FForm.Handle,GWL_STYLE,
656 // GetWindowLong(FForm.Handle,GWL_STYLE) AND NOT WS_CAPTION);
657
658 FForm.ClientHeight := FForm.Height;
659
660 // Edit box of offending word
661 FEbox := TEdit.Create(FForm);
662 FEbox.Parent := FForm;
663 FEbox.Top := 8;
664 FEbox.Left := 8;
665 FEbox.Width := 185;
666 FEBox.Font := FFont;
667 FEbox.Color := FColor;
668
669 // Suggestion list box
670 FLbox := TListBox.Create(FForm);
671 FLbox.Parent := FForm;
672 FLbox.Top := 32;
673 FLbox.Left := 8;
674 FLbox.Width := 185;
675 FLbox.Height := 193;
676 FLbox.Color := FColor;
677 FLbox.Font := FFont;
678 FLbox.OnClick := SuggestedClick;
679 FLbox.OnDblClick := SuggestedClick;
680
681 // Cancel Button
682 FCancelBtn := TBitBtn.Create(FForm);
683 FCancelBtn.Parent := FForm;
684 FCancelBtn.Top := 232;
685 FCancelBtn.Left := 8;
686 FCancelBtn.Kind := bkCancel;
687 FCancelBtn.Caption := 'Ignore';
688
689 // Change Button
690 FChangeBtn := TBitBtn.Create(FForm);
691 FChangeBtn.Parent := FForm;
692 FChangeBtn.Top := 232;
693 FChangeBtn.Left := 120;
694 FChangeBtn.Kind := bkOk;
695 FChangeBtn.Caption := 'Change';
696 end;
697
698 // =============================================
699 // Close the correction form and free memory
700 // =============================================
701
702 procedure TSpellCheck.CloseForm;
703 begin
704 FChangeBtn.Free;
705 FCancelBtn.Free;
706 FLbox.Free;
707 FEbox.Free;
708 FForm.Free;
709 end;
710
711 // ====================================================
712 // FLbox on click event to populate the edit box
713 // with selected suggestion (OnClick/OnDblClick)
714 // ====================================================
715
716 procedure TSpellCheck.SuggestedClick(Sender: TObject);
717 begin
718 FEbox.Text := FLbox.Items[FLbox.ItemIndex];
719 end;
720
721 end.
|