I have been trying to get a list of menu sub-items from a standard Windows application using the UIAutomationCore library imported as a TLB into Delphi - i.e.
File -> New | Exit
Help -> About
I can get the application menu, and then the top-level items into a list (i.e. in the example above, 'File' and 'Help', but I cannot get a list of ANY controls that are under these menuitems. My code is as below - the FElement represents the actual menuitem I am checking.
The length of the collection returned by FindAll is always 0. I have tried expanding the menuitem prior to this code, but it seems to have no effect.
UIAuto.CreateTrueCondition(condition);
FItems := TObjectList<TAutomationMenuItem>.create;
self.Expand;
sleep(3000);
// Find the elements
self.FElement.FindAll(TreeScope_Descendants, condition, collection);
collection.Get_Length(length);
for count := 0 to length -1 do
begin
collection.GetElement(count, itemElement);
itemElement.Get_CurrentControlType(retVal);
if (retVal = UIA_MenuItemControlTypeId) then
begin
item := TAutomationMenuItem.Create(itemElement);
FItems.Add(item);
end;
end;
I can see examples of this in C#, and they are not really doing anything different from the code above (as far as I can see)
Thanks in advance
Update : It looks very similar to this question
Update2 : In this example it is trying to do this for another Delphi application. However, if I try the same thing on notepad (for example), the same issue occurs.
Update3 : Using Inspect (and then using UI Automation), I have the following structure ...
Name = Exit
Ancestors = File (menu) Form1 (pane)
I have also tried this after expanding the menu (file), and the same thing is happening (or not happening).
I think you have the following two issues:
The menus will not list the sub menu items unless the menu is expanded
If you're trying to automate your own application, you have to do it in a thread.
The following works for me:
// Careful: the code might not be 100% threadsafe, but should work for the purpose of demonstration
const
UIA_MenuItemControlTypeId = 50011;
UIA_ControlTypePropertyId = 30003;
UIA_NamePropertyId = 30005;
UIA_ExpandCollapsePatternId = 10005;
procedure TForm1.Button1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure begin CoInitializeEx(nil, 2); FindItems(true); CoUninitialize; end).Start;
end;
procedure TForm1.FindItems(Recurse: Boolean);
var
UIAuto: TCUIAutomation;
condition: IUIAutomationCondition;
collection: IUIAutomationElementArray;
Length: Integer;
Count: Integer;
itemElement: IUIAutomationElement;
retVal: Integer;
val: WideString;
ExpandCollapsePattern: IUIAutomationExpandCollapsePattern;
FElement: IUIAutomationElement;
begin
UIAuto := TCUIAutomation.Create(nil);
UIAuto.CreateTrueCondition(condition);
// Find the elements
UIAuto.ElementFromHandle(Pointer(Handle), FElement);
FElement.FindAll(TreeScope_Descendants, condition, collection);
collection.Get_Length(length);
for Count := 0 to length - 1 do
begin
collection.GetElement(Count, itemElement);
itemElement.Get_CurrentControlType(retVal);
if (retVal = UIA_MenuItemControlTypeId) then
begin
ItemElement.Get_CurrentName(val);
TThread.Synchronize(nil,
procedure
begin
memo1.lines.Add(val);
end);
itemElement.GetCurrentPattern(UIA_ExpandCollapsePatternId, IInterface(ExpandCollapsePattern));
if Assigned(ExpandCollapsePattern) then
begin
ExpandCollapsePattern.Expand;
if Recurse = True then
FindItems(False);
end;
end;
end;
UIAuto.Free;
end;
Related
I try to create new unit Ado_Op , in this unit i try to create a procedure like this :
procedure CloseAllTables ();
Var I : Integer; T : TADOTable;
begin
for I := 1 to ComponentCount-1 do
if Components[i] is TADOTable then
begin
T := FindComponent(Components[i].Name) as TADOTable;
T.Close;
end;
T.Destroy;
end;
Error :
ComponentCount inaccessible.
Note : I'm using Delphi 10 Seattle.
The compiler error you report is just the beginning of your problems. There are quite a few more. I see the following problems, with item 1 being the one noted in the question:
You need to supply an object on which to refer to the properties ComponentCount and Components[].
You are erroneously using one based indexing.
You needlessly call FindComponent to find the component that you already have.
You call Destroy once only, on whichever object you found last. Or on an uninitialized variable if you don't find any. The compiler should warn of this, and I do hope you have warnings and hints enabled, and heed them.
Based on the comments you are trying to call the Close method on each table owned by a form. Do that like so:
procedure CloseAllTables(Owner: TComponent);
var
i: Integer;
begin
for i := 0 to Owner.ComponentCount-1 do
if Owner.Components[i] is TADOTable then
TADOTable(Owner.Components[i]).Close;
end;
If you wish to destroy all of these components too, which I doubt, then you would need to run the loop in descending order. That's because when you destroy an component, it is removed from its owners list of components. That code would look like this, assuming that there was no need to call Close on an object that is about to be destroyed.
procedure DestroyAllTables(Owner: TComponent);
var
i: Integer;
begin
for i := Owner.ComponentCount-1 downto 0 do
if Owner.Components[i] is TADOTable then
Owner.Components[i].Free;
end;
I have ComboBox4,ComboBox1 and Button5
When I click Button5 program should remove component selected in combobox4 from the ComboBox4 and ComboBox1 components' list. But I get list out of bounds error with the following code...
procedure TForm1.Button5Click(Sender: TObject);
var
cat : Integer;
trinti: TComponent;
catT : String;
begin
catT := ComboBox4.Text;
cat := ComboBox4.Items.IndexOf(catT);
trinti := ComboBox4.Components[cat];
ComboBox1.Items.BeginUpdate;
ComboBox4.Items.BeginUpdate;
ComboBox4.RemoveComponent(trinti);
ComboBox1.RemoveComponent(trinti);
ComboBox1.Items.EndUpdate;
ComboBox4.Items.EndUpdate;
removeCat(catT);
end;
Please help :(
The Components property, and the RemoveComponent method are the wrong things to use here. These are for ownership and lifetime management. Typically the only thing on your form that owns anything is the form itself. So using Components on the combo box will always results in an error.
Instead you need to use the Items property of the combo box, and its Delete method. It might look like this:
var
Index: Integer;
....
catT := ComboBox4.Text;
Index := ComboBox4.Items.IndexOf(catT);
if Index <> -1 then
ComboBox4.Items.Delete(Index);
I don't know exactly how to explain my question. Here is my try to explain: the function FindNext(SearchRec) will get me the next file from a directory. In my application I am looking sometimes go to backward a few files from my current SearchRec index. So how can I do that?
So I am looking for the oppose of FindNext(SearchRec) a function like FindBackward(SearchRec)
There's no such function. You'll need to keep track of previous hits in a list, say, and do the back tracking using that list.
I suggest to place them in an array of TSearchRec
SearchRecArr:array of TSearchRec;
Then when you reach a certain file, get the SearchRec that you need from the Array.
for example, this is an example where I placed in some folder 3 text files of names (z, z1, & z2).
then If I reached 'z2.txt' I will read SearchRec 2 steps backwards:
procedure TForm2.Button1Click(Sender: TObject);
var
SearchRec:TSearchRec;
SearchRecArr:array of TSearchRec;
i:integer;
begin
i:=-1;
if FindFirst('C:\Users\zeina.shehab\Desktop\New folder\z*.txt',faAnyFile,SearchRec)=0 then
begin
repeat
SetLength(SearchRecArr,length(SearchRecArr)+1);
SearchRecArr[high(SearchRecArr)]:=SearchRec;
inc(i);
if SearchRec.Name='z2.txt' then
caption:=SearchRecArr[i-2].Name;
until (FindNext(SearchRec)<>0);
end;
end;
I wrote my own function. Here is the code which works very well for me and it is very efficient for thousands of files(because it doesn't slow my playback algorithm).
Procedure GetBackward(var SRInitial:TSearchRec; iForwardSpeed:integer);
var SR:TSearchRec;
iIndex:integer;
vLastFiles:Array of String;
begin
SetLength(vLastFiles,Trunc(iForwardSpeed));
FindFirst(sPath+'*.txt',faAnyFile,SR);
while (FindNext(SR) = 0)and(SR.Name <> SRInitial.Name) do
begin
for iIndex := 0 to high(vLastFiles)-1 do
vLastFiles[iIndex]:=vLast[iIndex+1];
vLastFiles[high(vLastFiles)]:=SR.Name;
end;
//Fewer than ForwardSpeed
if vLastFiles[0] = '' then
begin
Exit;
end;
FindClose(SR);
FindClose(SRInitial);
FindFirst(sPath+'*.'+cbType.Text,faAnyFile,SRInitial);
while (FindNext(SRInitial) = 0)and(SRInitial.Name <> vLastFiles[0]) do
;
end;
The function was modified.
I want to list name of all forms exist in my project in a ListBox Dynamically, then by clicking on each of them, list all buttons exist on that form in another ListBox.
But I don't know if it can be implemented and how it can.
In case you are on Delphi 2010 you can use RTTI to list all registered ( = somehow used in the application) form classes:
uses
TypInfo, RTTI;
procedure ListAllFormClasses(Target: TStrings);
var
aClass: TClass;
context: TRttiContext;
types: TArray<TRttiType>;
aType: TRttiType;
begin
context := TRttiContext.Create;
types := context.GetTypes;
for aType in types do begin
if aType.TypeKind = tkClass then begin
aClass := aType.AsInstance.MetaclassType;
if (aClass <> TForm) and aClass.InheritsFrom(TForm) then begin
Target.Add(aClass.ClassName);
end;
end;
end;
end;
You must somehow take care that the class is not completely removed by the linker (therefor the registered hint above). Otherwise you cannot get hands on that class with the method described.
The forms are usually listed using Screen.Forms property, ex:
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
Memo1.Lines.Clear;
for I:= 0 to Screen.CustomFormCount - 1 do
Memo1.Lines.Add(Screen.Forms[I].Caption);
end;
sabri.arslan's answer is the way to go to find all instantiated forms at run-time.
In the comments Hamid asked for a way to find unassigned forms as well. Assuming that by unassigned he means uninstantiated forms, there would be only one way to do so and that is to iterate over the registry of classes used by the vcl streaming system to instantiate components by name when a dfm is streamed in.
However, IIRC, forms are not automatically added to the registry. In fact, if you want to instantiate forms based on a string of their name, you need(ed) to add them to the class registry yourself. OP could of course do that for each of the forms in his project himself. But, that leaves the problem that the class registry used by the streaming system is implemented using var's in the implementation section of the classes unit. And therefore can't be iterated over (easily) from the outside.
So the solution would be to use the initialization section of all form units in the project and register each form in a "roll-your-own" registry with their name and class and have the registry provide the methods to iterate over the registered forms. These method can be used to populate the listbox mentioned by the OP.
To get at the TButtons on a form would then require instantiating the form (it could remain hidden) and iterating over the components using code similar to sabri.arslan's answer to find the TButton instances.
Instantiating the form would require getting the class of the form from the registry based on the form's name selected in the listbox.
Example of a simple roll-your-own form registry:
unit Unit1;
interface
uses
Classes
, Forms
, SysUtils
;
procedure RegisterForm(aName: string; aClass: TFormClass);
procedure ListForms(aNames: TStrings);
function InstantiateForm(aName: string): TCustomForm;
implementation
var
FormRegistry: TStringList;
procedure RegisterForm(aName: string; aClass: TFormClass);
begin
FormRegistry.AddObject(aName, Pointer(aClass));
end;
procedure ListForms(aNames: TStrings);
var
i: Integer;
begin
for i := 0 to FormRegistry.Count - 1 do begin
aNames.Add(FormRegistry[i]);
end;
end;
function InstantiateForm(aName: string): TCustomForm;
var
idx: Integer;
frmClass: TFormClass;
begin
Result := nil;
idx := FormRegistry.IndexOf(aName);
if idx > -1 then begin
frmClass := TFormClass(FormRegistry.Objects[idx]);
Result := frmClass.Create(nil);
end;
end;
initialization
FormRegistry := TStringList.Create;
FormRegistry.Duplicates := dupError;
FormRegistry.Sorted := True;
finalization
FreeAndNil(FormRegistry);
end.
you can use "for" loop.
procedure ListForms(lbForms:TListBox);
var
i,j:integer;
begin
for i:=0 to application.ComponentCount-1 do
if application.components[i] is tform then
begin
lbForms.add(tform(application.components[i]).Name);
end;
end;
procedure ListBox1Click(Sender:TObject);
var
ix,j,i:integer;
begin
ix:=ListBox1.ItemIndex;
if ix>=0 then
begin
for i:=0 to application.componentcount-1 do
if application.components[i] is tform then
begin
if tform(application.components[i]).name=listbox1.items.strings[ix] then
begin
for j:=0 to tform(application.components[i]).controlcount - 1 do
if tform(application.components[i]).controls[i] is tbutton then
begin
listbox2.add(tbutton(tform(application.components[i]).controls[i]).caption);
end;
break;
end;
end;
end;
end;
There is no way (easy) to find the included forms.
But if you loop through the RCdata of the resources (See (1) (2) (3)), you can find the names of the forms. But that dosn't help you creating them.
In order to make forms "findable" the have to "register" them yourself, using RegisterCLass og finding them again using FindClass. See an example here: http://www.obsof.com/delphi_tips/delphi_tips.html#Button
Do you need this to be built at run time, or would compile time information work for you?
In recent versions (Delphi 2006 and higher?), you can set a compiler option to generate XML documentation for your project. A separate XML file is generated for each unit. You could parse this XML to find and forms and look at the members for any buttons.
In my app I have different forms that use the same datasource (so the queries are the same too), defined in a common datamodule. Question is, is there a way to know how many times did I open a specific query? By being able to do this, I could avoid close that query without closing it "every where else".
Edit: It's important to mention that I'm using Delphi3 and it is not a single query but several.
The idea is to use the DataLinks property of the TDataSource.
But, as it is protected, you have to gain access to it. One common trick is to create a fake descendant just for the purpose of casting:
type
TDataSourceHack = class(TDataSource);
Then you use it like:
IsUsed := TDataSourceHack(DataSource1).DataLinks.Count > 0;
You can get creative using a addref/release like approach. Just create a few functions and an integer variable in your shared datamodule to do the magic, and be sure to call them..partial code follows:
TDMShared = class(tDataModule)
private
fQueryCount : integer; // set to 0 in constructor
public
function GetQuery : tDataset;
procedure CloseQuery;
end;
function TDMShared.GetQuery : tDataset;
begin
inc(fQueryCount);
if fQueryCount = 1 then
SharedDatsetQry.open;
Result := shareddatasetqry; // your shared dataset here
end;
procedure TDMShared.CloseQuery;
begin
dec(fQueryCount);
if fQueryCount <= 0 then
shareddatasetqry.close; // close only when no refs left.
end;
EDIT: To do this with multiple queries, you need a container to hold the query references, and a way to manipulate them. a tList works well for this. You will need to make appropriate changes for your TDataset descendant, as well as create a FreeAndNil function if you are using an older version of Delphi. The concept I used for this was to maintain a list of all queries you request and manipulate them by the handle which is in effect the index of the query in the list. The method FreeUnusedQueries is there to free any objects which no longer have a reference...this can also be done as part of the close query method, but I separated it to handle the cases where a specific query would need to be reopened by another module.
Procedure TDMShared.DataModuleCreate(Sender:tObject);
begin
dsList := tList.create;
end;
Function TDMShared.CreateQuery(aSql:String):integer;
var
ds : tAdoDataset;
begin
// create your dataset here, for this example using TADODataset
ds := tAdoDataset.create(nil); // self managed
ds.connection := database;
ds.commandtext := aSql;
ds.tag := 0;
Result := dsList.add(ds);
end;
function TDMShared.GetQuery( handle : integer ) : tDataset;
begin
result := nil;
if handle > dsList.count-1 then exit;
if dsList.Items[ handle ] = nil then exit; // handle already closed
result := tAdoDataset( dsList.items[ handle ]);
Inc(Result.tag);
if Result.Tag = 1 then
Result.Open;
end;
procedure TDMShared.CloseQuery( handle : integer );
var
ds : tAdoDataset;
begin
if handle > dsLIst.count-1 then exit;
ds := tAdoDataset( dsList.items[ handle ]);
dec(ds.Tag);
if ds.Tag <= 0 then
ds.close;
end;
procedure TDMShared.FreeUnusedQueries;
var
ds : tAdoDataset;
ix : integer;
begin
for ix := 0 to dsList.Count - 1 do
begin
ds := tAdoDataset(dsLIst.Items[ ix ]);
if ds.tag <= 0 then
FreeAndNil(dsList.Items[ix]);
end;
end;
procedure TDMShared.DataModuleDestroy(Sender: TObject);
var
ix : integer;
begin
for ix := 0 to dsList.count-1 do
begin
if dsLIst.Items[ix] <> nil then
FreeAndNil(dsLIst.Items[ix]);
end;
dsList.free;
end;
Ok, a completely different solution...one that should work for Delphi 3.
Create a new "Descendant Object" from your existing dataset into a new unit, and add some behavior in the new object. Unfortunately I do not have Delphi 3 available for testing, but it should work if you can find the proper access points. For example:
TMySharedDataset = class(tOriginalDataset)
private
fOpenCount : integer;
protected
procedure Internal_Open; override;
procedure Internal_Close; override;
end;
TMySharedDataset.Internal_Open;
begin
inherited Internal_Open;
inc(fOpenCount);
end;
TMySharedDataset.Internal_Close;
begin
dec(fOpenCount);
if fOpenCount <= 0 then
Inherited Internal_Close;
end;
Then just include the unit in your data module, and change the reference to your shared dataset (you will also have to register this one and add it to the palette if your using components). Once this is done, you won't have to make changes to the other units as the dataset is still a descendant of your original one. What makes this all work is the creation of YOUR overridden object.
You could have a generic TDataSet on the shared datamodule and set it on the OnDataChange, using the DataSet property of the Field parameter
dstDataSet := Field.DataSet;
This way, when you want to close the dataset, close the dataset on the datamodule, which is a pointer to the correct DataSet on some form you don't even have to know