I have a TFrame that is Inherited from a TBaseFrame = class(TFrame)
Inside this there is an embeded TFrame with same inheritence
TViewStandardMovimentoFinanceiro = class(TFrameBase)
ViewStandardEdiMovimentoFinanceiro1: TViewStandardEdiMovimentoFinanceiro;
TViewStandardEdiMovimentoFinanceiro = class(TFrameBase)
TFrameBase = class(TFrame, INaharView, INaharViewAdapter)
The TViewStandardMovimentoFinanceiro is created with parent set to the main form (particularly to a THorzScrollBox)
From INSIDE the TViewStandardMovimentoFinanceiro frame I tried the classical approach of using the Children list and have not found that embedded TFrame.
I have tried also using the Parent`s Children list with no success. Same thing with the Components List
What I want to do is to to locate all available TFrames so I can ask for an interface (I know how to do that)
What am I missing?
Following recommendations bellow I have implemented this code for testing:
function TFrameBase.LocateControl(AControl: TControl; ADomainName: string): TControlHandler;
var
NaharView: INaharView;
ControlHandler: TControlHandler;
i: integer;
begin
result := nil;
for i := 0 to AControl.ChildrenCount - 1 do
if (AControl.Children[i] is TFrame) and (AControl.Children[i] <> Self) then
if Supports((AControl.Children[i] as TFrame), INaharView, NaharView) then
begin
ControlHandler := NaharView.Control[ADomainName];
if Assigned(ControlHandler) then
exit(ControlHandler);
end;
end;
function GetUltimateParent(Control: TControl): TControl;
begin
if Control.Parent is TControl then
Result := GetUltimateParent(TControl(Control.Parent))
else
Result := Control;
end;
function TFrameBase.GetNaharControl(ADomainName: string): TControlHandler;
var
i: integer;
ControlHandler: TControlHandler;
begin
if NaharControls.ContainsKey(ADomainName) then
Exit(NaharControls.Items[ADomainName])
else
begin
ControlHandler := LocateControl(GetUltimateParent(Self), ADomainName);
if Assigned(ControlHandler) then
exit(ControlHandler);
end;
raise EViewControlDomainNameNotFound.Create(ADomainName);
end;
When LocateControl is executed it goes several levels to the top and from there it tries to iterate on Children List, it only contains 3 items in a form form full of controls.
Your function LocateControl need to be recursive, as stated by Ondrej. Something like this
function TFrameBase.LocateControl(AControl: TControl; ADomainName: string): TControlHandler;
var
NaharView: INaharView;
ControlHandler: TControlHandler;
i: integer;
begin
result := nil;
for i := 0 to AControl.ChildrenCount - 1 do
begin
if (AControl.Children[i] is TFrame) and (AControl.Children[i] <> Self) then
begin
if Supports((AControl.Children[i] as TFrame), INaharView, NaharView) then
begin
ControlHandler := NaharView.Control[ADomainName];
if Assigned(ControlHandler) then
begin
exit(ControlHandler);
end;
end;
end;
// recursive bit
Result := LocateControl(AControl.Children[i], ADomainName):
if assigned( Result ) then
begin
exit;
end;
end;
end;
Related
Following _isEdit function detects whether input could be applied to the currently focused control:
class function TSpeedInput._getFocusedControlClassName(): WideString;
var
lpClassName: array[0..1000] of WideChar;
begin
FillChar(lpClassName, SizeOf(lpClassName), 0);
Windows.GetClassNameW(GetFocus(), PWideChar(#lpClassName), 999);
Result := lpClassName;
end;
class function TSpeedInput._isEdit(): Boolean;
const
CNAMES: array[0..3] of string = ('TEdit', 'TMemo', 'TTntMemo.UnicodeClass',
'TTntEdit.UnicodeClass');
var
cn: WideString;
i: Integer;
begin
Result := False;
cn := _getFocusedControlClassName();
for i := Low(CNAMES) to High(CNAMES) do
if cn = CNAMES[i] then begin
Result := True;
Exit;
end;
//MessageBoxW(0, PWideChar(cn), nil, 0);
end;
What I don't like about it is the hard coding of the class name list. Could it be detected that a currently focused window belongs to the editors family or, better to say, that it has an active caret? (in order that _isEdit returns False for a WhateverItIsControl that is in read-only mode).
If the Handle of the control is allocated, you can use this hack:
function IsEdit(AControl: TWinControl): boolean;
begin
if AControl.HandleAllocated then
begin
Result := SendMessage(AControl.Handle, EM_SETREADONLY,
WPARAM(Ord(AControl.Enabled)), 0) <> 0;
end
else
begin
Result := AControl is TCustomEdit;
end;
end;
If the controls you are interested in are on a specific form and are owned by that form (and are standard Delphi controls) you could use the following:
function TFormML2.FocusIsEdit: boolean;
var
i : integer;
begin
Result := FALSE;
for i := 0 to ComponentCount - 1 do
begin
if Components[ i ] is TCustomEdit then
begin
if (Components[ i ] as TCustomEdit).Focused and not (Components[ i ] as TCustomEdit).ReadOnly then
begin
Result := TRUE;
break;
end;
end;
end;
end;
If you know the form and can pass it as a parameter, you could do something similar.
TCustomEdit is the ancestor of all edit boxes, memos, etc.
i want to ask how to retain controlls when im making a copy of a control. for example i have an edit box that can be controlled with a slider for value change. when i make a copy using this code i achieve a copy of the items but the slider stops controlling editbox values. how can i fix that?
TypInfo;
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
procedure CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], #PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;
procedure DuplicateChildren(const ParentSource: TWinControl;
const WithEvents: Boolean = True);
var
I: Integer;
CurrentControl, ClonedControl: TControl;
begin
for I := ParentSource.ControlCount - 1 downto 0 do
begin
CurrentControl := ParentSource.Controls[I];
ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
ClonedControl.Parent := ParentSource;
CloneProperties(CurrentControl, ClonedControl);
ClonedControl.Name := CurrentControl.Name + '_';
if WithEvents then
CloneEvents(CurrentControl, ClonedControl);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DuplicateChildren(Panel1);
end;
Unless I'm misunderstanding you, your CloneProperties doesn't seem to have anything to do with the question you're asking. In your example of an edit control E1 and a slider S1, you can clone both of them to produce E2 and S2, but somewhere in your code there must be a statement that changes the value in E1 depending on the value of S1. However, in the way you've most likely written it, that statement doesn't apply to E2 and S2.
The simplest way around that is to write a method which takes the component instances and links the operation of the two together. e.g.
procedure TForm1.SetEditControlFromSlider(AnEdit : TEdit; ASlider : { TWhatever the slider actually is);
begin
// Set AnEdit's value from ASlider's properties
end;
Then, you can call this with Edit/Slider pairs like this
SetEditControlFromSlider(E1, S1);
[...]
SetEditControlFromSlider(E2, S2);
I can imagine you might not like having to do that.
IMO, the cleanest solution is to avoid attempting to clone components altogether and create a TFrame containing the Edit, Slider and the code that connects them, and then add to your form as many instances of the frame as you need. It's as easy as falling off a log.
type
TEditFrame = class(TFrame) // needs to be in its own unit, Used by your form
Edit1: TEdit;
TrackBar1: TTrackBar;
procedure TrackBar1Change(Sender: TObject);
private
public
end;
[...]
procedure TEditFrame.TrackBar1Change(Sender: TObject);
begin
Edit1.Text := IntToStr(TrackBar1.Position)
end;
Then, you can add clones of the frame to TForm1 by
procedure TForm1.Button1Click(Sender: TObject);
var
AFrame : TEditFrame;
begin
Inc(FrameCount); // Field of TForm1
AFrame := TEditFrame.Create(Self);
AFrame.Name := AFrame.Name + IntToStr(FrameCount);
AFrame.Parent := Self;
AFrame.Top := AFrame.Height * FrameCount;
end;
Note that because the code which links the two components, TrackBar1Change, it compiled into the frame's unit, it is automatically shared by every instance of the frame you create, without any need to "clone" the code.
I need to browse items of a treeview, without using recursion, for performance reasons.
TTreeview provides GlobalCount and ItemByGlobalIndex methods, but it only returns visible items
I searched the root class code without finding a private list of all nodes, FGlobalItems seems to only holds items that need to be rendered
Is there a way to sequentially browse all items (including not visible and collapsed nodes) of a treeview?
This question applies to Delphi XE3 / FM2
Thanks,
[Edit Feb 3]
I accepted the default answer (not possible out of the box), despite I was looking for a way to patch the firemonkey treeview on this aspect.
After more analysis, I found out that the FGlobalItems list only holds expanded items and is maintained in the method TCustomTreeView.UpdateGlobalIndexes;
Commenting line 924 of FMX.TreeView (if AItem.IsExpanded then...) leads to building a full index of nodes, and allows to browse all nodes sequentially using ItemByGlobalIndex(), BUT could lead to other performance issues and bugs...Without any more clue, I'll keep my recursive code.
Here are my functions for walking a treeview in a non-recursive manner. Simple to use if you have a node and want to move to the next or previous one without having to walk the entire tree.
GetNextItem functions by looking at it's first child, or if no children, looking at it's parent for the next child after itself (and going further through parents as necessary).
GetPrevItem looks at the parent to find the previous item, and uses GetLastChild to find the last child of that item (which does use recursion, BTW).
Note that the code as written only walk Expanded nodes, but can easily be modified to walk all nodes (just remove references to IsExpanded).
function GetLastChild(Item: TTreeViewItem): TTreeViewItem;
begin
if (Item.IsExpanded) and (Item.Count > 0) then
Result := GetLastChild(Item.Items[Item.Count-1])
else
Result := Item;
end;
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var ItemParent: TTreeViewItem;
I: Integer;
TreeViewParent: TTreeView;
Parent: TFMXObject;
Child: TFMXObject;
begin
if Item = nil then
Result := nil
else if (Item.IsExpanded) and (Item.Count > 0) then
Result := Item.Items[0]
else
begin
Parent := Item.Parent;
Child := Item;
while (Parent <> nil) and not (Parent is TTreeView) do
begin
while (Parent <> nil) and not (Parent is TTreeView) and not (Parent is TTreeViewItem) do
Parent := Parent.Parent;
if (Parent <> nil) and (Parent is TTreeViewItem) then
begin
ItemParent := TTreeViewItem(Parent);
I := 0;
while (I < ItemParent.Count) and (ItemParent.Items[I] <> Child) do
inc(I);
inc(I);
if I < ItemParent.Count then
begin
Result := ItemParent.Items[I];
EXIT;
end;
Child := Parent;
Parent := Parent.Parent
end;
end;
if (Parent <> nil) and (Parent is TTreeView) then
begin
TreeViewParent := TTreeView(Parent);
I := 0;
while (I < TreeViewParent.Count) and (TreeViewParent.Items[I] <> Item) do
inc(I);
inc(I);
if I < TreeViewParent.Count then
Result := TreeViewParent.Items[I]
else
begin
Result := Item;
EXIT;
end;
end
else
Result := Item
end
end;
function GetPrevItem(Item: TTreeViewItem): TTreeViewItem;
var Parent: TFMXObject;
ItemParent: TTreeViewItem;
TreeViewParent: TTreeView;
I: Integer;
begin
if Item = nil then
Result := nil
else
begin
Parent := Item.Parent;
while (Parent <> nil) and not (Parent is TTreeViewItem) and not (Parent is TTreeView) do
Parent := Parent.Parent;
if (Parent <> nil) and (Parent is TTreeViewItem) then
begin
ItemParent := TTreeViewItem(Parent);
I := 0;
while (I < ItemParent.Count) and (ItemParent.Items[I] <> Item) do
inc(I);
dec(I);
if I >= 0 then
Result := GetLastChild(ItemParent.Items[I])
else
Result := ItemParent;
end
else if (Parent <> nil) and (Parent is TTreeView) then
begin
TreeViewParent := TTreeView(Parent);
I := 0;
while (I < TreeViewParent.Count) and (TreeViewParent.Items[I] <> Item) do
inc(I);
dec(I);
if I >= 0 then
Result := GetLastChild(TreeViewParent.Items[I])
else
Result := Item
end
else
Result := Item;
end;
end;
The question essentially asks how to traverse a tree without recursion. There are many ways to traverse a tree; the fact that your tree happens to be represented with nodes in a visual control is irrelevant.
For some algorithms, it's easier to think of the traversal in recursive terms. That way, you let the programming language keep track of where in the tree you are by keeping the currently active node as an argument on the stack. If you don't want to use recursion, then you simply have to keep track of the progress yourself. Common tools for that include stacks and queues.
A preorder traversal means that when you visit a node, you do your action on that node's data before doing the action on the node's children. It corresponds to visiting each node of a tree-view control from top to bottom. You could implement it like this with a stack:
procedure PreorderVisit(Node: TTreeNode; Action: TNodeAction);
var
Worklist: TStack<TTreeNode>;
i: Integer;
begin
Worklist := TStack<TTreeNode>.Create;
try
Worklist.Push(Node);
repeat
Node := Worklist.Pop;
for i := Pred(Node.Items.Count) downto 0 do
Worklist.Push(Node.Items[i]);
Action(Node);
until Worklist.Empty;
finally
Worklist.Free;
end;
end;
Push the children onto the stack in reverse order so they'll be popped off in the desired order.
In that code, Action stands for whatever task you need to do with each node. You can either use it as specified in the code, as an external function, or you can write a specialized version of PreorderVisit that includes the task-specific code.
TTreeView doesn't actually represent a tree, though. It's really a forest (a collection of trees). That's because there is no single node that represents the root. You can easily use the function above to process all the nodes in a tree, though:
procedure PreorderVisitTree(Tree: TTreeView; Action: TNodeAction);
var
i: Integer;
begin
for i := 0 to Pred(Tree.Items.Count) do
PreorderVisit(Tree.Items[i], Action);
end;
Another way of doing a preorder traversal that takes advantage of the specific structure of TTreeView is to use the built-in GetNext method of each node:
procedure PreorderVisitTree(Tree: TTreeView; Action: TNodeAction);
var
Node: TTreeNode;
begin
if Tree.Items.Count = 0 then
exit;
Node := Tree.Items[0];
repeat
Action(Node);
Node := Node.GetNext;
until not Assigned(Node);
end;
There appears to be no way of getting hidden nodes of a Firemonkey tree view. You might find better results by iterating over your internal tree data structure instead of trying to extract information from the GUI.
In XE8 this works for me:
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var
Parent: TFMXObject;
Child: TTreeViewItem;
begin
Result := nil;
if Item.Count > 0 then
Result := Item.Items[0]
else
begin
Parent := Item.ParentItem;
Child := Item;
while (Result = nil) and (Parent <> nil) do
begin
if Parent is TTreeViewItem then
begin
if TTreeViewItem(Parent).Count > (Child.Index + 1) then
Result := TTreeViewItem(Parent).Items[Child.Index + 1]
else
begin
Child := TTreeViewItem(Parent);
if Child.ParentItem <> nil then
Parent := Child.ParentItem
else
Parent := Child.TreeView;
end;
end
else
begin
if TTreeView(Parent).Count > Child.Index + 1 then
Result := TTreeView(Parent).Items[Child.Index + 1]
else
Parent := nil;
end;
end;
end;
end;
The Item.ParentItem can also be nil! That is why I had replaced the line Parent := Item.ParentItem with the following lines:
if Item.ParentItem <> nil then
Parent := Item.ParentItem
else
Parent := Item.TreeView;
The complete function GetNextItem after the correction:
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var
Parent: TFMXObject;
Child: TTreeViewItem;
begin
Result := nil;
if Item.Count > 0 then
Result := Item.Items[0]
else begin
if Item.ParentItem <> nil then
Parent := Item.ParentItem
else
Parent := Item.TreeView;
Child := Item;
while (Result = nil) and (Parent <> nil) do
begin
if Parent is TTreeViewItem then
begin
if TTreeViewItem(Parent).Count > (Child.Index + 1) then
Result := TTreeViewItem(Parent).Items[Child.Index + 1]
else begin
Child := TTreeViewItem(Parent);
if Child.ParentItem <> nil then
Parent := Child.ParentItem
else
Parent := Child.TreeView;
end;
end else begin
if TTreeView(Parent).Count > Child.Index + 1 then
Result := TTreeView(Parent).Items[Child.Index + 1]
else
Parent := nil;
end;
end;
end;
end;
Tested at Delphi 10.3.2
I would add a function to SEARCH PARTIALLY a text into a TreeView, from a TEdit (Search) placed up from the TreeView (TV). (special thank to the previous post which this answer is based from)
This work perfectly using Enter to start the search and F3 to continue searching.
// SEARCH ITEM (text partially or by particular ID in item.tag)
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var
Parent: TFMXObject;
Child: TTreeViewItem;
begin
Result := nil;
if Item.Count > 0 then
Result := Item.Items[0]
else begin
if Item.ParentItem <> nil then
Parent := Item.ParentItem
else
Parent := Item.TreeView;
Child := Item;
while (Result = nil) and (Parent <> nil) do
begin
if Parent is TTreeViewItem then
begin
if TTreeViewItem(Parent).Count > (Child.Index + 1) then
Result := TTreeViewItem(Parent).Items[Child.Index + 1]
else begin
Child := TTreeViewItem(Parent);
if Child.ParentItem <> nil then
Parent := Child.ParentItem
else
Parent := Child.TreeView;
end;
end else begin
if TTreeView(Parent).Count > Child.Index + 1 then
Result := TTreeView(Parent).Items[Child.Index + 1]
else
Parent := nil;
end;
end;
end;
end;
function FindItem(aFromItem : TTreeViewItem ; Value: String = '' ; aID : integer = -1) : TTreeViewItem;
var I: Integer;
begin
Result := nil;
while aFromItem.Index < aFromITem.TreeView.Count do
begin
aFromItem := GetNextItem(aFromItem);
if aFromItem <> nil then
begin
if (aID <> -1) and (aFromItem.Tag = aID) then
begin
Result := aFromItem;
EXIT;
end
else if pos(Value, uppercase(aFromItem.Text)) > 0 then
begin
Result := aFromItem;
EXIT;
end;
end
else
exit;
end;
end;
procedure TCListeMedia.SearchKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
var
i : integer;
vSearch : string;
begin
if (Key = 13) or (Key = vkF3) then
begin
// Search or continue to search
vSearch := Uppercase(Search.Text);
if Key = 13 then
begin
i := 0;
if TV.Count > 0 then
begin
if pos(vSearch, uppercase(TV.Items[0].Text)) > 0 then
TV.Selected := TV.Items[0]
else
TV.Selected := FindItem(TV.Items[0], vSearch);
end;
end
else if TV.Selected <> nil then
begin
i := 1 + TV.Selected.Index;
TV.Selected := FindItem(TV.Selected, vSearch);
end;
end;
end;
procedure TCListeMedia.TVKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
if (Key = vkF3) then
SearchKeyDown(Sender, Key, KeyChar, Shift);
end;
I have made this function for my project is fast and easy you can try it
function FindItem(const TreeView: TTreeView; const Value: Variant): TTreeViewItem;
function ItemExist(const AItem: TTreeViewItem): Boolean;
begin
Result:= False;
if AItem <> nil then
begin
{Set your condition here}
if AItem.Text = Value then
begin
FindItem:= AItem;
Exit(True);
end;
var I: Integer;
for I := 0 to AItem.Count - 1 do
begin
if ItemExist( AItem.ItemByIndex(I)) then
Break;
end;
end;
end;
var
AItem: TTreeViewItem;
I: Integer;
begin
Result:= nil;
for I := 0 to TreeView.Count - 1 do
begin
AItem:= TreeView.ItemByIndex(I);
if ItemExist(AItem) or (Result <> nil) then Break;
end;
end;
I take advantage of class helpers and anonymous procedures in Delphi to loop through items in a TreeView. This can be easilly extended to build an index list.
My class helper goes like this:
{ TTreeViewHelper }
TTreeViewHelper
= Class helper for FMX.TreeView.TTreeView
Public
Procedure LoopThroughItems(const Func: TProc<TTreeViewItem>; const AExpandedOnly: Boolean);
End;
Procedure TTreeViewHelper.LoopThroughItems(const Func: TProc<TTreeViewItem>; const AExpandedOnly: Boolean);
var
i : integer;
procedure ProcessItem(const AItem: TTreeViewItem);
var
I: Integer;
begin
if(AItem=nil) then exit;
Func(AItem);
for I := 0 to AItem.Count - 1 do ProcessItem(AItem.ItemByIndex(I));
end;
begin
if not Assigned(Func)then exit;
if(GlobalCount<1)then exit;
if(AExpandedOnly)
then for i:=0 to Count-1 do Func(self.Items[i])
else for i:=0 to Count-1 do ProcessItem(ItemByGlobalIndex(i));
end;
And I am using it like this:
TreeView1.LoopThroughItems(
procedure(E: TTreeViewItem)
begin
if Assigned(E)and(E is TTreeNode)
then TN := E as TTreeNode { My own subclass }
else exit;
if Assigned(TN.DataObject)and(TN.DataObject is TIOTSensorData)
then IOT := TN.DataObject as TIOTSensorData
else exit;
if(IOT<>AFormula)then exit;
TreeView1.Selected := TN;
end,
False
);
The sample above is from my actual project, you would use your own logic in the anonymous procedure, but the really neat part is the last TreeView1.Selected := TN;, becasue even if the TN is a non-visible item, the TreeView will select it and expand all its parent nodes.
Now, you say you want to avoid recursion, but actually you want to avoid a recursive recursion. Because you'll have to build your index first, and while building it is okay to use recursion one time in there.
Following the same approach, just go ahead and add a new method to your class helper:
{ TTreeViewHelper }
TTreeViewHelper
= Class helper for FMX.TreeView.TTreeView
Public
Procedure LoopThroughItems(const Func: TProc<TTreeViewItem>; const AExpandedOnly: Boolean);
Function BuildFullIndex: TList<TTreeViewItem>;
End;
Function TTreeViewHelper.BuildFullIndex: TList<TTreeViewItem>;
var
i : integer;
procedure Publish(const AItem: TTreeViewItem);
var
I: Integer;
begin
if(AItem=nil) then exit;
Result.Add(AItem);
for I := 0 to AItem.Count - 1 do Publish(AItem.ItemByIndex(I));
end;
begin
Result := TList<TTreeViewItem>.Create;
if(GlobalCount<1)then exit;
for i:=0 to Count-1 do Publish(ItemByGlobalIndex(i))
end;
And use it like this:
uses
System.Generics.Collections;
var
Index : TList<TTreeViewItem>;
begin
Index := Formulas.BuildFullIndex;
try
if(Index.Count<1)then exit;
for i:=0 to Index.Count-1 do
begin
{ do your thing here }
end;
finally
FreeAndNil(Index);
end;
end;
Cheers!
I need the opposite information that the question "How to get cursor position on a control?" asks.
Given the current cursor position, how can I find the form (in my application) and the control that the cursor is currently over? I need the handle to it so that I can use Windows.SetFocus(Handle).
For reference, I'm using Delphi 2009.
I experienced some problems with suggested solutions (Delphi XE6/Windows 8.1/x64):
FindVCLWindow doesn't search disabled controls (Enabled=False).
TWinControl.ControlAtPos doesn't search controls if they are disabled
indirectly (for example if Button.Enabled=True, but Button.Parent.Enabled=False).
In my case it was a problem, because i need to find any visible control under the mouse cursor, so i have to use my own implementation of function FindControlAtPos:
function FindSubcontrolAtPos(AControl: TControl; AScreenPos, AClientPos: TPoint): TControl;
var
i: Integer;
C: TControl;
begin
Result := nil;
C := AControl;
if (C=nil) or not C.Visible or not TRect.Create(C.Left, C.Top, C.Left+C.Width, C.Top+C.Height).Contains(AClientPos) then
Exit;
Result := AControl;
if AControl is TWinControl then
for i := 0 to TWinControl(AControl).ControlCount-1 do
begin
C := FindSubcontrolAtPos(TWinControl(AControl).Controls[i], AScreenPos, AControl.ScreenToClient(AScreenPos));
if C<>nil then
Result := C;
end;
end;
function FindControlAtPos(AScreenPos: TPoint): TControl;
var
i: Integer;
f,m: TForm;
p: TPoint;
r: TRect;
begin
Result := nil;
for i := Screen.FormCount-1 downto 0 do
begin
f := Screen.Forms[i];
if f.Visible and (f.Parent=nil) and (f.FormStyle<>fsMDIChild) and
TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(AScreenPos)
then
Result := f;
end;
Result := FindSubcontrolAtPos(Result, AScreenPos, AScreenPos);
if (Result is TForm) and (TForm(Result).ClientHandle<>0) then
begin
WinAPI.Windows.GetWindowRect(TForm(Result).ClientHandle, r);
p := TPoint.Create(AScreenPos.X-r.Left, AScreenPos.Y-r.Top);
m := nil;
for i := TForm(Result).MDIChildCount-1 downto 0 do
begin
f := TForm(Result).MDIChildren[i];
if TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(p) then
m := f;
end;
if m<>nil then
Result := FindSubcontrolAtPos(m, AScreenPos, p);
end;
end;
I think FindVCLWindow will meet your needs. Once you have the windowed control under the cursor you can walk the parent chain to find the form on which the window lives.
If you want to know the control inside a form that is at a certain x,y coordinate
Use
function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;
AllowWinControls: Boolean = False; AllLevels: Boolean = False): TControl;
Given the fact that you seem only interested in forms inside your application, you can just query all forms.
Once you get a non-nil result, you can query the control for its Handle, with code like the following
Pseudo code
function HandleOfControlAtCursor: THandle;
const
AllowDisabled = true;
AllowWinControls = true;
AllLevels = true;
var
CursorPos: TPoint
FormPos: TPoint;
TestForm: TForm;
ControlAtCursor: TControl;
begin
Result:= THandle(0);
GetCursorPos(CursorPos);
for each form in my application do begin
TestForm:= Form_to_test;
FormPos:= TestForm.ScreenToClient(CursorPos);
ControlAtCursor:= TestForm.ControlAtPos(FormPos, AllowDisabled,
AllowWinControls, AllLevels);
if Assigned(ControlAtCursor) then break;
end; {for each}
//Break re-enters here
if Assigned(ControlAtCursor) then begin
while not(ControlAtCursor is TWinControl) do
ControlAtCursor:= ControlAtCursor.Parent;
Result:= ControlAtCursor.Handle;
end; {if}
end;
This also allows you to exclude certain forms from consideration should you so desire. If you're looking for simplicity I'd go with David and use FindVCLWindow.
P.S. Personally I'd use a goto rather than a break, because with a goto it's instantly clear where the break re-enters, but in this case it's not a big issue because there are no statements in between the break and the re-entry point.
Is it possible to, for instance, replace and free a TEdit with a subclassed component instantiated (conditionally) at runtime? If so, how and when it should be done? I've tried to set the parent to nil and to call free() in the form constructor and AfterConstruction methods but in both cases I got a runtime error.
Being more specific, I got an Access violation error (EAccessViolation). It seems François is right when he says that freeing components at frame costruction messes with Form controls housekeeping.
This more generic routine works either with a Form or Frame (updated to use a subclass for the new control):
function ReplaceControlEx(AControl: TControl; const AControlClass: TControlClass; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
begin
Result := nil;
Exit;
end;
Result := AControlClass.Create(AControl.Owner);
CloneProperties(AControl, Result);// copy all properties to new control
// Result.Left := AControl.Left; // or copy some properties manually...
// Result.Top := AControl.Top;
Result.Name := ANewName;
Result.Parent := AControl.Parent; // needed for the InsertControl & RemoveControl magic
if IsFreed then
FreeAndNil(AControl);
end;
function ReplaceControl(AControl: TControl; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
Result := nil
else
Result := ReplaceControlEx(AControl, TControlClass(AControl.ClassType), ANewName, IsFreed);
end;
using this routine to pass the properties to the new control
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
use it like:
procedure TFrame1.AfterConstruction;
var
I: Integer;
NewEdit: TMyEdit;
begin
inherited;
NewEdit := ReplaceControlEx(Edit1, TMyEdit, 'Edit2') as TMyEdit;
if Assigned(NewEdit) then
begin
NewEdit.Text := 'My Brand New Edit';
NewEdit.Author := 'Myself';
end;
for I:=0 to ControlCount-1 do
begin
ShowMessage(Controls[I].Name);
end;
end;
CAUTION: If you are doing this inside the AfterConstruction of the Frame, beware that the hosting Form construction is not finished yet.
Freeing Controls there, might cause a lot of problems as you're messing up with Form controls housekeeping.
See what you get if you try to read the new Edit Caption to display in the ShowMessage...
In that case you would want to use
...ReplaceControl(Edit1, 'Edit2', False)
and then do a
...FreeAndNil(Edit1)
later.
You have to call RemoveControl of the TEdit's parent to remove the control. Use InsertControl to add the new control.
var Edit2: TEdit;
begin
Edit2 := TEdit.Create(self);
Edit2.Left := Edit1.Left;
Edit2.Top := Edit2.Top;
Edit1.Parent.Insertcontrol(Edit2);
TWinControl(Edit1.parent).RemoveControl(Edit1);
Edit1.Free;
end;
Replace TEdit.Create to the class you want to use, and copy all properties you need like I did with Left and Top.
You can actually use RTTI (look in the TypInfo unit) to clone all the matching properties. I wrote code for this a while back, but I can't find it now. I'll keep looking.