Solved

Strange behavior when a form is closed

Posted on 2016-09-03
6
56 Views
Last Modified: 2016-09-05
The program have two forms, MainForm and Subform. The Mainform Button1 creates new subforms. If a few subforms is created, when they are closed (and freed) the window behind get focus, BUT not if its the mainform . Why?

unit Unit1;

interface

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

type
  TMainForm = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    List: TComponentList;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.Button1Click(Sender: TObject);
  Var
   T : Tform;

begin
     List.OwnsObjects:=True;
     T:=TForm2.Create(Nil);
     List.Add(T);
     T.Show;
end;

procedure TMainForm.Button2Click(Sender: TObject);
  var
    Antal : Integer;

begin
    Antal:=List.Count;
    Memo1.Lines.Add('Forms Count '+IntToStr(Antal));
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
     ReportMemoryLeaksOnShutdown:=True;
     List:= TComponentList.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
    List.Free;
end;

end.

object MainForm: TMainForm
  Left = 0
  Top = 0
  Caption = 'MainForm'
  ClientHeight = 303
  ClientWidth = 641
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 32
    Top = 16
    Width = 105
    Height = 25
    Caption = 'New Window'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 192
    Top = 16
    Width = 433
    Height = 273
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object Button2: TButton
    Left = 32
    Top = 55
    Width = 105
    Height = 25
    Caption = 'Info'
    TabOrder = 2
    OnClick = Button2Click
  end
end

unit Unit2;

interface

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

type
  TSubForm = class(TForm)
    Label1: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SubForm: TSubForm;

implementation

{$R *.dfm}

procedure TSubForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    Hide;
    Action := caFree;

end;

end.


object SubForm: TSubForm
  Left = 0
  Top = 0
  Caption = 'SubForm'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 120
    Top = 48
    Width = 60
    Height = 13
    Caption = 'Second form'
  end
end

Open in new window

0
Comment
Question by:Sunsales
  • 4
  • 2
6 Comments
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 41783589
because of the nil in this line :
T:=TForm2.Create(Nil);

Open in new window


it should read
T:=TForm2.Create(Self);

Open in new window


there is no point in maintaining your own Componentlist
the Screen has this property

after you have created TForm2, you can find it like this in the screen object
this routine frees all TForm2 type forms

procedure TMainForm.CloseAllForm2(Sender: TObject);
var I: Integer;
  frm: TForm2;
begin
  for I := Screen.FormCount-1 downto 0 do 
    if Screen.Forms[I] is TForm2 then 
    begin
      frm := Screen.Forms[I] as TForm2;
      frm.Free;
    end;
end;

Open in new window

1
 

Author Comment

by:Sunsales
ID: 41783697
There is need for Component list because there will be more than one class of sub-forms and the user need to be able to navigate between them. I want them to be kept separate. By a different popuplists in mainform the user will navigate.

Questoin, if I use Mainform as owner (or componentlist) wont the subforms all be destroyed when the owner is destroyed?
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 41783704
you want a stay-on-top form which displays all the forms available in your app ?
you don't need an extra component to display that

if an owner is destroyed, then it first destroys all it's child components
that's just good housekeeping
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 37

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 41783726
here is a sample of such a form listing all forms available in the app
add the unit to your project and add the form to the autocreate list of the forms

you might notice, it doesn't use other units
and it doesn't contain code for managing it's own list



unit uFrmList;

interface

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

type
  TfrmList = class(TForm)
    lvForms: TListView;
    tmrList: TTimer;
    pmListview: TPopupMenu;
    mnuLvShow: TMenuItem;
    mnuLvFree: TMenuItem;
    procedure tmrListTimer(Sender: TObject);
    procedure mnuLvShowClick(Sender: TObject);
  private
    procedure ListForms;
  end;

var
  frmList: TfrmList;

implementation

{$R *.dfm}

procedure TfrmList.mnuLvShowClick(Sender: TObject);
var li: TListItem;
  frm, frx: TForm;
  I: Integer;
begin
  li := lvForms.Selected;
  if li <> nil then
  begin
    frm := nil;
    for I := 0 to Screen.FormCount-1 do
    begin
      frx := Screen.Forms[I];
      if (frx.Name = li.Caption) and (frx.Caption = li.SubItems[1]) then
      begin
        frm := frx;
        Break;
      end;
    end;
    if frm <> nil then
    begin
      if Sender = mnuLvShow then
      begin
        frm.Show;
        frm.BringToFront;
      end else // Sender = mnuLvFree
      begin
        if frm = Application.MainForm then
          Application.Terminate
        else
          frm.Free;
      end;
    end;
    ListForms;
  end;
end;

procedure TfrmList.tmrListTimer(Sender: TObject);
begin
  ListForms;
end;

procedure TfrmList.ListForms;
const
  states: Array[TWindowState] of string = ('Normal', 'Minimized', 'Maximized');
  Visibles: Array[Boolean] of string = ('Hidden', 'Visible');
var li: TListItem;
  I: Integer;
begin
  lvForms.Items.BeginUpdate;
  try
    lvForms.Items.Clear;
    for I := 0 to Screen.FormCount -1 do
    begin
      li := lvForms.Items.Add;
      li.Caption := Screen.Forms[I].Name;
      li.SubItems.Add(Screen.Forms[I].ClassName);
      li.SubItems.Add(Screen.Forms[I].Caption);
      li.SubItems.Add(States[Screen.Forms[I].WindowState]);
      li.SubItems.Add(Visibles[Screen.Forms[I].Visible]);
    end;
  finally
    lvForms.Items.EndUpdate;
  end;
end;

end.

Open in new window

and the dfm:

object frmList: TfrmList
  Left = 925
  Top = 352
  Caption = 'frmList'
  ClientHeight = 488
  ClientWidth = 566
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Visible = True
  PixelsPerInch = 96
  TextHeight = 13
  object lvForms: TListView
    Left = 0
    Top = 0
    Width = 566
    Height = 488
    Align = alClient
    Columns = <
      item
        Caption = 'Name'
        Width = 80
      end
      item
        Caption = 'Class type'
        Width = 120
      end
      item
        Caption = 'Caption'
        Width = 120
      end
      item
        Caption = 'State'
        Width = 100
      end
      item
        Caption = 'Visible'
      end>
    PopupMenu = pmListview
    TabOrder = 0
    ViewStyle = vsReport
    ExplicitWidth = 404
  end
  object tmrList: TTimer
    Interval = 5000
    OnTimer = tmrListTimer
    Left = 48
    Top = 72
  end
  object pmListview: TPopupMenu
    Left = 200
    Top = 248
    object mnuLvShow: TMenuItem
      Caption = 'Show form'
      OnClick = mnuLvShowClick
    end
    object mnuLvFree: TMenuItem
      Caption = 'Free form'
      OnClick = mnuLvShowClick
    end
  end
end

Open in new window

1
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 41783730
freeing a subform depends on the usage

if you would have an invoice form, with a floating form for some detail
there is no point in leaving the floating form open upon closing the invoice form
closing the floating form should not result in closing of the invoice form
1
 

Author Comment

by:Sunsales
ID: 41784614
Thanx, i added this function to extract a list of all form of a particula type, havet tested it yet but i think it will work.

procedure TfrmList.ListFormsOfType(AObjectList: TObjectList; aClass: TClass);
  Var
    I: Integer;

begin
  if AObjectList=Nil then begin
      AObjectList:=TObjectList.Create;
      AObjectList.OwnsObjects:=False;
  end;
  AObjectList.Clear;
  for I := 0 to Screen.FormCount -1 do
  Begin
    if True then
     if Screen.Forms[I] is aClass then Begin
        AObjectList.Add(Screen.Forms[I]);
     End;
  End;
end;

Open in new window

0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, just open a new email message. In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …

816 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now