I :byte;

ptr6 :TForm2;

begin

for i:=0 to Aknad.Count-1 do

{Aknad.Count – количество элементов, в нашем случае окон, в списке}

begin

ptr6:=Aknad.Items[i]; {Доступ к окнам по их порядковым номерам }

ptr6.Top:=17+i*25;

ptr6.Left:=310+i*8;

ptr6.Caption:='Форма № '+IntToStr(i);

{Изменение координат и заглавия }

end;

kolwin:=Aknad.Count; {Изменение числа окон }

end;

Управление окнами – Закрыть все

procedure TForm1.N6Click(Sender: TObject);

Var I :byte; ptr6 :tForm2;

begin

for i:=Aknad.Count-1 downto 0 do

begin

ptr6:=Aknad.Items[i];

ptr6.Close;

end;

kolwin:=0;

end;

Управление окнами – Минимизировать все

procedure TForm1.N7Click(Sender: TObject);

Var

I :byte;

ptr6 :TForm2;

begin

for i:=0 to Aknad.Count-1 do

begin

ptr6:=Aknad.Items[i];

ptr6.WindowState:=wsMinimized;

end; end;

Выход

procedure TForm1.N3Click(Sender: TObject);

begin

Close;

end;

Delphi позволяет задавать условие закрытия окна (любого): окно может быть закрыто лишь при условии, что переменная CanClose :boolean имеет значение true. По умолчанию так оно и есть. Перед закрытием окна формируется событие CloseQuery и можно по традиционным правилам писать выполняемую при этом событии процедуру; реализация которой приведена ниже:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if kolwin<>0 then

begin

ShowMessage('Закройте все окна и потом выходите из программы');

canClose:=false;

end

else

canClose:=true;

end;

Требуется и реакция на событие закрытия динамически созданного окна:

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Aknad.Delete(Aknad.IndexОf(self));

{Исключим закрываемое окно из списка окон}

end;

Контрольные вопросы

1. Какие разновидности приложений с многими окнами вы знаете?

2. Опишите принятую структуру меню главного окна приложения.

3. Для чего используется менеджер проекта?

4. Какие действия необходимо произвести для создания стандартного диалогового окна?

5. Как организовать из главного окна управление подчиненными окнами?

6. Чем управляет свойство GroupIndex?

7. Укажите различие в структурах построения MDI и SDI–приложений.

8. Какие окна называют модальными?

9. Какие функции реализует свойство Options – goEditing компонента StringGrid?

Примеры составления программ

1. Демонстрация компонента THeaderControl

unit HContMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

HeaderControl1: THeaderControl;

Edit1: TEdit;

Memo1: TMemo;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure HeaderControl1Resize(Sender: TObject);

procedure HeaderControl1SectionResize(HeaderControl: THeaderControl;

Section: THeaderSection);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

const

Delta = 10;// Зазор между границами заголовка и компонентами

procedure TForm1.FormCreate(Sender: TObject);

var

HSection: THeaderSection;

k: Integer;

begin

// Создаем три секции заголовка:

with HeaderControl1 do for k := 0 to 2 do

begin

HSection := Sections.Add;

HSection.Text := 'Секция №' + IntToStr(k);

HSection.Width := Form1.Width div 3;

HSection.MinWidth := 3 * Delta;

end;

end;

procedure TForm1.HeaderControl1Resize(Sender: TObject);

// Устанавливает положение и размеры компонентов

begin

with HeaderControl1 do

begin

Edit1.Left := Delta;

Edit1.Top := HeaderControl1.Height + 1;

Edit1.Width := Sections.Items[0].Width - 2 * Delta;

Memo1.Left := Sections.Items[1].Left + Delta;

Memo1.Top := HeaderControl1.Height + 1;

Memo1.Width := Sections.Items[1].Width - 2 * Delta;

Button1.Left := Sections.Items[2].Left + Delta;

Button1.Top := HeaderControl1.Height + 1;

Button1.Width := Sections.Items[2].Width - 2 * Delta;

end

end;

procedure TForm1.HeaderControl1SectionResize(HeaderControl: THeaderControl;

Section: THeaderSection);

begin

HeaderControl1Resize(Self)

end;

end.

2. Иллюстрация вызова CreateProcess (Создание дочернего процесса)

unit UnitParent;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

// Пример запуска дочернего процесса

var

StartUpInfo: TStartUpInfo;

ProcInfo: TProcessInformation;

const

CommandLine = 'Child.exe';

begin

{ Готовим структуру StartUpInfo. Подробности о назначении ее полей

см. в справочной службе Win32 SDK Reference}

FillChar(StartUpInfo, SizeOf(StartupInfo), 0);

with StartUpInfo do

begin

cb := SizeOf(StartUpInfo); // Указываем размер структуры

{ Флаг STARTF_USESHOWWINDOW заставляет учитывать параметр wShowWindow.

Флаг STARTF_FORCEONFEEDBACK переводит указатель мыши в режим

"обратной связи" - он ждет окончание создания дочернего процесса. }

dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;

// Окно нового процесса должно быть видимым

wShowWindow := sw_ShowNormal;

end;

// Создаем дочерний процесс. В общем случае указывать имя исполняемого

// файла в параметре CommandLine разумнее, т.к. обеспечивает правильный

// вызов 16-битрых приложений в Windows NT

if not CreateProcess(NIL, PChar(CommandLine), NIL, NIL, False,

NORMAL_PRIORITY_CLASS, NIL, NIL, StartUpInfo, ProcInfo) then

ShowMessage('Ошибка '+IntToStr(GetLastError))

end;

end.

3. Демонстрация работы двух потоков

unit ThreadMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ExtCtrls, Gauges, Spin;

type

TForm1 = class(TForm)

Panel1: TPanel;

SpinEdit1: TSpinEdit;

Gauge1: TGauge;

Button1: TButton;

mmOutput: TMemo;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

if Tag=0 then

begin

SpinEdit1.Text := FloatToStr(sqr(StrToFloat(SpinEdit1.Text)));

if StrToFloat(SpinEdit1.Text) > 1e1233 then

begin

Tag := 1;

Button1.Caption := 'Корень'

end

end else begin

SpinEdit1.Text := FloatToStr(sqrt(StrToFloat(SpinEdit1.Text)));

if StrToFloat(SpinEdit1.Text) < 2 then

begin

SpinEdit1.Value := 2;

Tag := 0;

Button1.Caption := 'Квадрат'

end

end

end;

end.

unit ThreadU;

interface

uses

Classes;

type

ThreadDemo = class(TThread)

private

{ Private declarations }

protected

S: String;

N: Integer;

procedure UpdateMemo;

procedure UpdateGauge;

procedure Execute; override;

end;

var

TDemo: ThreadDemo;

implementation

uses Unit1, SysUtils;

{ Important: Methods and properties of objects in VCL can only be used in a

method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure ThreadDemo.UpdateCaption;

begin

Form1.Caption := 'Updated in a thread';

end; }

{ ThreadDemo }

procedure ThreadDemo.Execute;

var

j,k: Integer;

begin

repeat

S := '';

// Synchronize(UpdateMemo); // Обращение к Synchronize необязательно

UpdateMemo; // Можно просто вызвать метод

for k := 0 to 99 do

begin

N := k;

S := '';

for j := 1 to 20 do

S := S+FormatFloat('00',k);

Synchronize(UpdateMemo);

// UpdateMemo;

Synchronize(UpdateGauge);

// UpdateGauge

end;

until False

end;

procedure ThreadDemo.UpdateGauge;

begin

with Form1.mmOutput.Lines do

if (S='') or (Count>1000) then

Clear

else

Add(S)

end;

procedure ThreadDemo.UpdateMemo;

begin

Form1.Gauge1.Progress := N

end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ExtCtrls, Gauges, Spin;

type

TForm1 = class(TForm)

Panel1: TPanel;

SpinEdit1: TSpinEdit;

Gauge1: TGauge;

Button1: TButton;

mmOutput: TMemo;

procedure Button1Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses ThreadU;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

if Tag=0 then

begin

SpinEdit1.Text := FloatToStr(sqr(StrToFloat(SpinEdit1.Text)));

if StrToFloat(SpinEdit1.Text) > 1e1233 then

begin

Tag := 1;

Button1.Caption := 'Корень'

end

end else begin

SpinEdit1.Text := FloatToStr(sqrt(StrToFloat(SpinEdit1.Text)));

if StrToFloat(SpinEdit1.Text) < 2 then

begin

SpinEdit1.Value := 2;

Tag := 0;

Button1.Caption := 'Квадрат'

end

end

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

TDemo := ThreadDemo.Create(False)

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

TDemo.Suspend;

CanClose := True

end;

end.

4. Использование открытых массивов

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbCancel: TBitBtn;

edInput: TEdit;

mmOutput: TMemo;

lbOutput: TLabel;

procedure bbRunClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.dfm}

procedure TfmExample.bbRunClick(Sender: TObject);

{Иллюстрация использования открытых массивов: программа выводит в многострочный редактор mmOutput содержимое двух одномерных массивов разной длины с помощью одной процедуры ArrayPrint}

Procedure ArrayPrint(aArray: array of Integer);

var

k: Integer;

S: String;

begin

S := '';

for k := 0 to High(aArray) do

S := S + IntToStr(aArray[k]) + ' ';

mmOutput.Lines.Add(S);

end;

const

A: array [-1..2] of Integer = (0,1,2,3);

B: array [5..7] of Integer = (4,5,6);

begin

ArrayPrint(A);

ArrayPrint(B);

end;

end.

5. Иллюстрация вызова формы из DLL

unit TestMainU;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TTestMain = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Label1: TLabel;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure WMUser(var Msg: TMessage); message WM_USER;

end;

var

TestMain: TTestMain;

implementation

{$R *.DFM}

function ShowModalForm: Integer; External 'DLLWithForm.dll';

procedure ShowForm(Appl, Form: THandle); External 'DLLWithForm.dll';

procedure FreeForm; External 'DLLWithForm.dll';

procedure TTestMain.Button1Click(Sender: TObject);

// Модальный вызов

begin

Button2.Enabled := False;

label1.Caption := 'ModalResult = '+IntToStr(ShowModalForm);

label1.Show; // Показываем резудьтат вызова

Button2.Enabled := True

end;

procedure TTestMain.Button2Click(Sender: TObject);

// Немодальный вызов

begin

Button1.Enabled := False;

Button2.Enabled := False;

Button3.Enabled := True;

label1.Hide;

ShowForm(Application.Handle, Self.Handle);

end;

procedure TTestMain.Button3Click(Sender: TObject);

// Закрыть форму

begin

FreeForm;

Button1.Enabled := True;

Button2.Enabled := True;

Button3.Enabled := False;

end;

procedure TTestMain.WMUser(var Msg: TMessage);

begin

Button3.Click

end;

end.

unit DLLFormU;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons;

type

TDLLForm = class(TForm)

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

CallForm: THandle; //Дескриптор вызывающей формы

public

{ Public declarations }

end;

// Объявление экспортируемых подпрограмм

function ShowModalForm: Integer;

procedure ShowForm(Appl, Form: THandle);

procedure FreeForm;

var

DLLForm: TDLLForm;

implementation

{$R *.DFM}

function ShowModalForm: Integer;

// Модальный вызов

begin

DllForm := TDllForm.Create(Application);

Result := DLLForm.ShowModal;

DLLForm.Free;

end;

procedure ShowForm(Appl, Form: THandle);

// Немодальный вызов

begin

Application.Handle := Appl; // Замена объекта Application

DllForm := TDllForm.Create(Application);

DllForm.CallForm := Form;

DLLForm.Show

end;

procedure FreeForm;

// Уничтожение формы

begin

DLLForm.Free

end;

procedure TDLLForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if CallForm<>0 then

SendMessage(CallForm, wm_User, 0, 0)

end;

end.

Задания для самостоятельного выполнения

1. Реализовать программу, которая для массива из N действительных чисел, вводимых с клавиатуры в компонент Edit1, определяет, является ли введенная последовательность арифметической или геометрической прогрессией, и в случае, если последовательность является прогрессией, то выводит ее показатель на экран в компонент Label1.

2. В массиве целых чисел найти число, сумма цифр которого была бы наибольшей. Если таких чисел несколько, вывести на экран все эти числа в компонент Label1.

3. Написать программу, которая проверяет, находится ли в массиве введенное с клавиатуры число в компонент Edit1. Массив должен вводится во время работы программы в компонент StringGrid1.

4. Написать программу, которая проверяет, представляют ли элементы введенного с клавиатуры в компонент StringGrid1 массива неубывающую последовательность.

5. Написать программу, которая проверяет, сколько раз введенное с клавиатуры в компонент Edit1 число встречается в массиве.