mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 17:38:04 +02:00
1026 lines
23 KiB
ObjectPascal
1026 lines
23 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
StdActns.pas
|
|
------------
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
}
|
|
unit StdActns;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, ActnList, Forms, Dialogs, StdCtrls, Clipbrd;
|
|
|
|
type
|
|
|
|
{ Hint actions }
|
|
|
|
THintAction = class(TCustomHintAction)
|
|
end;
|
|
|
|
{ Edit actions }
|
|
|
|
TEditAction = class(TAction)
|
|
private
|
|
FControl: TCustomEdit;
|
|
procedure SetControl(const AValue: TCustomEdit);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
destructor Destroy; override;
|
|
function HandlesTarget(Target: TObject): Boolean; override;
|
|
// limits target to the specific control
|
|
property Control: TCustomEdit read FControl write SetControl;
|
|
end;
|
|
|
|
{ TEditCut }
|
|
|
|
TEditCut = class(TEditAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
{ TEditCopy }
|
|
|
|
TEditCopy = class(TEditAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
TEditPaste = class(TEditAction)
|
|
public
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
end;
|
|
|
|
TEditSelectAll = class(TEditAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
TEditUndo = class(TEditAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
TEditDelete = class(TEditAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
|
|
{ Help actions }
|
|
|
|
THelpAction = class(TAction)
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
function HandlesTarget(Target: TObject): Boolean; override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
THelpContents = class(THelpAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
end;
|
|
|
|
THelpTopicSearch = class(THelpAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
end;
|
|
|
|
THelpOnHelp = class(THelpAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
end;
|
|
|
|
THelpContextAction = class(THelpAction)
|
|
public
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
end;
|
|
|
|
|
|
{ TCommonDialogAction }
|
|
|
|
TCommonDialogClass = class of TCommonDialog;
|
|
|
|
TCommonDialogAction = class(TCustomAction)
|
|
private
|
|
FBeforeExecute: TNotifyEvent;
|
|
FExecuteResult: Boolean;
|
|
FOnAccept: TNotifyEvent;
|
|
FOnCancel: TNotifyEvent;
|
|
protected
|
|
FDialog: TCommonDialog;
|
|
procedure DoAccept;
|
|
procedure DoBeforeExecute;
|
|
procedure DoCancel;
|
|
function GetDialogClass: TCommonDialogClass; virtual;
|
|
procedure CreateDialog; virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
function Handlestarget(Target: TObject): Boolean; override;
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
property ExecuteResult: Boolean read FExecuteResult;
|
|
property BeforeExecute: TNotifyEvent read FBeforeExecute write FBeforeExecute;
|
|
property OnAccept: TNotifyEvent read FOnAccept write FOnAccept;
|
|
property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
|
|
published
|
|
property OnUpdate;
|
|
end;
|
|
|
|
{ File Actions }
|
|
|
|
TFileAction = class(TCommonDialogAction)
|
|
private
|
|
function GetFileName: TFileName;
|
|
procedure SetFileName(const AValue: TFileName);
|
|
protected
|
|
function GetDialog: TOpenDialog;
|
|
property FileName: TFileName read GetFileName write SetFileName;
|
|
end;
|
|
|
|
TFileOpen = class(TFileAction)
|
|
private
|
|
FUseDefaultApp: Boolean;
|
|
function GetDialog: TOpenDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TOpenDialog read GetDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property UseDefaultApp: Boolean read FUseDefaultApp write FUseDefaultApp
|
|
default False;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
TFileOpenWith = class(TFileOpen)
|
|
private
|
|
FAfterOpen: TNotifyEvent;
|
|
FFileName: TFileName;
|
|
published
|
|
property FileName: TFileName read FFileName write FFileName;
|
|
property AfterOpen: TNotifyEvent read FAfterOpen write FAfterOpen;
|
|
end;
|
|
|
|
TFileSaveAs = class(TFileAction)
|
|
private
|
|
function GetSaveDialog: TSaveDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TSaveDialog read GetSaveDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
{TFilePrintSetup = class(TCommonDialogAction)
|
|
private
|
|
function GetDialog: TPrinterSetupDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TPrinterSetupDialog read GetDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
TFilePageSetup = class(TCommonDialogAction)
|
|
private
|
|
function GetDialog: TPageSetupDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TPageSetupDialog read GetDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;}
|
|
|
|
TFileExit = class(TCustomAction)
|
|
public
|
|
function HandlesTarget(Target: TObject): Boolean; override;
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
published
|
|
property Caption;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property OnHint;
|
|
end;
|
|
|
|
{ Search Actions }
|
|
|
|
{ TSearchAction }
|
|
|
|
TSearchAction = class(TCommonDialogAction)
|
|
protected
|
|
FControl: TCustomEdit;
|
|
procedure CreateDialog; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure UpdateControl(NewControl: TCustomEdit);
|
|
function PerformSearch: Boolean;
|
|
procedure ShowNotFound; virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function HandlesTarget(Target: TObject): Boolean; override;
|
|
procedure Search(Sender: TObject); virtual;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
end;
|
|
|
|
{ TSearchFind }
|
|
|
|
TSearchFind = class(TSearchAction)
|
|
private
|
|
function GetFindDialog: TFindDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TFindDialog read GetFindDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
{ TSearchReplace }
|
|
|
|
TSearchReplace = class(TSearchAction)
|
|
private
|
|
function GetReplaceDialog: TReplaceDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
procedure CreateDialog; override;
|
|
public
|
|
procedure Replace(Sender: TObject); virtual;
|
|
published
|
|
property Caption;
|
|
property Dialog: TReplaceDialog read GetReplaceDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
{ TSearchFindFirst }
|
|
|
|
TSearchFindFirst = class(TSearchFind)
|
|
end;
|
|
|
|
{ TSearchFindNext }
|
|
|
|
TSearchFindNext = class(TCustomAction)
|
|
private
|
|
FSearchFind: TSearchFind;
|
|
procedure SetSearchFind(const AValue: TSearchFind);
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
function HandlesTarget(Target: TObject): Boolean; override;
|
|
procedure UpdateTarget(Target: TObject); override;
|
|
procedure ExecuteTarget(Target: TObject); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
published
|
|
property Caption;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property SearchFind: TSearchFind read FSearchFind write SetSearchFind;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property OnHint;
|
|
end;
|
|
|
|
{ TFontEdit }
|
|
|
|
TFontEdit = class(TCommonDialogAction)
|
|
private
|
|
function GetDialog: TFontDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TFontDialog read GetDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
{ TColorSelect }
|
|
|
|
TColorSelect = class(TCommonDialogAction)
|
|
private
|
|
function GetDialog: TColorDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TColorDialog read GetDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;
|
|
|
|
|
|
{ TPrintDlg }
|
|
|
|
{TPrintDlg = class(TCommonDialogAction)
|
|
private
|
|
function GetDialog: TPrintDialog;
|
|
protected
|
|
function GetDialogClass: TCommonDialogClass; override;
|
|
published
|
|
property Caption;
|
|
property Dialog: TPrintDialog read GetDialog;
|
|
property Enabled;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property ImageIndex;
|
|
property ShortCut;
|
|
property SecondaryShortCuts;
|
|
property Visible;
|
|
property BeforeExecute;
|
|
property OnAccept;
|
|
property OnCancel;
|
|
property OnHint;
|
|
end;}
|
|
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
// register edit actions
|
|
RegisterNoIcon([TEditCut, TEditCopy, TEditPaste, TEditSelectAll,
|
|
TEditUndo, TEditDelete]);
|
|
// register search actions
|
|
RegisterNoIcon([TSearchFind, TSearchReplace, TSearchFindFirst,
|
|
TSearchFindNext]);
|
|
// register help actions
|
|
RegisterNoIcon([THelpAction, THelpContents, THelpTopicSearch,
|
|
THelpOnHelp, THelpContextAction]);
|
|
// register dialog actions
|
|
RegisterNoIcon([TFontEdit, TColorSelect]);
|
|
// register file actions
|
|
RegisterNoIcon([TFileOpen, TFileOpenWith, TFileSaveAs, TFileExit]);
|
|
end;
|
|
|
|
{ TEditAction }
|
|
|
|
procedure TEditAction.SetControl(const AValue: TCustomEdit);
|
|
begin
|
|
if FControl = AValue then
|
|
Exit;
|
|
if FControl <> nil then
|
|
FControl.RemoveFreeNotification(Self);
|
|
FControl := AValue;
|
|
if FControl <> nil then
|
|
FControl.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TEditAction.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FControl) then
|
|
FControl := nil;
|
|
end;
|
|
|
|
destructor TEditAction.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TEditAction.HandlesTarget(Target: TObject): Boolean;
|
|
begin
|
|
Result := Target <> nil;
|
|
if Result then
|
|
Result :=
|
|
(Control = Target) or
|
|
((Control = nil) and (Target is TCustomEdit));
|
|
end;
|
|
|
|
{ TEditCut }
|
|
|
|
procedure TEditCut.ExecuteTarget(Target: TObject);
|
|
begin
|
|
(Target as TCustomEdit).CutToClipboard;
|
|
end;
|
|
|
|
procedure TEditCut.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := (Target as TCustomEdit).SelLength <> 0;
|
|
end;
|
|
|
|
{ TEditCopy }
|
|
|
|
procedure TEditCopy.ExecuteTarget(Target: TObject);
|
|
begin
|
|
(Target as TCustomEdit).CopyToClipboard;
|
|
end;
|
|
|
|
procedure TEditCopy.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := (Target as TCustomEdit).SelLength <> 0;
|
|
end;
|
|
|
|
{ TEditPaste }
|
|
|
|
procedure TEditPaste.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := Clipboard.HasFormat(CF_TEXT);
|
|
end;
|
|
|
|
procedure TEditPaste.ExecuteTarget(Target: TObject);
|
|
begin
|
|
(Target as TCustomEdit).PasteFromClipboard;
|
|
end;
|
|
|
|
{ TEditSelectAll }
|
|
|
|
procedure TEditSelectAll.ExecuteTarget(Target: TObject);
|
|
begin
|
|
(Target as TCustomEdit).SelectAll;
|
|
end;
|
|
|
|
procedure TEditSelectAll.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := (Target as TCustomEdit).Text <> '';
|
|
end;
|
|
|
|
{ TEditUndo }
|
|
|
|
procedure TEditUndo.ExecuteTarget(Target: TObject);
|
|
begin
|
|
(Target as TCustomEdit).Undo;
|
|
end;
|
|
|
|
procedure TEditUndo.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := (Target as TCustomEdit).CanUndo;
|
|
end;
|
|
|
|
{ TEditDelete }
|
|
|
|
procedure TEditDelete.ExecuteTarget(Target: TObject);
|
|
begin
|
|
(Target as TCustomEdit).ClearSelection;
|
|
end;
|
|
|
|
procedure TEditDelete.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := (Target as TCustomEdit).SelLength <> 0;
|
|
end;
|
|
|
|
{ THelpAction }
|
|
|
|
constructor THelpAction.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
end;
|
|
|
|
function THelpAction.HandlesTarget(Target: TObject): Boolean;
|
|
begin
|
|
Result:=inherited HandlesTarget(Target);
|
|
end;
|
|
|
|
procedure THelpAction.UpdateTarget(Target: TObject);
|
|
begin
|
|
inherited UpdateTarget(Target);
|
|
end;
|
|
|
|
{ THelpContents }
|
|
|
|
procedure THelpContents.ExecuteTarget(Target: TObject);
|
|
begin
|
|
inherited ExecuteTarget(Target);
|
|
end;
|
|
|
|
{ THelpTopicSearch }
|
|
|
|
procedure THelpTopicSearch.ExecuteTarget(Target: TObject);
|
|
begin
|
|
inherited ExecuteTarget(Target);
|
|
end;
|
|
|
|
{ THelpOnHelp }
|
|
|
|
procedure THelpOnHelp.ExecuteTarget(Target: TObject);
|
|
begin
|
|
inherited ExecuteTarget(Target);
|
|
end;
|
|
|
|
{ THelpContextAction }
|
|
|
|
procedure THelpContextAction.ExecuteTarget(Target: TObject);
|
|
begin
|
|
inherited ExecuteTarget(Target);
|
|
end;
|
|
|
|
procedure THelpContextAction.UpdateTarget(Target: TObject);
|
|
begin
|
|
inherited UpdateTarget(Target);
|
|
end;
|
|
|
|
{ TCommonDialogAction }
|
|
|
|
procedure TCommonDialogAction.DoAccept;
|
|
begin
|
|
if Assigned(FOnAccept) then
|
|
OnAccept(Self);
|
|
end;
|
|
|
|
procedure TCommonDialogAction.DoBeforeExecute;
|
|
begin
|
|
if Assigned(FBeforeExecute) then
|
|
BeforeExecute(Self);
|
|
end;
|
|
|
|
procedure TCommonDialogAction.DoCancel;
|
|
begin
|
|
if Assigned(FOnCancel) then
|
|
OnCancel(Self);
|
|
end;
|
|
|
|
function TCommonDialogAction.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TCommonDialogAction.CreateDialog;
|
|
var
|
|
DlgClass: TCommonDialogClass;
|
|
begin
|
|
DlgClass := GetDialogClass;
|
|
if Assigned(DlgClass) then
|
|
begin
|
|
FDialog := DlgClass.Create(Self);
|
|
FDialog.Name := DlgClass.ClassName;
|
|
FDialog.SetSubComponent(True);
|
|
end;
|
|
end;
|
|
|
|
constructor TCommonDialogAction.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
CreateDialog;
|
|
|
|
DisableIfNoHandler := False;
|
|
Enabled := True;
|
|
end;
|
|
|
|
function TCommonDialogAction.Handlestarget(Target: TObject): Boolean;
|
|
begin
|
|
// no target
|
|
Result := FDialog <> nil;
|
|
end;
|
|
|
|
procedure TCommonDialogAction.ExecuteTarget(Target: TObject);
|
|
begin
|
|
DoBeforeExecute;
|
|
FExecuteResult := FDialog.Execute;
|
|
if FExecuteResult then
|
|
DoAccept
|
|
else
|
|
DoCancel;
|
|
end;
|
|
|
|
{ TFileAction }
|
|
|
|
function TFileAction.GetFileName: TFileName;
|
|
begin
|
|
Result := GetDialog.FileName;
|
|
end;
|
|
|
|
procedure TFileAction.SetFileName(const AValue: TFileName);
|
|
begin
|
|
GetDialog.FileName := AValue;
|
|
end;
|
|
|
|
function TFileAction.GetDialog: TOpenDialog;
|
|
begin
|
|
Result := TOpenDialog(FDialog);
|
|
end;
|
|
|
|
{ TFileOpen }
|
|
|
|
function TFileOpen.GetDialog: TOpenDialog;
|
|
begin
|
|
Result := TOpenDialog(FDialog);
|
|
end;
|
|
|
|
function TFileOpen.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := TOpenDialog;
|
|
end;
|
|
|
|
{ TFileSaveAs }
|
|
|
|
function TFileSaveAs.GetSaveDialog: TSaveDialog;
|
|
begin
|
|
Result := TSaveDialog(FDialog);
|
|
end;
|
|
|
|
function TFileSaveAs.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := TSaveDialog;
|
|
end;
|
|
|
|
{ TFileExit }
|
|
|
|
function TFileExit.HandlesTarget(Target: TObject): Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TFileExit.ExecuteTarget(Target: TObject);
|
|
begin
|
|
if Assigned(Application) then
|
|
if Assigned(Application.MainForm) then
|
|
Application.MainForm.Close
|
|
else
|
|
Application.Terminate
|
|
else
|
|
halt(0);
|
|
end;
|
|
|
|
{ TSearchAction }
|
|
|
|
procedure TSearchAction.CreateDialog;
|
|
begin
|
|
inherited CreateDialog;
|
|
TFindDialog(FDialog).OnFind := @Search;
|
|
end;
|
|
|
|
procedure TSearchAction.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FControl) then
|
|
FControl := nil;
|
|
end;
|
|
|
|
procedure TSearchAction.UpdateControl(NewControl: TCustomEdit);
|
|
begin
|
|
if FControl <> nil then
|
|
FControl.RemoveFreeNotification(Self);
|
|
FControl := NewControl;
|
|
if FControl <> nil then
|
|
FControl.FreeNotification(Self);
|
|
end;
|
|
|
|
function TSearchAction.PerformSearch: Boolean;
|
|
var
|
|
StartPos, Position, Increment, CharsToMatch: Integer;
|
|
SearchTxt, Text: String;
|
|
Down: Boolean;
|
|
P: PChar;
|
|
|
|
procedure RestoreSearch; inline;
|
|
begin
|
|
CharsToMatch := Length(SearchTxt);
|
|
if not Down then
|
|
P := PChar(SearchTxt) + CharsToMatch - 1
|
|
else
|
|
P := PChar(SearchTxt);
|
|
end;
|
|
|
|
begin
|
|
SearchTxt := Utf8ToAnsi(TFindDialog(FDialog).FindText);
|
|
Text := Utf8ToAnsi(FControl.Text);
|
|
|
|
Result := (SearchTxt <> '') and (Text <> '');
|
|
if not Result then
|
|
Exit;
|
|
|
|
if not (frMatchCase in TFindDialog(FDialog).Options) then
|
|
begin
|
|
Text := LowerCase(Text);
|
|
SearchTxt := LowerCase(SearchTxt);
|
|
end;
|
|
|
|
Down := frDown in TFindDialog(FDialog).Options;
|
|
if not Down then
|
|
begin
|
|
Increment := -1;
|
|
if InheritsFrom(TSearchFindFirst) then
|
|
StartPos := Length(Text)
|
|
else
|
|
StartPos := FControl.SelStart - 1;
|
|
end
|
|
else
|
|
begin
|
|
Increment := 1;
|
|
if InheritsFrom(TSearchFindFirst) then
|
|
StartPos := 1
|
|
else
|
|
StartPos := FControl.SelStart + FControl.SelLength + 1;
|
|
end;
|
|
|
|
Result := False;
|
|
RestoreSearch;
|
|
Position := StartPos;
|
|
while (Position > 0) and (Position <= Length(Text)) and (CharsToMatch > 0) do
|
|
begin
|
|
if Text[Position] = P^ then
|
|
begin
|
|
Dec(CharsToMatch);
|
|
P := P + Increment;
|
|
end
|
|
else
|
|
RestoreSearch;
|
|
if CharsToMatch = 0 then
|
|
break;
|
|
Position := Position + Increment;
|
|
end;
|
|
Result := CharsToMatch = 0;
|
|
|
|
if Result then
|
|
begin
|
|
if Down then
|
|
FControl.SelStart := Position - Length(SearchTxt)
|
|
else
|
|
FControl.SelStart := Position - 1;
|
|
FControl.SelLength := Length(SearchTxt);
|
|
end;
|
|
end;
|
|
|
|
procedure TSearchAction.ShowNotFound;
|
|
begin
|
|
MessageDlg(Format('Text "%s" is not found', [TFindDialog(FDialog).FindText]),
|
|
mtWarning, [mbOk], 0);
|
|
end;
|
|
|
|
constructor TSearchAction.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
FControl := nil;
|
|
end;
|
|
|
|
destructor TSearchAction.Destroy;
|
|
begin
|
|
if FControl <> nil then
|
|
FControl.RemoveFreeNotification(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TSearchAction.HandlesTarget(Target: TObject): Boolean;
|
|
begin
|
|
Result := Target is TCustomEdit;
|
|
end;
|
|
|
|
procedure TSearchAction.Search(Sender: TObject);
|
|
begin
|
|
if not PerformSearch then
|
|
ShowNotFound;
|
|
end;
|
|
|
|
procedure TSearchAction.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := (Target as TCustomEdit).Text <> '';
|
|
end;
|
|
|
|
procedure TSearchAction.ExecuteTarget(Target: TObject);
|
|
begin
|
|
UpdateControl(Target as TCustomEdit);
|
|
inherited ExecuteTarget(Target);
|
|
end;
|
|
|
|
{ TFontEdit }
|
|
|
|
function TFontEdit.GetDialog: TFontDialog;
|
|
begin
|
|
Result := TFontDialog(FDialog);
|
|
end;
|
|
|
|
function TFontEdit.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := TFontDialog;
|
|
end;
|
|
|
|
{ TColorSelect }
|
|
|
|
function TColorSelect.GetDialog: TColorDialog;
|
|
begin
|
|
Result := TColorDialog(FDialog);
|
|
end;
|
|
|
|
function TColorSelect.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := TColorDialog;
|
|
end;
|
|
|
|
{ TSearchFind }
|
|
|
|
function TSearchFind.GetFindDialog: TFindDialog;
|
|
begin
|
|
Result := TFindDialog(FDialog);
|
|
end;
|
|
|
|
function TSearchFind.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := TFindDialog;
|
|
end;
|
|
|
|
{ TSearchReplace }
|
|
|
|
function TSearchReplace.GetReplaceDialog: TReplaceDialog;
|
|
begin
|
|
Result := TReplaceDialog(FDialog);
|
|
end;
|
|
|
|
function TSearchReplace.GetDialogClass: TCommonDialogClass;
|
|
begin
|
|
Result := TReplaceDialog;
|
|
end;
|
|
|
|
procedure TSearchReplace.CreateDialog;
|
|
begin
|
|
inherited CreateDialog;
|
|
TReplaceDialog(FDialog).OnReplace := @Replace;
|
|
end;
|
|
|
|
procedure TSearchReplace.Replace(Sender: TObject);
|
|
var
|
|
Text, RText: String;
|
|
p1, p2: integer;
|
|
begin
|
|
if PerformSearch then
|
|
begin
|
|
Text := Utf8ToAnsi(FControl.Text);
|
|
RText := Utf8ToAnsi(Dialog.ReplaceText);
|
|
p1 := FControl.SelStart;
|
|
p2 := FControl.SelLength;
|
|
FControl.ClearSelection;
|
|
Delete(Text, p1 + 1, p2);
|
|
Insert(RText, Text, p1 + 1);
|
|
FControl.Text := UTF8Encode(Text);
|
|
FControl.SelStart := p1;
|
|
FControl.SelLength := Length(RText);
|
|
end
|
|
else
|
|
ShowNotFound;
|
|
end;
|
|
|
|
{ TSearchFindNext }
|
|
|
|
procedure TSearchFindNext.SetSearchFind(const AValue: TSearchFind);
|
|
begin
|
|
if FSearchFind = AValue then
|
|
Exit;
|
|
if FSearchFind <> nil then
|
|
FSearchFind.RemoveFreeNotification(Self);
|
|
FSearchFind := AValue;
|
|
if FSearchFind <> nil then
|
|
FSearchFind.FreeNotification(Self);
|
|
end;
|
|
|
|
constructor TSearchFindNext.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
FSearchFind := nil;
|
|
end;
|
|
|
|
function TSearchFindNext.HandlesTarget(Target: TObject): Boolean;
|
|
begin
|
|
Result := (Target is TCustomEdit);
|
|
end;
|
|
|
|
procedure TSearchFindNext.UpdateTarget(Target: TObject);
|
|
begin
|
|
Enabled := ((Target as TCustomEdit).Text <> '') and
|
|
(SearchFind <> nil) and
|
|
(frFindNext in SearchFind.Dialog.Options);
|
|
end;
|
|
|
|
procedure TSearchFindNext.ExecuteTarget(Target: TObject);
|
|
begin
|
|
SearchFind.UpdateControl(Target as TCustomEdit);
|
|
SearchFind.Search(Target);
|
|
end;
|
|
|
|
procedure TSearchFindNext.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FSearchFind) then
|
|
FSearchFind := nil;
|
|
end;
|
|
|
|
end.
|