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