type
TGrundForm =
class(TForm)
private
procedure SetActiveControl(Control: TWinControl);
{override;} // TCustomForm.SetActiveControl ist leider nicht virtuell, darum anschließend zumindestens der Setter überdeckt.
public
class procedure FocusError_Init(COwner: TComponent; Control: TWinControl;
out LastControl, LastGlobalControl: TWinControl);
static;
class procedure FocusError_Exec(
const ObjectClass, FuncName:
string; COwner: TComponent; Control, LastControl, LastGlobalControl: TWinControl; WithoutDest: Boolean=False);
static;
{$REGION 'Documentation'}
/// <summary>
/// Ordentliche Fehlermeldung inkl. Name des betreffenden Controls.<br /><br />SCannotFocus = 'Ein deaktiviertes
/// oder unsichtbares Fenster kann nicht den Fokus erhalten'
/// </summary>
/// <remarks>
/// <code lang="Delphi">
/// TCustomForm = class(TScrollingWinControl)
/// private
/// procedure SetActive(Value: Boolean); // SetWindowFocus
/// procedure SetActiveControl(Control: TWinControl); // SetWindowFocus + Exception(SCannotFocus)
/// procedure SetVisible(Value: Boolean); // SetWindowToMonitor + Inherited:=Value
/// procedure SetWindowFocus; // Windows.SetFocus
/// procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE; // SetActive
/// //procedure CMActivate(var Message: TCMActivate); message CM_ACTIVATE; // Activate
/// protected
/// //procedure Activate; dynamic; // CM_ACTIVATE
/// public
/// procedure DefocusControl(Control: TWinControl; Removing: Boolean); // SetActiveControl
/// procedure FocusControl(Control: TWinControl); // SetActiveControl + Windows.SetFocus
/// procedure SetFocus; override; // SetWindowFocus + Exception(SCannotFocus)
/// function SetFocusedControl(Control: TWinControl): Boolean; virtual; // Screen.ActiveControl + CM_EXIT/CM_ENTER, CM_FOCUSCHANGED, CM_ACTIVATE/CM_DEACTIVATE
/// end;</code>
/// </remarks>
{$ENDREGION}
procedure SetFocus;
override;
function SetFocusedControl(Control: TWinControl): Boolean;
override;
property ActiveControl
write SetActiveControl;
end;
TMyRichEdit =
class(TRichEdit)
public
procedure SetFocus;
override;
end;
TMyButton =
class(TButton)
public
procedure SetFocus;
override;
end;
...
function TGrundForm.FindNextControl(CurControl: TWinControl; GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
begin
Result :=
inherited FindNextControl(CurControl, GoForward, CheckTabStop, CheckParent);
if not Assigned(Result)
then
Result :=
inherited FindNextControl(
nil, GoForward, CheckTabStop, CheckParent);
// ActiveControl ist das Letzte => von Vorne
end;
class procedure TGrundForm.FocusError_Exec(
const ObjectClass, FuncName:
string; COwner: TComponent; Control, LastControl, LastGlobalControl: TWinControl; WithoutDest: Boolean);
var
S, S2:
string;
begin
{on E: Exception do begin}
Assert(ExceptObject <>
nil, '
TGrundForm.FocusError_Exec wurde nicht innerhalb von except-end aufgerufen');
if not Assigned(COwner)
then
COwner := Control;
// Abort unverändert durchreichen
if ExceptObject
is EAbort
then
if EAbort(ExceptObject).
Message <> LoadResString(@SOperationAborted)
then
raise EAbort.Create(EAbort(ExceptObject).
Message)
// wie "raise;" aber da nicht direkt im except-end, muß das Objekt neu erstellt werden, denn "raise ExceptObject;" würde knallen, da doppelte Freigabe. (Delphi prüft nicht, ob das selbe Objekt erneut reingegeben wird)
else
Abort;
// die Position wurde bereits eingetragen (verschachtelte Aufrufe: z.B. SetFocus > SetWindowFocus)
S := COwner.SecureClassName(ObjectClass);
if StartsStr('
.SetFocus', FuncName)
and StartsStr(S + '
.SetFocus',
Exception(ExceptObject).
Message)
then
raise ExceptClass(ExceptObject.ClassType).Create(
Exception(ExceptObject).
Message) at ExceptAddr;
if WithoutDest
then
S := COwner.SecureClassName(ObjectClass) + FuncName + '
from ' + LastControl.SecureFullName
else
S := COwner.SecureClassName(ObjectClass) + FuncName + '
to ' + Control.SecureFullName + '
from ' + LastControl.SecureFullName;
if Assigned(LastGlobalControl)
and (LastGlobalControl <> LastControl)
then
S := S + '
[' + LastGlobalControl.SecureFullName + '
]';
if (Screen.ActiveControl <> Control)
and (Screen.ActiveControl <> LastGlobalControl)
then
S := S + '
now on ' + Screen.ActiveControl.SecureFullName;
S := S + '
:'#10;
try
while Assigned(Control)
do begin
S2 := '
';
if Control.HandleAllocated
then begin
if not IsWindowVisible(Control.Handle)
and Control.Visible
then
S2 := S2 + '
Hidden** '
else if not Control.Visible
then
S2 := S2 + '
Hidden ';
if not IsWindowEnabled(Control.Handle)
and Control.Enabled
then
S2 := S2 + '
Disabled** '
else if not Control.Enabled
then
S2 := S2 + '
Disabled ';
end else begin
if not Control.Visible
then
S2 := S2 + '
Hidden ';
if not Control.Enabled
then
S2 := S2 + '
Disabled ';
end;
if S2 <> '
'
then
if (Control.
Name <> '
')
then
S := S + Control.
Name + '
= ' + Trim(S2) + #10
else if (Control.
Name = '
')
and ContainsStr(Control.ClassName, '
Inner')
and Assigned(Control.Parent)
and (Control.Parent.
Name <> '
')
then
S := S + Control.Parent.
Name + '
= ' + Trim(S2) + #10
else
S := S + Control.SecureFullName + '
= ' + Trim(S2) + #10;
Control := Control.Parent;
end;
except
end;
S := S +
Exception(ExceptObject).
Message;
raise ExceptClass(ExceptObject.ClassType).Create(S) at ExceptAddr;
end;
class procedure TGrundForm.FocusError_Init(COwner: TComponent; Control: TWinControl;
out LastControl, LastGlobalControl: TWinControl);
begin
LastControl :=
nil;
LastGlobalControl :=
nil;
try
if not Assigned(COwner)
then
COwner := Control;
// Global (auch auf anderdem Fenster)
LastGlobalControl := Screen.ActiveControl;
// nur im eigenen Fenster (andere Fenster ignorieren)
if COwner
is TCustomForm
then // falls nicht direkt als Form übergeben > einfach nachfolgend mit behandeln lassen (MDI-Child)
LastControl := TForm(COwner).ActiveControl;
// bei MDI-Childs und eingegetteten Fenstern im Parent suchen
while Assigned(COwner)
and not not Assigned(LastControl)
do begin
if COwner
is TControl
then
COwner := TControl(COwner).Parent
else
COwner := COwner.Owner;
if COwner
is TCustomForm
then
LastControl := TForm(COwner).ActiveControl;
end;
except
end;
if not Assigned(LastControl)
then
LastControl := LastGlobalControl;
end;
procedure TGrundForm.SetActiveControl(Control: TWinControl);
var
LastControl, LastGlobalControl: TWinControl;
begin
TGrundForm.FocusError_Init(Self, Control, LastControl, LastGlobalControl);
try
//inherited;
inherited ActiveControl := Control;
except
TGrundForm.FocusError_Exec('
TGrundForm', '
.SetFocus/SetActiveControl', Self, Control, LastControl, LastGlobalControl);
end;
end;
procedure TGrundForm.SetFocus;
var
LastControl, LastGlobalControl: TWinControl;
begin
TGrundForm.FocusError_Init(
nil, Self, LastControl, LastGlobalControl);
try
inherited;
except
TGrundForm.FocusError_Exec('
TGrundForm', '
.SetFocus',
nil, Self, LastControl, LastGlobalControl);
end;
end;
function TGrundForm.SetFocusedControl(Control: TWinControl): Boolean;
var
LastControl, LastGlobalControl: TWinControl;
begin
TGrundForm.FocusError_Init(Self, Control, LastControl, LastGlobalControl);
try
Result :=
inherited;
except
TGrundForm.FocusError_Exec('
TGrundForm', '
.SetFocus/SetFocusedControl', Self, Control, LastControl, LastGlobalControl);
end;
end;
...
procedure TMyButton.SetFocus;
var
LastControl, LastGlobalControl: TWinControl;
begin
TGrundForm.FocusError_Init(
nil, Self, LastControl, LastGlobalControl);
try
inherited;
except
TGrundForm.FocusError_Exec('
TMyButton', '
.SetFocus',
nil, Self, LastControl, LastGlobalControl);
end;
end;