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;
Related
I am working at a huge, legacy source code where several SetFocus is called at many places, but sometimes, the check if the control is visible or enabled is missing.
Due to limited time, and the huge amount of source code, I decided that I want to ignore these errors, since the focus is (in our case) not a critical feature. A raised Exception will result in a complete failure, while a missing focus is just an optical issue.
My current plan is following:
I create an unit with a class helper like this:
type
TWinControlEx = class helper for TWinControl
procedure SetFocusSafe;
end;
procedure TWinControlEx.SetFocusSafe;
begin
if CanFocus then SetFocus;
end;
I include the unit to every unit which uses ".SetFocus" (I will use the global code search)
I replace every .SetFocus with .SetFocusSafe
There is a problem though: If possible, I want to avoid that coworkers accidently use .SetFocus , or forget to include the classhelper unit.
Which other options do I have?
The best case would be if there is a technique/hack to make SetFocus not raising an exception. (Without recompiling the VCL)
Just patch the TWinControl.SetFocus method:
unit SetFocusFix;
interface
implementation
uses
Controls,
Forms,
SysUtils,
Windows;
type
TWinControlHack = class(TWinControl)
public
procedure SetFocus; override;
end;
procedure TWinControlHack.SetFocus;
var
Parent: TCustomForm;
begin
if not CanFocus then Exit;
Parent := GetParentForm(Self);
if Parent <> nil then
Parent.FocusControl(Self)
else if ParentWindow <> 0 then
Windows.SetFocus(Handle)
else
ValidParentForm(Self);
end;
procedure RedirectFunction(OrgProc, NewProc: Pointer);
type
TJmpBuffer = packed record
Jmp: Byte;
Offset: Integer;
end;
var
n: UINT_PTR;
JmpBuffer: TJmpBuffer;
begin
JmpBuffer.Jmp := $E9;
JmpBuffer.Offset := PByte(NewProc) - (PByte(OrgProc) + 5);
if not WriteProcessMemory(GetCurrentProcess, OrgProc, #JmpBuffer, SizeOf(JmpBuffer), n) then
RaiseLastOSError;
end;
initialization
RedirectFunction(#TWinControl.SetFocus, #TWinControlHack.SetFocus);
end.
Alternatively
TWinControlEx = class helper for TWinControl
procedure SetFocus; reintroduce;
end;
with...
procedure TWinControlEx.SetFocus;
var
Parent: TCustomForm;
begin
if not CanFocus then Exit;
Parent := GetParentForm(Self);
if Parent <> nil then
Parent.FocusControl(Self)
else if ParentWindow <> 0 then
Winapi.Windows.SetFocus(Handle)
else
ValidParentForm(Self);
end;
My answer below does not answer DIRECTLY your question but it is still relevant because you rely on CanFocus. CanFocus returns a lie. You should not rely on it. The documentation is also wrong. More exactly, CanFocus can return True even if the control is not focusable. In this case an exception will be raised.
So, use this instead:
function CanFocus(Control: TWinControl): Boolean;
begin
Result:= Control.CanFocus AND Control.Enabled AND Control.Visible;
if Result
AND NOT Control.InheritsFrom(TForm)
then
{ Recursive call:
This control might be hosted by a panel which could be also invisible/disabled.
So, we need to check all the parents down the road, until we encounter the parent Form.
Also see: GetParentForm }
Result:= CanFocus(Control.Parent); { Parent of a control could be nil, but in this case Control.CanFocus will deal with that.}
end;
procedure SetFocus(Control: TWinControl);
begin
if CanFocus(Control)
then Control.SetFocus;
end;
PS: Under Lazarus CanFocus works properly.
Justification:
J provided a nice answer, but I don't like class helpers because if you have more than one class helper for the same class, the only one will be used. The process is almost "by dice": the order of the units in the "uses" clause determine which helper will apply. I don't like this amount of randomness in a programming language.
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;
We have a HUGE Delphi 2005 application with LOTS of ADO components (TADODataset, TADOStoredPRoc, TADOCommand...) spread on hundreads of forms. All of them are connected to a SINGLE TADOConnection.
Most of these components have their CommandTimeout property set to the default (30s) but a few have it set to 5 minutes (300s) and some are set to never timeout (0s).
I'd like to be able to globally change this setting for all ADO components application-wide. I'd prefer to do it programmatically at runtime so that I could tweak the timeouts on a per-installation basis if I need to.
I was hoping I could find a global event on the connection when an ADO component is created/attached, where I could tweak the commandtimeout, or hack my way into injecting my code in the components themselves, but came up blank.
I don't want to create decendants because I'll have to search/replace trought all the components, and if I ever forget to use the descendants instead of the regular ADO components my timeout wont follow the rest of the application.
Anybody has an idea how we could do this ?
If all of you ADO components are placed on a form, you can iterate over all forms using the Screen.Forms and Screen.FormCount properties. For each form iterate over its ComponentCount/Components property and check for TADOCommand, TADODataSet, TADOQuery, TADOStoredProc and TADOTable. Then you can set the timeout as you wish. Of course, if you create forms dynamically you have to take this into account separately.
The following code may guide you.
procedure SetADOTimeout(ATimeout: Integer);
var
cmp: TComponent;
frm: TForm;
I: Integer;
J: Integer;
begin
for I := 0 to Screen.FormCount - 1 do begin
frm := Screen.Forms[I];
for J := 0 to frm.ComponentCount - 1 do begin
cmp := frm.Components[J];
if cmp is TADOCommand then
TADOCommand(cmp).CommandTimeout := ATimeout
else if cmp is TADODataSet then
TADODataSet(cmp).CommandTimeout := ATimeout
else if cmp is TADOQuery then
TADOQuery(cmp).CommandTimeout := ATimeout
else if cmp is TADOStoredProc then
TADOStoredProc(cmp).CommandTimeout := ATimeout
else if cmp is TADOTable then
TADOTable(cmp).CommandTimeout := ATimeout;
end;
end;
end;
Greetings to all Argentinian solutions!
Just define the OnWillExecute event handler for the TADOConnection you have and write following code:
type
TCustomADODataSetAccess = class(TCustomADODataSet);
procedure TYourDataModule.ADOConnectionWillExecute(...);
var
i: Integer;
begin
for i := 0 to ADOConnection.DataSetCount - 1 do
TCustomADODataSetAccess(ADOConnection.DataSets[i]).CommandTimeout := Connection.CommandTimeout;
end;
This will set the command timeout for any query/table/stored procedure which uses your ADO connection.
According to the documentation, you can use CommandCount and Commands to locate all the open components attached to your TADOConnection.
Your problem is likely to be dynamically created forms. You'll need to find "something" to hook when a form is created and check for ADO components on that form.
If your forms descend from a custom form class, you could do this in the form's constructor or OnCreate event.
If not, you could look at TApplicationEvents and using the TApplication's OnIdle event.
Since CommandTimeout is introduced in the TCustomADODataset class, you can iterate for each form/datamodule, find a TCustomADODataset and it's descendants (ADODataset, ADOTable, ADOQuery) then set the Property.
procedure SetADOCommandTimeOut(aTimeOut: integer);
var
i, j: integer;
begin
for i:= 0 to Screen.FormCount-1 do
begin
for j:= 0 to Forms[i].ComponentCount-1 do
if Forms[i].Components[j] is TCustomADODataset then
TCustomADODataset1(Forms[i].Components[j]).CommandTimeOut:= aTimeOut;
end;
for i:= 0 to Screen.DataModuleCount-1 do
begin
for j:= 0 to Datamodules[i].ComponentCount-1 do
if Datamodules[i].Components[j] is TCustomADODataset then
TCustomADODataset1(Datamodules[i].Components[j]).CommandTimeOut:= aTimeOut;
end;
end;
Note: TCustomADODataset1 is exactly TCustomADODataset, only it has a published CommandTimeOut property :
TCustomADODataset1 = class(TCustomADODataset)
published
property CommandTimeOut;
end;
But it's only applied to forms/datamodules which are already created. If you create your forms/datamodules dynamically, then you must apply it whenever a new form/datamodule is created.
One way to do it is by override Notification in your Mainform, checking for a new a creation of form/datamodule, but this a little bit tricky since at the the creation time, all the components are not created yet. You trick it by delay it for a while using a timer (I don't know a more elegant way - just to show the idea)
Procedure TMainForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (Operation = opInsert) and (
((AComponent is TForm) and not (aComponent is TMainForm)) // exclude MainForm
or (AComponent is TDataModule)
) then
begin
Timer1.Interval:= 2000; // 2 seconds ?
Timer1.Enabled:= True;
end;
end;
Procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:= False;
SetADOCommandTimeOut(MyTimeOut);
end;
You create datamodule hierarchies? If so, you can use code like Uwe's answer on your patriarch form (which all other datamodules inherit).
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