unit UNew;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, MemDS, DBAccess, Ora,
  Vcl.StdCtrls, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
  cxContainer, cxEdit, cxListBox, cxDBEdit, cxTextEdit, cxMaskEdit,
  cxDropDownEdit, cxLookupEdit, cxDBLookupEdit, cxDBLookupComboBox, cxStyles,
  cxCustomData, cxFilter, cxData, cxDataStorage, cxDBData,
  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
  cxClasses, cxGridCustomView, cxGrid;

type
// TInstError = procedure(const Content: String) of object;
  TFrmNew = class(TForm)

    OraSession: TOraSession;
    fncsleep: TOraStoredProc;
    lbl_oraconnect: TLabel;
    lbl_orasleep: TLabel;
    lbl_3: TLabel;
    lbl_FormName: TLabel;
    lbl1: TLabel;
    lbl_FormTag: TLabel;
    OraSessCommon: TOraSession;
    Ds_searchMA: TOraDataSource;
    qry_searchMA: TOraQuery;
    qry_searchMAPER_PK: TIntegerField;
    qry_searchMAPER_STRORALOGIN: TStringField;
    qry_searchMAPER_STRFIRSTNAME: TStringField;
    qry_searchMAPER_STRLASTNAME: TStringField;
    qry_searchMAPER_BOLACTIVE: TIntegerField;
    qry_searchMAPER_STRPERNO: TStringField;
    cbb1: TcxLookupComboBox;
    btn_telechild: TButton;
    cxgrdbtblvwGrid1DBTableView1: TcxGridDBTableView;
    cxgrdlvlGrid1Level1: TcxGridLevel;
    cxgrd1: TcxGrid;
    cxgrdbclmnGrid1DBTableView1PER_PK: TcxGridDBColumn;
    cxgrdbclmnGrid1DBTableView1PER_STRORALOGIN: TcxGridDBColumn;
    cxgrdbclmnGrid1DBTableView1PER_STRFIRSTNAME: TcxGridDBColumn;
    cxgrdbclmnGrid1DBTableView1PER_STRLASTNAME: TcxGridDBColumn;
    cxgrdbclmnGrid1DBTableView1PER_BOLACTIVE: TcxGridDBColumn;
    cxgrdbclmnGrid1DBTableView1PER_STRPERNO: TcxGridDBColumn;
    mmo1: TMemo;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);


    procedure FormCreate(Sender: TObject);
    function update : Boolean;
    procedure btn_telechildClick(Sender: TObject);
    procedure qry_searchMAAfterScroll(DataSet: TDataSet);

  private
    { Private-Deklarationen }

  public
    { Public-Deklarationen }
  protected
      procedure CreateParams(var Params: TCreateParams); override;

  end;

  TMyThread = class(TThread)
  private
  // FInstError: TInstError;

    procedure execute; override;
    procedure doprogress;

  public
    //

  protected

    FormUsed : TFrmNew;


    //property InstError: TInstError read FInstError write FInstError;
  end;

var

  Fname : string;
  MThread : TMyThread;
  progressvar : SmallInt = 0;
  orasessioninprogress : Boolean = False;

implementation

{$R *.dfm}

uses UMain;

procedure TFrmNew.btn_telechildClick(Sender: TObject);
begin
  FrmMain.btn_telemainClick(sender);
end;

procedure TFrmNew.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;

function TFrmNew.update : Boolean;
begin
  case progressvar of
    1 : lbl_oraconnect.Caption := 'Connected';
    2 : lbl_orasleep.Caption := 'ausgeschlafen';
    3 : // im Moment nix;
  end;
  progressvar := 0; // rücksetzen
  Result := True;
end;


procedure TFrmNew.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  while orasessioninprogress do begin

    //
  end;
  qry_searchMA.Close;
  OraSessCommon.Disconnect;
// MThread.Terminate;
// FreeAndNil(MThread);

 FrmMain.killform(Self.Name, Self.Tag);
end;

procedure TFrmNew.FormCreate(Sender: TObject);
begin
  Self.Caption := Self.Name;
end;

procedure TFrmNew.FormShow(Sender: TObject);
begin

  lbl_FormName.Caption := self.Name;
  lbl_FormTag.Caption := inttostr(Self.Tag);
  MThread := TMyThread.Create(True);
  MThread.FormUsed := Self;
  MThread.FreeOnTerminate := false;
  MThread.Start;

end;

procedure TFrmNew.qry_searchMAAfterScroll(DataSet: TDataSet);
begin
  mmo1.Text:=Self.qry_searchMAPER_STRORALOGIN.AsString;
end;

procedure TMyThread.Execute;
begin
   orasessioninprogress := true;
   FormUsed.OraSessCommon.Connect;
   progressvar := 1;
   MThread.Synchronize(doprogress);
// FormUsed.qry_searchMA.Open;
// FormUsed.fncsleep.ParamByName('i_seconds').AsInteger:=4;
// FormUsed.fncsleep.Execute;


   orasessioninprogress := false;
   progressvar := 3;
   MThread.Synchronize(doprogress);
   FormUsed.qry_searchMA.Open;
   progressvar := 2;
   MThread.Synchronize(doprogress);
end;

procedure TMyThread.doprogress;
begin
  FormUsed.update;
end;

 end.

unit UMain;

interface

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

type
  PMultipleForm = ^TFrmNew;

  TFrmMain = class(TForm)
    btn_newform: TButton;
    box_frm: TListBox;
    lbl_main: TLabel;
    btn_telemain: TButton;
    procedure ShowHideClick(Sender: TObject);
    procedure btn_newformClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure box_frmClick(Sender: TObject);
    procedure btn_telemainClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }

    FormListe: TList;
    FormP: PMultipleForm;

    procedure newform(_name : string);
    procedure killform(_name : string; _tag : SmallInt);
  end;

var
  FrmMain: TFrmMain;
  FrmNames : array of string;

implementation

{$R *.dfm}


procedure TFrmMain.ShowHideClick(Sender: TObject);
begin
  FormP := FormListe[box_frm.ItemIndex];
  FormP^.Visible := not FormP^.Visible;

end;


procedure TFrmMain.box_frmClick(Sender: TObject);
begin
  FormP := FormListe[box_frm.ItemIndex];
  FormP^.Visible := not FormP^.Visible;

end;

procedure TFrmMain.btn_newformClick(Sender: TObject);
  var frm : TFrmNew;
begin



  GetMem(FormP, SizeOf(TFrmNew)); // --> reserviert an der Adresse von FormP den Speicher für die Form
  FormP^ := TFrmNew.Create(Self); // --> erzeugt die Form
  FormP^.Caption := FormP^.Caption + IntToStr(box_frm.Items.Count + 1);
  FormListe.Add(FormP); // --> fügt den Pointer zur Liste hinzu
  box_frm.Items.Add('Form' + IntToStr(box_frm.Items.Count + 1));
  Formp^.Tag := box_frm.Items.Count;
  Formp^.Name := 'Form'+inttostr(Formp^.Tag);
  Formp^.Show;

end;

procedure TFrmMain.btn_telemainClick(Sender: TObject);
  var idx : SmallInt;
    NFormP: PMultipleForm;
begin
  if btn_telemain.Caption = 'Anruf' then btn_telemain.Caption := 'Auflegen'
    else btn_telemain.Caption := 'Anruf';

  for idx := 0 to FormListe.Count-1 do
  begin
    NFormP := FormListe[idx];
    NFormP^.btn_telechild.Caption := btn_telemain.Caption;
  end;
end;

procedure TFrmMain.newform(_name : string);
begin
   setlength(FrmNames, length(FrmNames)+1); // Array um ein Element erhöhrn
   FrmNames[high(FrmNames)] := _name;
   box_frm.Items.Add(_name);
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: Integer;
begin
  for i := 0 to FormListe.Count-1 do
  begin
    FormP := FormListe[i];
    if Assigned(FormP^) then begin

    FormP^.Hide; // --> muss zuerst aufgerufen werden, da mit dem Aufruf von Free auch das OnHide-Ereignis aufgerufen wird.
    // da sich nach dem Aufruf von OnHide der Pointer verändert haben könnte würde ein EAccessViolent entstehen
    FormP := FormListe[i];
    FormP^.Free;
    FreeMem(FormP, SizeOf(TFrmNew)); // --> gibt den Speicher der für die Adresse reserviert wurde frei
    end;
  end;




  FreeAndNil(formliste);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FormListe := TList.Create;
end;

procedure TFrmMain.killform(_name : string; _tag : SmallInt);
  var idx : SmallInt;
begin
  for idx := 0 to box_frm.Count -1 do begin
    if _name = box_frm.Items[idx] then begin
      box_frm.Items.Delete(idx);
      FormP := Formliste[idx];
      FormP^.Hide;
      FormP^.Free;
      FreeMem(FormP, SizeOf(TFrmNew)); // --> gibt den Speicher der für die Adresse reserviert wurde frei
      FormListe.Delete(idx);
      Break;
    end;
  end;
end;


end.