Dynamically list all forms in a project - delphi

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.

Related

How to convert the numeric keypad dot-key into the DecimalSeparator?

In some applications, like Microsoft Excel, the dot-key from the numeric keypad (VK_DECIMAL) is automatically converted into the current DecimalSeparator.
I'm trying to implement the same feature but I didn't find a way to make it work in the whole application.
At the form level, it can be done by using the form's KeyPreview property and OnKeyPress event handler, for example:
function IsKeyPressed(const AKey : Word) : Boolean;
begin
Result := GetKeyState(AKey) < 0;
end;
procedure TMyBaseForm.FormCreate(Sender: TObject);
begin
inherited;
KeyPreview := True;
end;
procedure TMyBaseForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
inherited;
if(IsKeyPressed(VK_DECIMAL))
then Key := FormatSettings.DecimalSeparator;
end;
But this solution requires to have a common base form class for all application's forms and won't work with any form/dialog who is not inheriting from that base class (i.e: It will not work with a simple InputQuery either)

How to create an instance of every form in my project?

I have ported an application from ADO to FireDAC applying several RegExp replaces on the source code to convert the ADOQuery, ADOTables, ADOCommands, ADOStoredProcs, etc. ... to the corresponding FireDAC components.
It has worked fine, but now when running that application plenty of forms raise errors because of the type of the persistent fields being different than the type expected (the one defined from ADO when the persistent field was created).
I'm trying to make a list of those errors, creating an instance of all my forms and opening their datasets with persistent fields, and logging the errors. I can get the list of forms from the project source code, but when I try to use FindClass to create each form I get an error telling that the class has not been found.
Is there any other way to create a Form/DataModule from its class name ?.
This is my current code:
class procedure TfrmCheckFormularis.CheckDatasets(ProjecteFile: string);
var frmCheckFormularis: TfrmCheckFormularis;
Projecte: string;
rm: TMatch;
cc: TComponentClass;
c: TComponent;
i: integer;
Dataset: TFDQuery;
begin
Projecte := TFile.ReadAllText(ProjecteFile);
frmCheckFormularis := TfrmCheckFormularis.Create(Application);
try
with frmCheckFormularis do begin
Show;
qryForms.CreateDataSet;
qryErrors.CreateDataSet;
// I get a list of all the forms and datamodules on my project
for rm in TRegEx.Matches(Projecte, '^(?:.* in '')(?<File>.*)(?:'' {)(?<Class>.*)(?:},)', [roMultiline]) do begin
qryForms.AppendRecord([rm.Groups['File'].Value, rm.Groups['Class'].Value]);
end;
// Check every form and datamodule
qryForms.First;
while not qryForms.Eof do begin
cc := TComponentClass(FindClass(qryFormsClass.Value));
c := cc.Create(frmCheckFormularis);
try
for i := 0 to c.ComponentCount - 1 do begin
if c.Components[i] is TFDQuery then begin
Dataset := c.Components[i] as TFDQuery;
// When the Dataset has persistent fields, I open it to check if the persistent fields are correct
if Dataset.FieldDefs.Count > 1 then begin
try
Dataset.Open;
except
on E: Exception do qryErrors.AppendRecord([c.Name, Dataset.Name, E.Message]);
end;
end;
end;
end;
finally
c.Free;
end;
qryForms.Next;
end;
end;
finally
frmCheckFormularis.Free;
end;
end;
Thank you.
Using the "new" RTTI in Delphi is quite easy. The following code will (hopefully*) create one instance of each form in your application:
procedure TForm1.Button1Click(Sender: TObject);
var
Context: TRttiContext;
&Type: TRttiType;
InstanceType: TRttiInstanceType;
begin
Context := TRttiContext.Create;
for &Type in Context.GetTypes do
begin
if (&Type.TypeKind = tkClass) and &Type.IsInstance then
begin
InstanceType := TRttiInstanceType(&Type);
if InstanceType.MetaclassType.InheritsFrom(TForm) and (InstanceType.MetaclassType <> TForm) then
TFormClass(InstanceType.MetaclassType).Create(Application){.Show}; // optionally show it
end;
end;
end;
* Technically, it will create one instance of each proper descendant class of TForm.

Procedure to find component in new unit

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;

Avoid that SetFocus raises an Exception

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.

How to implement some sort of Form Manager?

I'm in the middle of a project with a number of child forms. Many of the forms may be open at once. I'd like to know if there's already something I can use to manage and keep track of these forms, much like the windows taskbar and/or task manager. If not, then what would be the best approach? I don't want to have to reinvent the wheel if this is already done.
Description
As mentioned above, this project has many forms which may be opened at once. I will also be implementing some visual list control (much like the taskbar or task manager) for user control of these forms (or in the user's case, the forms are called windows). The most ideal way to manage these would be to first capture each of these forms as they're created and keep record of them somewhere. Some forms need this behavior, and some forms do not. For example, modal forms will never need this handling.
I will be giving the user access to show, minimize, or close these forms, as well as some other future un-thought handling, like maybe a custom popup menu associated with one of these forms (but that's another subject). The point is, I need to build something to capture these forms and keep them in order.
This will also include some other user interaction with all the forms at once, as well as simple access to each one of them, similar to how Screen.Forms already works. For example, a command to minimize all forms (FormManager.MinimizeAll), to maximize the currently active form (FormManager.ActiveForm.Maximize), or with a particular form (FormManager[3].Maximize).
Possible Options
I understand there are a few far different approaches to accomplish similar results, and haven't started coding it yet because each of those approaches has a different starting point. The options are...
Wrap Screen.Forms and other associated functionality from the Screen (which wouldn't allow too much of my desired flexibility)
Every time I create a form, register it with this form manager (which is very flexible, but I have to make sure I always register each created form)
Build a master form to register its self with the form manager and inherit everything from it (which is also very flexible, but in different ways, and much more complex)
The second option is sounding the most promising so far. But again, I don't want to start building it if there is already a solution for this. I'm pretty confident that I'm not the first person to do this. I don't know how to search for such a thing, I get nothing related to what I want on Google.
The global variable Screen (in Forms unit) does some "tracking", ie
Screen.Forms list all currently open forms;
Screen.ActiveForm form which has input focus (see also FocusedForm);
Screen.OnActiveFormChange event;
You could add each form to a TObjectList. I wrote a component called FormStack, which allows you to add forms (even forms with the same name), retrieve, remove, etc. To get a Task Manager like behavior, I think you'd just need to iterate the list to obtain form names . Hopefully you can use something here to shed some light on your idea..
Here's the code for FormStack.
unit uFormstack;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Contnrs;
type
TFormstack = class(TComponent)
private
{ Private declarations }
FormList: TObjectList;
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Procedure Add(InstanceClass: TComponentClass; Var Reference);
Procedure RemoveLast;
Procedure RemoveAll;
Function FindForm(AComponentClass: TComponentClass): Boolean;
Function GetForm(AComponentClass: TComponentClass): TObject;
Function GetByIndex(AIndex: Integer): TObject;
Procedure RemoveByIndex(AIndex: Integer);
published
{ Published declarations }
end;
procedure Register;
implementation
//{$R *.res}
procedure Register;
begin
RegisterComponents('FormStack', [TFormstack]);
end;
{-----------------------------------------------------------------------------
TFormStack
-----------------------------------------------------------------------------}
Constructor TFormStack.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
FormList := TObjectList.Create;
FormList.OwnsObjects := True;
End;
Destructor TFormStack.Destroy;
Begin
FormList.Free;
Inherited Destroy;
End;
Procedure TFormStack.Add(InstanceClass: TComponentClass; Var Reference);
Var
Instance: TComponent;
Begin
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
Instance.Create(Self); // Owner is FormList <<-- blows up if datamodule in D2010
FormList.Add(Instance);
Instance.Tag := FormList.Count-1;
End;
Procedure TFormStack.RemoveAll;
Var
I: Integer;
Begin
For I := FormList.Count -1 downto 0 do // last in first out
begin
Self.RemoveLast;
End;
End;
// This removes the last form on the stack
Procedure TFormStack.RemoveLast;
Begin
if FormList.Count > 0 then
FormList.Remove(FormList.Items[FormList.Count-1]);
End;
Function TFormStack.FindForm(AComponentClass: TComponentClass): Boolean;
Var
I: Integer;
Begin
Result := False;
For I := FormList.Count-1 downto 0 do
If Formlist.Items[I].ClassType = AComponentClass then
Result := True;
End;
Function TFormStack.GetForm(AComponentClass: TComponentClass): TObject;
Var
I: Integer;
begin
Result := Nil;
For I := FormList.Count-1 downto 0 do
If Formlist.Items[I].ClassType = AComponentClass then
Result := FormList.Items[I];
end;
Function TFormStack.GetByIndex(AIndex: Integer): TObject;
begin
Result := Nil;
If FormList.Count-1 >= AIndex then
Result := FormList.Items[AIndex];
end;
Procedure TFormStack.RemoveByIndex(AIndex: Integer);
begin
If FormList.Count-1 >= AIndex then
FormList.Remove(FormList.Items[AIndex]);
end;
end.
If I understand you correctly, you want to track this in code while the app is running?
Maybe you can do something with Screen.Forms?

Resources