1
votes

I have a large application with several forms that are being created when user clicks on menu bar. I want to give them the functionality to call a child form by typing its Name in a Edit component. ChildForms are being normally created by the following procedure:

procedure CreateChildForm(ChildClass: TComponentClass; var Reference);
 begin
   Screen.Cursor := crHourGlass;
   try
     if (FindChildForm(ChildClass, TObject(Reference))) then
begin
  (TObject(Reference) as TForm).WindowState := wsNormal;
  (TObject(Reference) as TForm).Show;
end
else
  Application.CreateForm(ChildClass,Reference);
  except
  on e: exception do
    ErrorMsg('Exception -> CreateChildForm ' + e.message);
  end;
  Screen.Cursor := crDefault;
end;

like this.

procedure TMain.acPN010Execute(Sender: TObject);
begin
  CreateChildForm(TfrmPN010,frmPN010);
end;

How do I pass the string as a parameter to that procedure ?

1
You can't. A string is, well, a string. You'd need a way to look up the reference given a string. But it doesn't sound like a very good design.David Heffernan
I would use a combobox, populate with entries from your menu bar. This way user can't mistype, you have gor each displayed form name exact Info in the object of the items entry.nil
Maybe the GetClass function can help you, it allows you to get a class starting from its classname.Fabrizio
Application.FindComponent('frmPN010_1') as TForm should give you the first instance created by that procedure. But as has been said, such design is no good.Victoria

1 Answers

1
votes

To expand on my comment, here an example of using a TCombobox to create child forms. This can potentially be used to basically re-use your menu code and automatically adjust to changing your menu - e.g. when new child forms are added to your project.

You are not mentioning your menu class types or structure, but this should be adjustable depending on implementation details.

With following code you can populate the Items of a combobox with all sub-items of a TMenuItem:

procedure FillCombobox(AMenuItem: TMenuItem; ACombobox: TCombobox);
var
  I: Integer;
begin
  for I := 0 to AMenuItem.Count - 1 do
    ACombobox.Items.AddObject(AMenuItem.Items[I].Caption, AMenuItem.Items[I]);
end;

Using the OnSelect event of the combobox you can do exactly what a click on a given menu item had done:

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
  TMenuItem(ComboBox1.Items.Objects[ComboBox1.ItemIndex]).Click;
end;

A small test project using this and the code for creating child forms you provided - except FindChildForm and ErrorMsg, details on what that does unknown.

.pas:

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    FormNo11: TMenuItem;
    FormNo21: TMenuItem;
    ComboBox1: TComboBox;
    Panel1: TPanel;
    procedure FormNo21Click(Sender: TObject);
    procedure FormNo11Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Select(Sender: TObject);
  private
    { Private declarations }
    FChild1: TForm;
    FChild2: TForm;
  public
    { Public declarations }
  end;

  TChild1 = class(TForm)
    constructor Create(AOwner: TComponent); override;
  end;

  TChild2 = class(TForm)
  public
    constructor Create(AOwner: TComponent); override;
  end;

    procedure FillCombobox(AMenuItem: TMenuItem; ACombobox: TCombobox);

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure CreateChildForm(ChildClass: TComponentClass; var Reference);
Begin
  Screen.Cursor := crHourGlass;
  try
//    if (FindChildForm(ChildClass, TObject(Reference))) then
//    begin
//      (TObject(Reference) as TForm).WindowState := wsNormal;
//      (TObject(Reference) as TForm).Show;
//    end
//    else
    Application.CreateForm(ChildClass,Reference);
  except
  on e: exception do
    raise;
//    ErrorMsg('Except/on -> CreateChildForm ' + e.message);
  end;
  Screen.Cursor := crDefault;
end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
  TMenuItem(ComboBox1.Items.Objects[ComboBox1.ItemIndex]).Click;
end;

procedure FillCombobox(AMenuItem: TMenuItem; ACombobox: TCombobox);
var
  I: Integer;
begin
  for I := 0 to AMenuItem.Count - 1 do
    ACombobox.Items.AddObject(AMenuItem.Items[I].Caption, AMenuItem.Items[I]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillCombobox(N1, ComboBox1);
end;

procedure TForm1.FormNo11Click(Sender: TObject);
begin
  CreateChildForm(TChild1, FChild1);
end;

procedure TForm1.FormNo21Click(Sender: TObject);
begin
  CreateChildForm(TChild2, FChild2);
end;

{ TChild1 }

constructor TChild1.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  FormStyle := fsMDIChild;
  Caption := 'No. I';
end;

{ TChild2 }

constructor TChild2.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  FormStyle := fsMDIChild;
  Caption := 'No. II';
end;

end.

.dfm:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 344
  ClientWidth = 649
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsMDIForm
  Menu = MainMenu1
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 303
    Width = 649
    Height = 41
    Align = alBottom
    Caption = 'Panel1'
    TabOrder = 0
    ExplicitTop = 309
    object ComboBox1: TComboBox
      Left = 8
      Top = 12
      Width = 145
      Height = 21
      AutoCompleteDelay = 2500
      AutoDropDown = True
      TabOrder = 0
      OnSelect = ComboBox1Select
    end
  end
  object MainMenu1: TMainMenu
    Left = 24
    Top = 8
    object N1: TMenuItem
      Caption = 'Forms'
      object FormNo11: TMenuItem
        Caption = 'Form No. 1'
        OnClick = FormNo11Click
      end
      object FormNo21: TMenuItem
        Caption = 'Form No. 2'
        OnClick = FormNo21Click
      end
    end
  end
end