[gelöst] TForm zur Laufzeit registrieren und in MDI-Fenster öffnen

[Carsten1975]

Hallo zusammen,

über die Weihnachtstage habe ich ein wenig experimentiert, aber ich finde einfach keine Lösung. Vielleicht denke ich auch etwas zu kompliziert?

Ich habe diverse kleine Hilfsprogramme und möchte die Liste noch erweitern. Da ich aber nicht jedes Programm separat aufrufen möchte, habe ich mir überlegt einen sogenannten Programm-Manager als MDI zu programmieren.

Wenn ich die kleinen Hilfsprogramme direkt einbinde, funktioniert es soweit auch. Jetzt möchte ich aber das Ganze über eine Datenbank machen, damit ich nicht jedes Mal den Programm-Manager anpassen muss.

In der Datenbank habe ich eine Tabelle ‚Formulare‘ mit den Spalten ‚Id‘, ‚FrmKlasse‘, ‚FrmName‘, ‚FrmCaption‘.

Der Zugriff von der Datenbank funktioniert auch soweit, aber wie kann ich mit der Funktion ,ControlNameIsTForm‘ herausfinden ob die Form bereits gestartet wurde und dass diese nicht doppelt geöffnet wird, sondern in den Vordergrund springt?

Zudem wie kann ich die Form mit dem Stringnamen registrieren den ich aus der Datenbank nehme.

Am Ende möchte ich einfach nur noch die Daten von den Programmen in der Tabelle eintragen.

Code: Alles auswählen

Unit FProgManager;

  {$mode objfpc}{$H+}

  Interface

    Uses

      Classes,
      ComCtrls,
      Controls,
      Dialogs,
      ExtCtrls,
      Forms,
      Graphics,
      StdCtrls,
      SysUtils,
      UMaske1,
      UMaske2,
      UMaske3;

    Type

      { TFrmProgManager }

      TFrmProgManager = Class(TForm)
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        MDIScrollBox: TScrollBox;

        Procedure Button1Click(Sender: TObject);
        Procedure Button2Click(Sender: TObject);
        Procedure Button3Click(Sender: TObject);
        Procedure FormCreate(Sender: TObject);
        Procedure FormClose(Sender: TObject; Var CloseAction: TCloseAction);



      Private

        Procedure ppMenueClick(Sender: TObject);
	Procedure MDIFenster(uForm : TForm);

        function ControlNameIsTForm(const aControlName: String; out Formname: TForm): Boolean;

      Public
        function MDIChildCreated(const FormTag: Integer): Boolean;
        function MDIChildState(FormTag: Integer; uActivate: Boolean; FormClass: TFormClass; var Form: TForm): Boolean;

    End;

    Type

      TMDIRecord = Record
        MDIStatus_bol : Boolean;
      End;

      grTMDI = Array of TMDIRecord;


    Var
      FrmProgManager : TFrmProgManager;
      grMDI : grTMDI;

  Implementation

    {$R *.lfm}

    Var

      pvCaption_str    : String;
      pvIntName_str    : String;
      pvFrmID_int      : Integer;
      pvFrmKlassen_str : String;
      pvForm_frm       : TForm;
      pvFormClass_frc  : TFormClass;

    { TFrmKasse }

    Procedure TFrmProgManager.FormCreate(Sender: TObject);
    Var
      lvZaehler_int : Integer;
    Begin
      SetLength(grMDI, 10);

      For lvZaehler_int := 0 to 10 Do
      Begin
        grMDI[lvZaehler_int].MDIStatus_bol := False;
      End;

      FrmProgManager.Caption := 'Programm Manager';
      FrmProgManager.Left    := 10;
      FrmProgManager.Top     := 10;

      RegisterClass(TFrmMaske1);
      RegisterClass(TFrmMaske2);
      RegisterClass(TFrmMaske3);

    End;

    Procedure TFrmProgManager.MDIFenster(uForm : TForm);
    Begin
{
      Constant Value Description

      ANSI_CHARSET 0 ANSI characters.
      DEFAULT_CHARSET 1 Font is chosen based solely on Name and Size. If the
      described font is not available on the system, Windows will substitute
      another font.
      SYMBOL_CHARSET 2 Standard symbol set.
      MAC_CHARSET 77 Macintosh characters. Not available on NT 3.51.
      SHIFTJIS_CHARSET 128 Japanese shift-jis characters.
      HANGEUL_CHARSET 129 Korean characters (Wansung).
      JOHAB_CHARSET 130 Korean characters (Johab). Not available on NT 3.51

      GB2312_CHARSET 134 Simplified Chinese characters (mainland china).
      CHINESEBIG5_CHARSET 136 Traditional Chinese characters (taiwanese).
      GREEK_CHARSET 161 Greek characters. Not available on NT 3.51.
      TURKISH_CHARSET 162 Turkish characters. Not available on NT 3.51
      VIETNAMESE_CHARSET 163 Vietnamese characters. Not available on NT 3.51.
      HEBREW_CHARSET 177 Hebrew characters. Not available on NT 3.51
      ARABIC_CHARSET 178 Arabic characters. Not available on NT 3.51

      BALTIC_CHARSET 186 Baltic characters. Not available on NT 3.51.
      RUSSIAN_CHARSET 204 Cyrillic characters. Not available on NT 3.51.
      THAI_CHARSET 222 Thai characters. Not available on NT 3.51
      EASTEUROPE_CHARSET 238 Includes diacritical marks for eastern european
      countries. Not available on NT 3.51.
      OEM_CHARSET 255 Depends on the codepage of the operating system.
}

      uForm.Parent       := MDIScrollBox;
      uForm.Left         := 10;
      uForm.Top          := 10;
      uForm.BorderIcons  := [biSystemMenu];
      uForm.BorderStyle  := bsSizeable;
      uForm.Color        := clBtnFace;
      uForm.Font.CharSet := 0; //ANSI_CHARSET;
      uForm.Font.Color   := clWindowText;
      uForm.Font.Height  := -12;
      uForm.Font.Name    := 'Arial';
      uForm.FormStyle    := fsMDIChild;
      uForm.KeyPreview   := True;
      uForm.ParentFont   := True;
      uForm.Position     := poOwnerFormCenter;
      uForm.ShowHint     := True;
      uForm.Caption      := pvCaption_str;

      uForm.Show;
    End;

    function TFrmProgManager.ControlNameIsTForm(const aControlName: String; out Formname: TForm): Boolean;
    var
      AComponent: TComponent;
    begin
      AComponent := FindComponent(aControlName);
      Result := Assigned(AComponent) and AComponent.InheritsFrom(TForm);
      case Result of
        True:  Formname := TForm(AComponent);
        False: Formname := Nil;
      end;
    end;

    Procedure TFrmProgManager.ppMenueClick(Sender: TObject);
    Begin

      If (pvFrmKlassen_str <> '') Then
         Begin
           pvFormClass_frc := TFormClass(FindClass(pvFrmKlassen_str));
           ControlNameIsTForm(pvFrmKlassen_str, pvForm_frm);
           MDIChildState(TComponent(Sender).Tag, True, pvFormClass_frc, pvForm_frm);

           If (grMDI[pvFrmID_int].MDIStatus_bol) Then
              Begin
//                pvForm_frm.BringToFront;
              End
           Else
              Begin


                MDIFenster(pvForm_frm);

              End;
         End
    End;

    Procedure TFrmProgManager.FormClose(Sender: TObject; Var CloseAction: TCloseAction);
    Begin
      Free;
    End;


    Function TFrmProgManager.MDIChildCreated(Const FormTag: Integer): Boolean;
    Var
      I: Integer;
    Begin
      Result := False;

      If (grMDI[pvFrmID_int].MDIStatus_bol) Then Result := True;

    End;

    Function TFrmProgManager.MDIChildState(FormTag: Integer; uActivate: Boolean; FormClass: TFormClass; Var Form: TForm): Boolean;
       Procedure Init(FormClass: TFormClass; Var Form: TForm);
       Begin
         If uActivate Then
            Begin
              If Not MDIChildCreated(FormTag{TForm(Form)}) Then
                 Begin
                   Form     := FormClass.Create(Application);
                   MDIFenster(Form);
                   Form.Tag := FormTag;
                   grMDI[pvFrmID_int].MDIStatus_bol := True;
                 End;
              If Form.WindowState = wsMinimized Then Form.WindowState := wsNormal;

//              Form.BringToFront;
            End
         Else If MDIChildCreated(FormTag) Then Form.Close;
       End;

    Begin

      Result := True;

      Init(FormClass, TForm(Form));

{
      case pvFrmID_int of
              1   :  Init(TFrmMaske1, TForm(FrmMaske1));
              2   :  Init(TFrmMaske2, TForm(FrmMaske2));
              3   :  Init(TFrmMaske3, TForm(FrmMaske3));
      end; }
    End;


    Procedure TFrmProgManager.Button1Click(Sender: TObject);
    Begin
      pvCaption_str    := 'Maske1';
      pvFrmID_int      := 1;
      pvFrmKlassen_str := 'TFrmMaske1';

      ppMenueClick(Sender);
    End;

    Procedure TFrmProgManager.Button2Click(Sender: TObject);
    Begin
      pvCaption_str    := 'Maske2';
      pvFrmID_int      := 2;
      pvFrmKlassen_str := 'TFrmMaske2';

      ppMenueClick(Sender);
    End;

    Procedure TFrmProgManager.Button3Click(Sender: TObject);
    Begin
      pvCaption_str    := 'Maske3';
      pvFrmID_int      := 3;
      pvFrmKlassen_str := 'TFrmMaske3';

      ppMenueClick(Sender);
    End;

End.

Vielen Dank für eure Hilfe und Antworten.

[Winni]

Hi!

Bevor Du Dich in dein persönliches MDI-Unglück stürzt, solltest Du diesen Thread aus diesem Forum lesen:

viewtopic.php?t=10791

Winni

[Carsten1975]

Das habe ich schon.

Nur funktioniert das Beispiel nicht richtig, da fehlen nämlich rechts oben die Button Minimize, Maximize and Close.

Code: Alles auswählen

unit MDIForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, MultiDoc, ChildDoc,
  MDIChild_1, MDIChild_2, MDIChild_3;

type

  { TFrmMDIForm }

  TFrmMDIForm = class(TForm)
    MainMenu1: TMainMenu;
    mnuForm: TMenuItem;
    mnuForm1: TMenuItem;
    mnuForm2: TMenuItem;
    mnuForm3: TMenuItem;
    MDcMainFrm: TMultiDoc;
    procedure mnuForm1Click(Sender: TObject);
    procedure mnuForm2Click(Sender: TObject);
    procedure mnuForm3Click(Sender: TObject);
  private

  public

  end;

var
  FrmMDIForm: TFrmMDIForm;

implementation

{$R *.lfm}

{ TFrmMDIForm }

procedure TFrmMDIForm.mnuForm1Click(Sender: TObject);
Var
  Child : TChildDoc;
  FormChild : TFrmMDIChild_1;

Begin

  Child := MDcMainFrm.NewChild;
  FormChild := TFrmMDIChild_1.Create(Child);
  Child.DockedPanel := FormChild.Panel1;


end;

procedure TFrmMDIForm.mnuForm2Click(Sender: TObject);
Var
  Child : TChildDoc;
  FormChild : TFrmMDIChild_2;

Begin

  Child := MDcMainFrm.NewChild;
  FormChild := TFrmMDIChild_2.Create(Child);
  Child.DockedPanel := FormChild.Panel1;


end;

procedure TFrmMDIForm.mnuForm3Click(Sender: TObject);
Var
  Child : TChildDoc;
  FormChild : TFrmMDIChild_3;

Begin

  Child := MDcMainFrm.NewChild;
  FormChild := TFrmMDIChild_3.Create(Child);
  Child.DockedPanel := FormChild.Panel1;


end;

end.

[charlytango]

Soweit ich mich noch dunkel erinnere liefen die Buttons über den FormStyle des verwendetet Formulars (ich glaube fsMDIForm oder fsMDIChild).
Will dir nicht ins handwerk pfuschen, aber eine Datenbank als simple Programmsteuerung wäre jetzt nicht meine erste Wahl. Reicht da nicht ein Hauptmenü von dem aus alle verfügbaren Fenster aufgerufen werden können?
Denn um aufgerufen zu werden muss das Fenster erstmal existieren (ich gehe davon aus dass du Lazarus als RAD benutzt und Formulare zeichnest statt sie zur Laufzeit zu erzeugen). Und sie dann ins Menü einzuhängen ist ein Klacks

MDI ist aber aktuell nicht wirklich die Oberfläche der Wahl. Modernere Oberflächen arbeiten eher mit Tabreitern und eingedockten Formularen.
Eine Möglichkeit die ich gerne benutze ist TDINotebook. Eine Komponente die Fenster managed und auch wahlweise eingedockt oder frei fliegend verwaltet.

https://wiki.lazarus.freepascal.org/TTDINotebook

Wobei dann jedes von dir entworfene Formular (auch mehrfach zb für das gleichzeitige Bearbeiten zweier Personen) als Tab in die Oberfläche eingehängt werden kann. Die beiliegende Demo klappt ganz ordentlich und einen Versuch ist es allemal wert.

Das Package kann über den OPM (Online Package Manager) installiert werden.
Falls du den noch nicht installiert hast findet du das OPM Package im Lazarus Verzeichnis unter <....lazarusverzeichnis>\lazarus\components\onlinepackagemanager

LG

.

[fliegermichl]

Um auf Deine Frage zurückzukommen.
Es gibt die Instanzvariable Screen vom Typ TScreen.

Diese hat u.a. die Properties FormCount und Forms die du in einer Schleife abfragen kannst.
Beispiel:

Code: Alles auswählen

procedure TForm1.Findeform(aForm: TFormclass);
var i : integer;
 Form : TCustomForm;
begin
 for i := 0 to Screen.FormCount - 1 do
  if (Screen.Forms[i] is aForm) then
  begin
    Screen.Forms[i].Show;
    Screen.Forms[i].BringToFront;
    exit;
  end;
  Form := aForm.Create(Application);
  Form.Show;
end;

[Carsten1975]

Vielen Dank an fliegermichl, genau das war die Lösung.

Allerdings habe ich noch weitere Fragen:

Zudem wie kann ich die Form mit dem Stringnamen registrieren, den ich aus der Datenbank nehme?
Wie kann ich die Units dynamisch in die Uses einbinden, ohne jedesmal das Programm neu erstellen zu lassen, da ich ja die Forms nur in der Datenbank ergänzen möchte?

Gibt es soetwas wie einen Tree wo sämtliche Klassen wie ein Baum aufgeführt sind?
In der normalen Hilfe ist das ja alles nur etwas vereinfacht dargestellt?

Vielen Dank für eure weiteren Antworten
und einen guten Rutsch ins neue Jahr 2022.

[fliegermichl]

Wenn es vorgefertigte (im Designer erstellte) Formulare sind, dann müssen alle deren Units mit in das Programm eincompiliert sein.
Siehe Projekt -> Projekteinstellungen -> Projekteinstellungen -> Formulare -> Verfügbare Formulare.

Wenn es wirklich dynamische Formulare sind, deren Inhalte ebenfalls aus der Datenbank geholt werden, dann muß nur die Unit "Forms" eingebunden werden.

Man kann dann allerdings keine unteschiedlichen Formularklassen definieren (da diese ja unbekannt sind). Alles ist dann TForm.

Deren Eigenschaft "Name" kann allerdings zur Laufzeit festgelegt und das Formular somit auch identifiziert werden.
Name muss ein gültiger Pascalbezeichner sein.

Die units aller in den Formularen verwendeten Komponenten müssen eingebunden werden und diese dann per Prozedur erstellt werden.