Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Несколько окон одного класса

Автор: Чучмек 24.10.2012, 02:04

Если требуется создать более одного экземпляра окна - почему бы и нет?
TFormN.Create - и все ок.

Но если программа уже готова(почти), и вдруг возникает необходимость в использования более чем одного экземпляра главного окна.
Могут возникнуть проблемы. http://forum.vingrad.ru/forum/topic-357029/kw-paramstr-newwindow-ppdisp.html

Часть проблем примитивные и легко решаемые(если представлять что и зачем), а некоторые - требуют отдельного решения.
Поэтому пришлось создавать эту длинную и возможно, никому не нужную тему.

Пример.
Есть почти готовая рисовалка.
Главное окно: Unit1.TForm1
(Form1.AutoSize=true)
Image1 - поле для рисования (AutoSize=true)
MainMenu1 - меню
  N1 - "Файл"
   N2 - "Info" - вызов окна с информацией о программе
   N3 - Выбор цвета "пера" - (открывается отдельное окно)
   N4 - вызов окна изменения размера
   N5 - сохранить художество
   N6 - открывает окно настроек
Unit1.pas

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  n:integer=3;
implementation
 uses unit2,unit3,unit4,unit5;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Bitmap.Width:=160;
Image1.Picture.Bitmap.Height:=160;

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
 vx,vy,i:integer;
begin
if GetAsyncKeyState(VK_LBUTTON)<>0 then
 for i:=0 to trunc(sqr(0.5*n)-1) do
  begin
  vx:=x+random(n)-n div 2;
  vy:=y+random(n)-2 div 2;
  if (vx>=0) and (vx<Image1.Picture.Bitmap.Width) and
     (vy>=0) and (vy<Image1.Picture.Bitmap.Height) then
  Image1.Picture.Bitmap.Canvas.Pixels[vx,vy]:=Form2.ColorBox1.Selected;
  end;


end;

procedure TForm1.N3Click(Sender: TObject);
begin
form2.Visible:=true;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
form3.ShowModal;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
form4.Visible:=true;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
if SaveDialog1.Execute then  Image1.Picture.Bitmap.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.N6Click(Sender: TObject);
begin
Form5.Visible:=true;
end;

end.

Окно выбора цвета Unit2.TForm2 содержит один ColorBox. Вынес в отдельное окно для примера.
unit2.pas

Код


unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    ColorBox1: TColorBox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

end.

Окно изменения размера Unit3.TForm3
Edit1 - ширина
Edit2 - высота
Button1 - "Ok"
unit3.pas

Код


unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm3 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation
uses unit1;

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
var w,h:integer;
begin
if TryStrToInt(Edit1.Text,w) and TryStrToInt(Edit2.Text,h) and
   (w>0) and (w<=1024) and (h>0) and (h<=1024) then
 begin
 form1.Image1.Picture.Bitmap.Width:=w;
 form1.Image1.Picture.Bitmap.Height:=h;
 end else MessageBox(0,'Указан не допустимый размер',nil,0);
end;

procedure TForm3.FormActivate(Sender: TObject);
begin
Edit1.Text:=inttostr(Form1.Image1.Picture.Bitmap.Width);
Edit2.Text:=inttostr(Form1.Image1.Picture.Bitmap.Height);

end;

end.

Окно с информацией о программе Unit4.Form4
Содержит одну лейбу с текстом.

Окно настроек (Unit5.Form5) - Два чекбокса
CheckBox1- изменение размеров рисунка при растягивании окна мышью
CheckBox2- жирное перо

Unit5.pas

Код


unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,UxTheme;

type
  TForm5 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure CheckBox1Click(Sender: TObject);

    procedure FormResize(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation
 uses unit1, Math;
{$R *.dfm}

procedure TForm5.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
 begin
 Form1.AutoSize:=false;
 Form1.Image1.AutoSize:=false;
 Form1.Image1.Align:=alClient;
 Form1.OnResize:=FormResize;
 Form1.Constraints.MaxWidth:=1024;
 Form1.Constraints.MaxHeight:=1024;
 Form1.N4.Enabled:=false;
 end else
 begin
 Form1.N4.Enabled:=true;
 Form1.AutoSize:=true;
 Form1.Image1.AutoSize:=true;
 Form1.Image1.Align:=alNone;
 Form1.OnResize:=nil;
 end;
end;

procedure TForm5.FormResize(Sender: TObject);
begin
Form1.Image1.Picture.Bitmap.Width:=Form1.Image1.Width;
Form1.Image1.Picture.Bitmap.Height:=Form1.Image1.Height;
end;

procedure TForm5.CheckBox2Click(Sender: TObject);
begin
 if CheckBox2.Checked then n:=6 else n:=3;
end;

end.

Project1.dpr

Код


program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2},
  Unit3 in 'Unit3.pas' {Form3},
  Unit4 in 'Unit4.pas' {Form4},
  Unit5 in 'Unit5.pas' {Form5};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm2, Form2);
  Application.CreateForm(TForm3, Form3);
  Application.CreateForm(TForm4, Form4);
  Application.CreateForm(TForm5, Form5); 
  Application.Run;
end.

... И захотелось нам... Чтобы... Сразу несколько рисовальных окон было. Стерео картинку рисовать будем.
Преобразование разобью на несколько этапов.
Описание чуть позже.

Автор: Rennigth 24.10.2012, 08:44

Чучмек, если я правильно понял проблему(т.е. настройки и т.д. должны применяться ко всем экземплярам окна?), то мне кажется и менюшку и все эвенты в динамике присваивать при создании окна. Другого варианта не вижу... Хотя можно использовать что-то глобальное, реестр или файл на жестком.

Автор: Чучмек 24.10.2012, 11:31

Цитата(Rennigth @ 24.10.2012, 08:44

)

т.е. настройки и т.д. должны применяться ко всем экземплярам окна

И это тоже, для себя я здесь большой проблемы не вижу. - Загружать настройки при старте программы, сохранять или при изменении или по завершении,хранить список всех открытых экземпляров окна. На этом нужно будет отдельно остановится. Чуть позже.

Автор: Чучмек 25.10.2012, 10:39

Нужно еще одно окно - пожалуйста TForm1.Create(Application).Visible:=true;
Почти полноценное окно и рисовать в нем можно, и сохранить нарисованное.
Только не совсем то - размеры изменяются только у первого, цвет "пера" - меняется сразу в двух окнах.
При закрытии первого окна завершается приложение.
  Завершение приложения происходит потому что первое окно является Application.MainForm
А при закрытии MainForm происходит завершение приложения.
Отсюда - нужно либо в OnClose делать проверку   if Self = application.MainForm, и скрывать MainForm вместо закрытия.
Либо заменить MainForm.
Мне подуше второй вариант.
File->New->Form; Form.Name=StartForm; Save->StartFormUnit.pas
В project.dpr строку Application.CreateForm(TStartForm, StartForm) делаем первой из Application.CreateForm
Строку Application.CreateForm(TForm1, Form1)  - убираем
В StartForm можно показать заставку при запуске приложения. Но нам это не надо. StartForm  показывать не будем.
в dpr прописываем Application.ShowMainForm:=false;
Создавать первый экземпляр TForm1 можно в StartForm.OnCreate
При создании окна, возможно, необходимо передать ему начальные параметры. Для этого можно написать отдельную функцию NewForm.
А можно переопределить конструктор TForm1

Код


type
  TForm1 = class(TForm)
    ...
    ...
    ...    
  private
    { Private declarations }
  public
    { Public declarations }
    constructor Create();
  end;

Код


constructor TForm1.Create(name: string);
begin
inherited Create(application);
Visible:=true;
end;

[b]StartFormUnit.pas[b]

Код


unit StartFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TStartForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  StartForm: TStartForm;

implementation
 uses unit1;
{$R *.dfm}

procedure TStartForm.FormCreate(Sender: TObject);
begin
  TForm1.Create();
end;


end.

В MainMenu1 добавляем пункт N7 - "новое окно"

Код


procedure TForm1.N7Click(Sender: TObject);
begin
TForm1.Create;
end;

При закрытии окна TForm1 необходимо делать проверку - если закрывается последнее окно TForm1 - завершить приложение.
Можно держать количество открытых TForm1 в отдельной переменной.
Можно создать список открытых TForm1. А можно использовать список Application.Components

Код


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
 i:integer;
 isclose:boolean;
begin
Application.RemoveComponent(self);
isclose:=true;
for i:=0 to Application.ComponentCount-1 do
 if (Application.Components[i] is TForm1)then
  begin
  isclose:=false;
  break;
  end;
Free;
if isclose then Application.Terminate;
end;

Одну проблему устранили...

Автор: Чучмек 25.10.2012, 11:13

Теперь вторая проблема - на все окна TForm1 в панели задач одна кнопка "Project1"
Это происходит потому, что при создании нового окна (используется CreateWindowEx) в параметре hWndParent передается Application.Handle.
И все окна приложения являются дочерними окнами Application. (Кто не знал - Application тоже окно, причем главное окно приложения).
Дочерние окна своей кнопки в панели задач не имеют, а кнопка "Project1" - кнопка от Application.
Отсюда решение - скрыть Application а в качестве hWndParent, при создании окна TForm1, передавать 0 или GetDesktopWindow()
Переопределяем CreateParams

Код


type
  TForm1 = class(TForm)
  ...
  ...
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  ...
  ...
  end;

Код


procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
Params.WndParent:=0;
end;

И в dpr добавляем строчку
ShowWindow(Application.Handle,SW_HIDE)

Код


program Project1;

uses
  Forms,windows,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2},
  Unit3 in 'Unit3.pas' {Form3},
  Unit4 in 'Unit4.pas' {Form4},
  Unit5 in 'Unit5.pas' {Form5},
  StartFormUnit in 'StartFormUnit.pas' {StartForm};

{$R *.res}

begin
  Application.Initialize;
  Application.ShowMainForm:=false;
  Application.CreateForm(TStartForm, StartForm);
  ShowWindow(Application.Handle,SW_HIDE);
  Application.CreateForm(TForm2, Form2);
  Application.CreateForm(TForm3, Form3);
  Application.CreateForm(TForm4, Form4);
  Application.CreateForm(TForm5, Form5);
  Application.Run;
end.

Автор: Чучмек 26.10.2012, 15:36

Идем дальше. "Причесывание" кода. Все глобальные переменные, которые используются для сохранения промежуточных состояний и связи межу методами/событиями TForm1 вносим внутрь класса TForm1. В методах TForm1 везде где встречается Form1 - меняем на self или вообще убираем. Стоку var Form1: TForm1; - удаляем. (Переменную Form1, для удобства, можно перенести внутрь TForm1)

Код


  TForm1 = class(TForm)
 ...
 ...
  public
    { Public declarations }
    form1:tform1;
    n:integer;
 ...
  end;

Код


constructor TForm1.Create;
begin
...
...
form1:=self;
n:=3;
...
end;

Если Form1 встречается в функциях/процедурах - делаем их либо методами TForm1, либо добавляем в функции дополнительный параметр.
Было

Код


procedure myfunc(s:text);
begin
form1.memo1.lines.add(s);
end;

стало

Код


procedure TForm1.myfunc(s:text);
begin
memo1.lines.add(s);
end;

или

Код


procedure myfunc(s:text;form1:tform1);
begin
form1.memo1.lines.add(s);
end;

Определяемся с дополнительными окнами. Какие из дополнительных окон будут существовать в единственном экземпляре,а какие - в нескольких(по одному на каждый экземпляр TForm1)
Так в моем примере окно с информацией о программе Form4 и окно настроек Form5 будут в единственном экземпляре.
А окно выбора цвета TForm2 и окно изменения размера TForm3 - для каждого экземпляра TForm1.

Для "многоэкземплярных" окон(форм) - аналогично "причесываем" код.
Из юнита формы удаляем переменную var FormN:TFormN.
Из dpr удаляем строку создания формы Application.CreateForm(TFormN, FormN);
В TForm1 добавляем переменную на каждую "многоэкземплярную" форму.
При создании экземпляра TForm1 создаем и связанные "многоэкземплярные" формы.

Код


type
  TForm1 = class(TForm)
    ...
    ...
  public
    { Public declarations }
    ...
    form2:TForm;
    form3:TForm;
    ...
    ...
  end;

Код


constructor TForm1.Create;
begin
...
...
form2:=TForm2.Create(self);
form3:=TForm3.Create(self);
end;

Если в методах "многоэкземплярных" форм было обращение к Form1 или к глобальной переменной из Unit1(мы ее уже перенесли в TForm1) то  возможны варианты:
  a) Добавить в TFormN переменную Form1:TForm; инициализировать ее в переопределенном конструкторе, или при создании из TForm1, или при первом вызове ( if not Assigned(form1) then form1:=self.Owner as tform);использовать  как (form1 as TForm1).
  б) сразу использовать (Owner as TForm1)

Если из одной вспомогательной "многоэкземплярной" формы было обращение к другой - заменить на обращение через TForm1 -  (Owner as TForm1).Form3

Для "одноэкземплярных", если использовалось обращение к TForm1, необходимо разделить обращения на общие(ко всем экземплярам главного/рабочего окна) и частные(к одному).
Так в окне настроек было два пункта -"Изменение размера мышью" и "Жирное перо"
Пусть "Изменение размера мышью" - настройка для всех окон, а  "Жирное перо" - только для окна вызвавшего окно настроек.
Было

Код


//включение/отключение опции "Изменение размера мышью"
procedure TForm5.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
 begin
 Form1.AutoSize:=false;
 Form1.Image1.AutoSize:=false;
 Form1.Image1.Align:=alClient;
 Form1.OnResize:=FormResize;
 Form1.Constraints.MaxWidth:=1024;
 Form1.Constraints.MaxHeight:=1024;
 Form1.N4.Enabled:=false;
 end else
 begin
 Form1.N4.Enabled:=true;
 Form1.AutoSize:=true;
 Form1.Image1.AutoSize:=true;
 Form1.Image1.Align:=alNone;
 Form1.OnResize:=nil;
 end;
end;
procedure TForm5.FormResize(Sender: TObject);
begin
Form1.Image1.Picture.Bitmap.Width:=Form1.Image1.Width;
Form1.Image1.Picture.Bitmap.Height:=Form1.Image1.Height;
end;

Стало

Код


procedure TForm5.CheckBox1Click(Sender: TObject);
var
 i:integer;
 Form1:TForm1;
begin
for i:=0 to Application.ComponentCount-1 do
 if Application.Components[i] is TForm1 then
   begin
   Form1:=Application.Components[i] as TForm1;
   if CheckBox1.Checked then
    begin
    Form1.AutoSize:=false;
    Form1.Image1.AutoSize:=false;
    Form1.Image1.Align:=alClient;
    Form1.OnResize:=FormResize;
    Form1.Constraints.MaxWidth:=1024;
    Form1.Constraints.MaxHeight:=1024;
    Form1.N4.Enabled:=false;
    end else
    begin
    Form1.N4.Enabled:=true;
    Form1.AutoSize:=true;
    Form1.Image1.AutoSize:=true;
    Form1.Image1.Align:=alNone;
    Form1.OnResize:=nil;
    end;
  end;
end;

procedure TForm5.FormResize(Sender: TObject);
begin
TForm1(Sender).Image1.Picture.Bitmap.Width:=TForm1(Sender).Image1.Width;
TForm1(Sender).Image1.Picture.Bitmap.Height:=TForm1(Sender).Image1.Height;
end;

Для опции "Жирное перо"
Добавим в TForm5 переменную Form1

Код


type
  TForm5 = class(TForm)
  ...
  ...
  public
    { Public declarations }
    Form1:TForm;
  end;

Код


procedure TForm5.CheckBox2Click(Sender: TObject);
begin
 if CheckBox2.Checked then (form1 as TForm1).n:=6 else (form1 as TForm1).n:=3;
end;

Вызов окна настроек

Код


procedure TForm1.N6Click(Sender: TObject);
begin
Form5.Visible:=true;
Form5.Form1:=self;
Form5.CheckBox2.Checked:=n>3;
end;

При закрытии экземпляра TForm1 открытые связанные "многоэкземплярные" окна закроются сами (передаем Self в TFormN.Create), а вот "одноэкземплярные" остаются открытыми (родитель - Application) .
Иногда это не нужно.
Если мы, в окне настроек, чекним "Жирное перо", после закрытия окна вызвавшего настройки, - получим "Invalid class typecast".
Окно настроек нужно закрыть

Код


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
...
begin
if (Form5.Form1=Self) and Form5.Visible then Form5.Visible:=false;
...
...
end;

Автор: Чучмек 27.10.2012, 16:27

Теперь собственно самое интересное.
Потребность в псевдомодальном режиме.
Если мы из экземпляра TForm1 вызовем окно в модальном режиме (MessageBox/ShowMessage/TCommonDialog.Execute/FormN.ShowModal мы получим блокировку всех остальных окон до закрытия модального окна. Это не есть гуд. Остальные экземпляры TForm1 и связанные с ними окна должны оставаться свободными.
Если бы каждый экземпляр TForm1 имел свой цикл обработки сообщений и свой поток - нет проблем. Однако,в Delphi, по крайней мере в 7-ой, такого нет.