1 {
2  /***************************************************************************
3                                 StdActns.pas
4                                 ------------
5 
6 
7  ***************************************************************************/
8 
9  *****************************************************************************
10   This file is part of the Lazarus Component Library (LCL)
11 
12   See the file COPYING.modifiedLGPL.txt, included in this distribution,
13   for details about the license.
14  *****************************************************************************
15 
16 }
17 unit StdActns;
18 
19 {$mode objfpc}{$H+}
20 
21 interface
22 
23 uses
24   Classes, SysUtils, ActnList, Forms, Dialogs, StdCtrls, Clipbrd;
25 
26 type
27 
28   { Hint actions }
29 
30   THintAction = class(TCustomHintAction)
31   end;
32 
33   { Edit actions }
34 
35   TEditAction = class(TAction)
36   private
37     FControl: TCustomEdit;
38     procedure SetControl(const AValue: TCustomEdit);
39   protected
40     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
41   public
42     destructor Destroy; override;
HandlesTargetnull43     function HandlesTarget(Target: TObject): Boolean; override;
44     // limits target to the specific control
45     property Control: TCustomEdit read FControl write SetControl;
46   end;
47 
48   { TEditCut }
49 
50   TEditCut = class(TEditAction)
51   public
52     procedure ExecuteTarget(Target: TObject); override;
53     procedure UpdateTarget(Target: TObject); override;
54   end;
55 
56   { TEditCopy }
57 
58   TEditCopy = class(TEditAction)
59   public
60     procedure ExecuteTarget(Target: TObject); override;
61     procedure UpdateTarget(Target: TObject); override;
62   end;
63 
64   TEditPaste = class(TEditAction)
65   public
66     procedure UpdateTarget(Target: TObject); override;
67     procedure ExecuteTarget(Target: TObject); override;
68   end;
69 
70   TEditSelectAll = class(TEditAction)
71   public
72     procedure ExecuteTarget(Target: TObject); override;
73     procedure UpdateTarget(Target: TObject); override;
74   end;
75 
76   TEditUndo = class(TEditAction)
77   public
78     procedure ExecuteTarget(Target: TObject); override;
79     procedure UpdateTarget(Target: TObject); override;
80   end;
81 
82   TEditDelete = class(TEditAction)
83   public
84     procedure ExecuteTarget(Target: TObject); override;
85     procedure UpdateTarget(Target: TObject); override;
86   end;
87 
88 
89   { Help actions }
90 
91   THelpAction = class(TAction)
92   public
93     constructor Create(TheOwner: TComponent); override;
HandlesTargetnull94     function HandlesTarget(Target: TObject): Boolean; override;
95     procedure UpdateTarget(Target: TObject); override;
96   end;
97 
98   THelpContents = class(THelpAction)
99   public
100     procedure ExecuteTarget(Target: TObject); override;
101   end;
102 
103   THelpTopicSearch = class(THelpAction)
104   public
105     procedure ExecuteTarget(Target: TObject); override;
106   end;
107 
108   THelpOnHelp = class(THelpAction)
109   public
110     procedure ExecuteTarget(Target: TObject); override;
111   end;
112 
113   THelpContextAction = class(THelpAction)
114   public
115     procedure ExecuteTarget(Target: TObject); override;
116     procedure UpdateTarget(Target: TObject); override;
117   end;
118 
119 
120   { TCommonDialogAction }
121 
122   TCommonDialogClass = class of TCommonDialog;
123 
124   TCommonDialogAction = class(TCustomAction)
125   private
126     FBeforeExecute: TNotifyEvent;
127     FExecuteResult: Boolean;
128     FOnAccept: TNotifyEvent;
129     FOnCancel: TNotifyEvent;
130   protected
131     FDialog: TCommonDialog;
132     procedure DoAccept;
133     procedure DoBeforeExecute;
134     procedure DoCancel;
GetDialogClassnull135     function GetDialogClass: TCommonDialogClass; virtual;
136     procedure CreateDialog; virtual;
137   public
138     constructor Create(TheOwner: TComponent); override;
Handlestargetnull139     function Handlestarget(Target: TObject): Boolean; override;
140     procedure ExecuteTarget(Target: TObject); override;
141     property ExecuteResult: Boolean read FExecuteResult;
142     property BeforeExecute: TNotifyEvent read FBeforeExecute write FBeforeExecute;
143     property OnAccept: TNotifyEvent read FOnAccept write FOnAccept;
144     property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
145   published
146     property OnUpdate;
147   end;
148 
149   { File Actions }
150 
151   TFileAction = class(TCommonDialogAction)
152   private
GetFileNamenull153     function GetFileName: TFileName;
154     procedure SetFileName(const AValue: TFileName);
155   protected
GetDialognull156     function GetDialog: TOpenDialog;
157     property FileName: TFileName read GetFileName write SetFileName;
158   end;
159 
160   TFileOpen = class(TFileAction)
161   private
162     FUseDefaultApp: Boolean;
GetDialognull163     function GetDialog: TOpenDialog;
164   protected
GetDialogClassnull165     function GetDialogClass: TCommonDialogClass; override;
166   published
167     property Caption;
168     property Dialog: TOpenDialog read GetDialog;
169     property Enabled;
170     property HelpContext;
171     property HelpKeyword;
172     property HelpType;
173     property Hint;
174     property ImageIndex;
175     property ShortCut;
176     property SecondaryShortCuts;
177     property UseDefaultApp: Boolean read FUseDefaultApp write FUseDefaultApp
178                                                                   default False;
179     property Visible;
180     property BeforeExecute;
181     property OnAccept;
182     property OnCancel;
183     property OnHint;
184   end;
185 
186   TFileOpenWith = class(TFileOpen)
187   private
188     FAfterOpen: TNotifyEvent;
189     FFileName: TFileName;
190   published
191     property FileName: TFileName read FFileName write FFileName;
192     property AfterOpen: TNotifyEvent read FAfterOpen write FAfterOpen;
193   end;
194 
195   TFileSaveAs = class(TFileAction)
196   private
GetSaveDialognull197     function GetSaveDialog: TSaveDialog;
198   protected
GetDialogClassnull199     function GetDialogClass: TCommonDialogClass; override;
200   published
201     property Caption;
202     property Dialog: TSaveDialog read GetSaveDialog;
203     property Enabled;
204     property HelpContext;
205     property Hint;
206     property ImageIndex;
207     property ShortCut;
208     property SecondaryShortCuts;
209     property Visible;
210     property BeforeExecute;
211     property OnAccept;
212     property OnCancel;
213     property OnHint;
214   end;
215 
216   {TFilePrintSetup = class(TCommonDialogAction)
217   private
218     function GetDialog: TPrinterSetupDialog;
219   protected
220     function GetDialogClass: TCommonDialogClass; override;
221   published
222     property Caption;
223     property Dialog: TPrinterSetupDialog read GetDialog;
224     property Enabled;
225     property HelpContext;
226     property HelpKeyword;
227     property HelpType;
228     property Hint;
229     property ImageIndex;
230     property ShortCut;
231     property SecondaryShortCuts;
232     property Visible;
233     property BeforeExecute;
234     property OnAccept;
235     property OnCancel;
236     property OnHint;
237   end;
238 
239   TFilePageSetup = class(TCommonDialogAction)
240   private
241     function GetDialog: TPageSetupDialog;
242   protected
243     function GetDialogClass: TCommonDialogClass; override;
244   published
245     property Caption;
246     property Dialog: TPageSetupDialog read GetDialog;
247     property Enabled;
248     property HelpContext;
249     property HelpKeyword;
250     property HelpType;
251     property Hint;
252     property ImageIndex;
253     property ShortCut;
254     property SecondaryShortCuts;
255     property Visible;
256     property BeforeExecute;
257     property OnAccept;
258     property OnCancel;
259     property OnHint;
260   end;}
261 
262   TFileExit = class(TCustomAction)
263   public
HandlesTargetnull264     function HandlesTarget(Target: TObject): Boolean; override;
265     procedure ExecuteTarget(Target: TObject); override;
266   published
267     property Caption;
268     property Enabled;
269     property HelpContext;
270     property HelpKeyword;
271     property HelpType;
272     property Hint;
273     property ImageIndex;
274     property ShortCut;
275     property SecondaryShortCuts;
276     property Visible;
277     property OnHint;
278   end;
279 
280   { Search Actions }
281 
282   { TSearchAction }
283 
284   TSearchAction = class(TCommonDialogAction)
285   protected
286     FControl: TCustomEdit;
287     procedure CreateDialog; override;
288     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
289     procedure UpdateControl(NewControl: TCustomEdit);
PerformSearchnull290     function PerformSearch: Boolean;
291     procedure ShowNotFound; virtual;
292   public
293     constructor Create(TheOwner: TComponent); override;
294     destructor Destroy; override;
HandlesTargetnull295     function HandlesTarget(Target: TObject): Boolean; override;
296     procedure Search(Sender: TObject); virtual;
297     procedure UpdateTarget(Target: TObject); override;
298     procedure ExecuteTarget(Target: TObject); override;
299   end;
300 
301   { TSearchFind }
302 
303   TSearchFind = class(TSearchAction)
304   private
GetFindDialognull305     function GetFindDialog: TFindDialog;
306   protected
GetDialogClassnull307     function GetDialogClass: TCommonDialogClass; override;
308   published
309     property Caption;
310     property Dialog: TFindDialog read GetFindDialog;
311     property Enabled;
312     property HelpContext;
313     property HelpKeyword;
314     property HelpType;
315     property Hint;
316     property ImageIndex;
317     property ShortCut;
318     property SecondaryShortCuts;
319     property Visible;
320     property BeforeExecute;
321     property OnAccept;
322     property OnCancel;
323     property OnHint;
324   end;
325 
326   { TSearchReplace }
327 
328   TSearchReplace = class(TSearchAction)
329   private
GetReplaceDialognull330     function GetReplaceDialog: TReplaceDialog;
331   protected
GetDialogClassnull332     function GetDialogClass: TCommonDialogClass; override;
333     procedure CreateDialog; override;
334   public
335     procedure Replace(Sender: TObject); virtual;
336   published
337     property Caption;
338     property Dialog: TReplaceDialog read GetReplaceDialog;
339     property Enabled;
340     property HelpContext;
341     property HelpKeyword;
342     property HelpType;
343     property Hint;
344     property ImageIndex;
345     property ShortCut;
346     property SecondaryShortCuts;
347     property Visible;
348     property BeforeExecute;
349     property OnAccept;
350     property OnCancel;
351     property OnHint;
352   end;
353 
354   { TSearchFindFirst }
355 
356   TSearchFindFirst = class(TSearchFind)
357   end;
358 
359   { TSearchFindNext }
360 
361   TSearchFindNext = class(TCustomAction)
362   private
363     FSearchFind: TSearchFind;
364     procedure SetSearchFind(const AValue: TSearchFind);
365   public
366     constructor Create(TheOwner: TComponent); override;
HandlesTargetnull367     function HandlesTarget(Target: TObject): Boolean; override;
368     procedure UpdateTarget(Target: TObject); override;
369     procedure ExecuteTarget(Target: TObject); override;
370     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
371   published
372     property Caption;
373     property Enabled;
374     property HelpContext;
375     property HelpKeyword;
376     property HelpType;
377     property Hint;
378     property ImageIndex;
379     property SearchFind: TSearchFind read FSearchFind write SetSearchFind;
380     property ShortCut;
381     property SecondaryShortCuts;
382     property Visible;
383     property OnHint;
384   end;
385 
386   { TFontEdit }
387 
388   TFontEdit = class(TCommonDialogAction)
389   private
GetDialognull390     function GetDialog: TFontDialog;
391   protected
GetDialogClassnull392     function GetDialogClass: TCommonDialogClass; override;
393   published
394     property Caption;
395     property Dialog: TFontDialog read GetDialog;
396     property Enabled;
397     property HelpContext;
398     property HelpKeyword;
399     property HelpType;
400     property Hint;
401     property ImageIndex;
402     property ShortCut;
403     property SecondaryShortCuts;
404     property Visible;
405     property BeforeExecute;
406     property OnAccept;
407     property OnCancel;
408     property OnHint;
409   end;
410 
411   { TColorSelect }
412 
413   TColorSelect = class(TCommonDialogAction)
414   private
GetDialognull415     function GetDialog: TColorDialog;
416   protected
GetDialogClassnull417     function GetDialogClass: TCommonDialogClass; override;
418   published
419     property Caption;
420     property Dialog: TColorDialog read GetDialog;
421     property Enabled;
422     property HelpContext;
423     property HelpKeyword;
424     property HelpType;
425     property Hint;
426     property ImageIndex;
427     property ShortCut;
428     property SecondaryShortCuts;
429     property Visible;
430     property BeforeExecute;
431     property OnAccept;
432     property OnCancel;
433     property OnHint;
434   end;
435 
436 
437   { TPrintDlg }
438 
439   {TPrintDlg = class(TCommonDialogAction)
440   private
441     function GetDialog: TPrintDialog;
442   protected
443     function GetDialogClass: TCommonDialogClass; override;
444   published
445     property Caption;
446     property Dialog: TPrintDialog read GetDialog;
447     property Enabled;
448     property HelpContext;
449     property HelpKeyword;
450     property HelpType;
451     property Hint;
452     property ImageIndex;
453     property ShortCut;
454     property SecondaryShortCuts;
455     property Visible;
456     property BeforeExecute;
457     property OnAccept;
458     property OnCancel;
459     property OnHint;
460   end;}
461 
462 
463 procedure Register;
464 
465 implementation
466 
467 procedure Register;
468 begin
469   // register edit actions
470   RegisterNoIcon([TEditCut, TEditCopy, TEditPaste, TEditSelectAll,
471                   TEditUndo, TEditDelete]);
472   // register search actions
473   RegisterNoIcon([TSearchFind, TSearchReplace, TSearchFindFirst,
474                   TSearchFindNext]);
475   // register help actions
476   RegisterNoIcon([THelpAction, THelpContents, THelpTopicSearch,
477                   THelpOnHelp, THelpContextAction]);
478   // register dialog actions
479   RegisterNoIcon([TFontEdit, TColorSelect]);
480   // register file actions
481   RegisterNoIcon([TFileOpen, TFileOpenWith, TFileSaveAs, TFileExit]);
482 end;
483 
484 { TEditAction }
485 
486 procedure TEditAction.SetControl(const AValue: TCustomEdit);
487 begin
488   if FControl = AValue then
489     Exit;
490   if FControl <> nil then
491     FControl.RemoveFreeNotification(Self);
492   FControl := AValue;
493   if FControl <> nil then
494     FControl.FreeNotification(Self);
495 end;
496 
497 procedure TEditAction.Notification(AComponent: TComponent; Operation: TOperation);
498 begin
499   inherited Notification(AComponent, Operation);
500   if (Operation = opRemove) and (AComponent = FControl) then
501     FControl := nil;
502 end;
503 
504 destructor TEditAction.Destroy;
505 begin
506   inherited Destroy;
507 end;
508 
TEditAction.HandlesTargetnull509 function TEditAction.HandlesTarget(Target: TObject): Boolean;
510 begin
511   Result := Target <> nil;
512   if Result then
513     Result :=
514       (Control = Target) or
515       ((Control = nil) and (Target is TCustomEdit));
516 end;
517 
518 { TEditCut }
519 
520 procedure TEditCut.ExecuteTarget(Target: TObject);
521 begin
522   (Target as TCustomEdit).CutToClipboard;
523 end;
524 
525 procedure TEditCut.UpdateTarget(Target: TObject);
526 begin
527   Enabled := (Target as TCustomEdit).SelLength <> 0;
528 end;
529 
530 { TEditCopy }
531 
532 procedure TEditCopy.ExecuteTarget(Target: TObject);
533 begin
534   (Target as TCustomEdit).CopyToClipboard;
535 end;
536 
537 procedure TEditCopy.UpdateTarget(Target: TObject);
538 begin
539   Enabled := (Target as TCustomEdit).SelLength <> 0;
540 end;
541 
542 { TEditPaste }
543 
544 procedure TEditPaste.UpdateTarget(Target: TObject);
545 begin
546   Enabled := Clipboard.HasFormat(CF_TEXT);
547 end;
548 
549 procedure TEditPaste.ExecuteTarget(Target: TObject);
550 begin
551   (Target as TCustomEdit).PasteFromClipboard;
552 end;
553 
554 { TEditSelectAll }
555 
556 procedure TEditSelectAll.ExecuteTarget(Target: TObject);
557 begin
558   (Target as TCustomEdit).SelectAll;
559 end;
560 
561 procedure TEditSelectAll.UpdateTarget(Target: TObject);
562 begin
563   Enabled := (Target as TCustomEdit).Text <> '';
564 end;
565 
566 { TEditUndo }
567 
568 procedure TEditUndo.ExecuteTarget(Target: TObject);
569 begin
570   (Target as TCustomEdit).Undo;
571 end;
572 
573 procedure TEditUndo.UpdateTarget(Target: TObject);
574 begin
575   Enabled := (Target as TCustomEdit).CanUndo;
576 end;
577 
578 { TEditDelete }
579 
580 procedure TEditDelete.ExecuteTarget(Target: TObject);
581 begin
582   (Target as TCustomEdit).ClearSelection;
583 end;
584 
585 procedure TEditDelete.UpdateTarget(Target: TObject);
586 begin
587   Enabled := (Target as TCustomEdit).SelLength <> 0;
588 end;
589 
590 { THelpAction }
591 
592 constructor THelpAction.Create(TheOwner: TComponent);
593 begin
594   inherited Create(TheOwner);
595 end;
596 
HandlesTargetnull597 function THelpAction.HandlesTarget(Target: TObject): Boolean;
598 begin
599   Result:=inherited HandlesTarget(Target);
600 end;
601 
602 procedure THelpAction.UpdateTarget(Target: TObject);
603 begin
604   inherited UpdateTarget(Target);
605 end;
606 
607 { THelpContents }
608 
609 procedure THelpContents.ExecuteTarget(Target: TObject);
610 begin
611   inherited ExecuteTarget(Target);
612 end;
613 
614 { THelpTopicSearch }
615 
616 procedure THelpTopicSearch.ExecuteTarget(Target: TObject);
617 begin
618   inherited ExecuteTarget(Target);
619 end;
620 
621 { THelpOnHelp }
622 
623 procedure THelpOnHelp.ExecuteTarget(Target: TObject);
624 begin
625   inherited ExecuteTarget(Target);
626 end;
627 
628 { THelpContextAction }
629 
630 procedure THelpContextAction.ExecuteTarget(Target: TObject);
631 begin
632   inherited ExecuteTarget(Target);
633 end;
634 
635 procedure THelpContextAction.UpdateTarget(Target: TObject);
636 begin
637   inherited UpdateTarget(Target);
638 end;
639 
640 { TCommonDialogAction }
641 
642 procedure TCommonDialogAction.DoAccept;
643 begin
644   if Assigned(FOnAccept) then
645     OnAccept(Self);
646 end;
647 
648 procedure TCommonDialogAction.DoBeforeExecute;
649 begin
650   if Assigned(FBeforeExecute) then
651     BeforeExecute(Self);
652 end;
653 
654 procedure TCommonDialogAction.DoCancel;
655 begin
656   if Assigned(FOnCancel) then
657     OnCancel(Self);
658 end;
659 
GetDialogClassnull660 function TCommonDialogAction.GetDialogClass: TCommonDialogClass;
661 begin
662   Result := nil;
663 end;
664 
665 procedure TCommonDialogAction.CreateDialog;
666 var
667   DlgClass: TCommonDialogClass;
668 begin
669   DlgClass := GetDialogClass;
670   if Assigned(DlgClass) then
671   begin
672     FDialog := DlgClass.Create(Self);
673     FDialog.Name := DlgClass.ClassName;
674     FDialog.SetSubComponent(True);
675   end;
676 end;
677 
678 constructor TCommonDialogAction.Create(TheOwner: TComponent);
679 begin
680   inherited Create(TheOwner);
681   CreateDialog;
682 
683   DisableIfNoHandler := False;
684   Enabled := True;
685 end;
686 
Handlestargetnull687 function TCommonDialogAction.Handlestarget(Target: TObject): Boolean;
688 begin
689   // no target
690   Result := FDialog <> nil;
691 end;
692 
693 procedure TCommonDialogAction.ExecuteTarget(Target: TObject);
694 begin
695   DoBeforeExecute;
696   FExecuteResult := FDialog.Execute;
697   if FExecuteResult then
698     DoAccept
699   else
700     DoCancel;
701 end;
702 
703 { TFileAction }
704 
GetFileNamenull705 function TFileAction.GetFileName: TFileName;
706 begin
707   Result := GetDialog.FileName;
708 end;
709 
710 procedure TFileAction.SetFileName(const AValue: TFileName);
711 begin
712   GetDialog.FileName := AValue;
713 end;
714 
TFileAction.GetDialognull715 function TFileAction.GetDialog: TOpenDialog;
716 begin
717   Result := TOpenDialog(FDialog);
718 end;
719 
720 { TFileOpen }
721 
GetDialognull722 function TFileOpen.GetDialog: TOpenDialog;
723 begin
724   Result := TOpenDialog(FDialog);
725 end;
726 
GetDialogClassnull727 function TFileOpen.GetDialogClass: TCommonDialogClass;
728 begin
729   Result := TOpenDialog;
730 end;
731 
732 { TFileSaveAs }
733 
GetSaveDialognull734 function TFileSaveAs.GetSaveDialog: TSaveDialog;
735 begin
736   Result := TSaveDialog(FDialog);
737 end;
738 
GetDialogClassnull739 function TFileSaveAs.GetDialogClass: TCommonDialogClass;
740 begin
741   Result := TSaveDialog;
742 end;
743 
744 { TFileExit }
745 
HandlesTargetnull746 function TFileExit.HandlesTarget(Target: TObject): Boolean;
747 begin
748   Result := True;
749 end;
750 
751 procedure TFileExit.ExecuteTarget(Target: TObject);
752 begin
753   if Assigned(Application) then
754     if Assigned(Application.MainForm) then
755       Application.MainForm.Close
756     else
757       Application.Terminate
758   else
759     halt(0);
760 end;
761 
762 { TSearchAction }
763 
764 procedure TSearchAction.CreateDialog;
765 begin
766   inherited CreateDialog;
767   TFindDialog(FDialog).OnFind := @Search;
768 end;
769 
770 procedure TSearchAction.Notification(AComponent: TComponent;
771   Operation: TOperation);
772 begin
773   inherited Notification(AComponent, Operation);
774   if (Operation = opRemove) and (AComponent = FControl) then
775     FControl := nil;
776 end;
777 
778 procedure TSearchAction.UpdateControl(NewControl: TCustomEdit);
779 begin
780   if FControl <> nil then
781     FControl.RemoveFreeNotification(Self);
782   FControl := NewControl;
783   if FControl <> nil then
784     FControl.FreeNotification(Self);
785 end;
786 
PerformSearchnull787 function TSearchAction.PerformSearch: Boolean;
788 var
789   StartPos, Position, Increment, CharsToMatch: Integer;
790   SearchTxt, Text: String;
791   Down: Boolean;
792   P: PChar;
793 
794   procedure RestoreSearch; inline;
795   begin
796     CharsToMatch := Length(SearchTxt);
797     if not Down then
798       P := PChar(SearchTxt) + CharsToMatch - 1
799     else
800       P := PChar(SearchTxt);
801   end;
802 
803 begin
804   SearchTxt := Utf8ToAnsi(TFindDialog(FDialog).FindText);
805   Text := Utf8ToAnsi(FControl.Text);
806 
807   Result := (SearchTxt <> '') and (Text <> '');
808   if not Result then
809     Exit;
810 
811   if not (frMatchCase in TFindDialog(FDialog).Options) then
812   begin
813     Text := LowerCase(Text);
814     SearchTxt := LowerCase(SearchTxt);
815   end;
816 
817   Down := frDown in TFindDialog(FDialog).Options;
818   if not Down then
819   begin
820     Increment := -1;
821     if InheritsFrom(TSearchFindFirst) then
822       StartPos := Length(Text)
823     else
824       StartPos := FControl.SelStart - 1;
825   end
826   else
827   begin
828     Increment := 1;
829     if InheritsFrom(TSearchFindFirst) then
830       StartPos := 1
831     else
832       StartPos := FControl.SelStart + FControl.SelLength + 1;
833   end;
834 
835   Result := False;
836   RestoreSearch;
837   Position := StartPos;
838   while (Position > 0) and (Position <= Length(Text)) and (CharsToMatch > 0) do
839   begin
840     if Text[Position] = P^ then
841     begin
842       Dec(CharsToMatch);
843       P := P + Increment;
844     end
845     else
846       RestoreSearch;
847     if CharsToMatch = 0 then
848       break;
849     Position := Position + Increment;
850   end;
851   Result := CharsToMatch = 0;
852 
853   if Result then
854   begin
855     if Down then
856       FControl.SelStart := Position - Length(SearchTxt)
857     else
858       FControl.SelStart := Position - 1;
859     FControl.SelLength := Length(SearchTxt);
860   end;
861 end;
862 
863 procedure TSearchAction.ShowNotFound;
864 begin
865   MessageDlg(Format('Text "%s" is not found', [TFindDialog(FDialog).FindText]),
866     mtWarning, [mbOk], 0);
867 end;
868 
869 constructor TSearchAction.Create(TheOwner: TComponent);
870 begin
871   inherited Create(TheOwner);
872   FControl := nil;
873 end;
874 
875 destructor TSearchAction.Destroy;
876 begin
877   if FControl <> nil then
878     FControl.RemoveFreeNotification(Self);
879   inherited Destroy;
880 end;
881 
HandlesTargetnull882 function TSearchAction.HandlesTarget(Target: TObject): Boolean;
883 begin
884   Result := Target is TCustomEdit;
885 end;
886 
887 procedure TSearchAction.Search(Sender: TObject);
888 begin
889   if not PerformSearch then
890     ShowNotFound;
891 end;
892 
893 procedure TSearchAction.UpdateTarget(Target: TObject);
894 begin
895   Enabled := (Target as TCustomEdit).Text <> '';
896 end;
897 
898 procedure TSearchAction.ExecuteTarget(Target: TObject);
899 begin
900   UpdateControl(Target as TCustomEdit);
901   inherited ExecuteTarget(Target);
902 end;
903 
904 { TFontEdit }
905 
TFontEdit.GetDialognull906 function TFontEdit.GetDialog: TFontDialog;
907 begin
908   Result := TFontDialog(FDialog);
909 end;
910 
GetDialogClassnull911 function TFontEdit.GetDialogClass: TCommonDialogClass;
912 begin
913   Result := TFontDialog;
914 end;
915 
916 { TColorSelect }
917 
GetDialognull918 function TColorSelect.GetDialog: TColorDialog;
919 begin
920   Result := TColorDialog(FDialog);
921 end;
922 
GetDialogClassnull923 function TColorSelect.GetDialogClass: TCommonDialogClass;
924 begin
925   Result := TColorDialog;
926 end;
927 
928 { TSearchFind }
929 
GetFindDialognull930 function TSearchFind.GetFindDialog: TFindDialog;
931 begin
932   Result := TFindDialog(FDialog);
933 end;
934 
GetDialogClassnull935 function TSearchFind.GetDialogClass: TCommonDialogClass;
936 begin
937   Result := TFindDialog;
938 end;
939 
940 { TSearchReplace }
941 
GetReplaceDialognull942 function TSearchReplace.GetReplaceDialog: TReplaceDialog;
943 begin
944   Result := TReplaceDialog(FDialog);
945 end;
946 
GetDialogClassnull947 function TSearchReplace.GetDialogClass: TCommonDialogClass;
948 begin
949   Result := TReplaceDialog;
950 end;
951 
952 procedure TSearchReplace.CreateDialog;
953 begin
954   inherited CreateDialog;
955   TReplaceDialog(FDialog).OnReplace := @Replace;
956 end;
957 
958 procedure TSearchReplace.Replace(Sender: TObject);
959 var
960   Text, RText: String;
961   p1, p2: integer;
962 begin
963   if PerformSearch then
964   begin
965     Text := Utf8ToAnsi(FControl.Text);
966     RText := Utf8ToAnsi(Dialog.ReplaceText);
967     p1 := FControl.SelStart;
968     p2 := FControl.SelLength;
969     FControl.ClearSelection;
970     Delete(Text, p1 + 1, p2);
971     Insert(RText, Text, p1 + 1);
972     FControl.Text := UTF8Encode(Text);
973     FControl.SelStart := p1;
974     FControl.SelLength := Length(RText);
975   end
976   else
977     ShowNotFound;
978 end;
979 
980 { TSearchFindNext }
981 
982 procedure TSearchFindNext.SetSearchFind(const AValue: TSearchFind);
983 begin
984   if FSearchFind = AValue then
985     Exit;
986   if FSearchFind <> nil then
987     FSearchFind.RemoveFreeNotification(Self);
988   FSearchFind := AValue;
989   if FSearchFind <> nil then
990     FSearchFind.FreeNotification(Self);
991 end;
992 
993 constructor TSearchFindNext.Create(TheOwner: TComponent);
994 begin
995   inherited Create(TheOwner);
996   FSearchFind := nil;
997 end;
998 
HandlesTargetnull999 function TSearchFindNext.HandlesTarget(Target: TObject): Boolean;
1000 begin
1001   Result := (Target is TCustomEdit);
1002 end;
1003 
1004 procedure TSearchFindNext.UpdateTarget(Target: TObject);
1005 begin
1006   Enabled := ((Target as TCustomEdit).Text <> '') and
1007              (SearchFind <> nil) and
1008              (frFindNext in SearchFind.Dialog.Options);
1009 end;
1010 
1011 procedure TSearchFindNext.ExecuteTarget(Target: TObject);
1012 begin
1013   SearchFind.UpdateControl(Target as TCustomEdit);
1014   SearchFind.Search(Target);
1015 end;
1016 
1017 procedure TSearchFindNext.Notification(AComponent: TComponent;
1018   Operation: TOperation);
1019 begin
1020   inherited Notification(AComponent, Operation);
1021   if (Operation = opRemove) and (AComponent = FSearchFind) then
1022     FSearchFind := nil;
1023 end;
1024 
1025 end.
1026