Найти количество дескрипторов форм, используемых вашим приложением

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

function EnumProc(wnd: HWND; var count: DWORD): Bool; stdcall;

begin

Inc(count);

result := True;

EnumChildWindows(wnd, @EnumProc, integer(@count));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

count: DWORD;

begin

count := 0;

EnumThreadWindows(GetCurrentThreadID, @EnumProc, Integer(@count));

Caption := Format(‘%d window handles in use’, [count]);

end;

{/codecitation}

Можно ли создать форму, которая получает дополнительные параметры в методе Сreate

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Просто замените конструктор Create класса Вашей формы.

unit Unit2;

interface

uses

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

type

TForm2 = class(TForm)

private

{Private declarations}

public

{Public declarations}

constructor CreateWithCaption(aOwner: TComponent; aCaption: string);

end;

var

Form2: TForm2;

implementation

{$R *.DFM}

constructor TForm2.CreateWithCaption(aOwner: TComponent; aCaption: string);

begin

Create(aOwner);

Caption := aCaption;

end;

uses

Unit2;

procedure TForm1.Button1Click(Sender: TObject);

begin

Unit2.Form2 :=Unit2.TForm2.CreateWithCaption(Application, ‘My Caption’);

Unit2.Form2.Show;

end;

{/codecitation}

Можно ли рисовать на рамке формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией толщиной в 1 пиксель.

В частных объявлениях объявляем процедуру обработки сообщение WMNCPaint:

private

{ Private declarations }

procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;

В области реализации [после слова implemantation] пишем:

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);

var

dc: hDc;

Pen: hPen;

OldPen: hPen;

OldBrush: hBrush;

begin

inherited;

dc := GetWindowDC(Handle);

msg.Result := 1;

Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));

OldPen := SelectObject(dc, Pen);

OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));

Rectangle(dc, 0,0, Form1.Width, Form1.Height);

SelectObject(dc, OldBrush);

SelectObject(dc, OldPen);

DeleteObject(Pen);

ReleaseDC(Handle, Canvas.Handle);

end;

{/codecitation}

Менять главную форму во время выполнения

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

procedure SetAsMainForm(aForm:TForm);

var

P:Pointer;

begin

P := @Application.Mainform;

Pointer(P^) := aForm;

end;

{************************************}

// Example of Usage:

{

Question:

If my application is main.exe and the main form is form1, form1 displays

when it runs. I would like to display other forms based on the parameter

passed.

main.exe param1 will display form2 as the first form

main.exe param2 with display form3 as the first form

Answer:

}

program Project1;

uses

Forms,

Unit1 in ‘Unit1.pas’ {Form1},

Unit2 in ‘Unit2.pas’ {Form2},

Unit3 in ‘Unit3.pas’ {Form3};

{$R *.res}

procedure SetAsMainForm(aForm:TForm);

var

P:Pointer;

begin

P := @Application.Mainform;

Pointer(P^) := aForm;

end;

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TForm2, Form2);

Application.CreateForm(TForm3, Form3);

if Paramstr(1) = ‘Param1’ then

SetAsMainForm(Form2);

if Paramstr(1) = ‘Param2’ then

SetAsMainForm(Form3);

Application.Run;

end.

{/codecitation}

Косвенный вызов формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Передаем имя класса формы переменной с именем FormClassName:

MyForm := TFormClass(FindClass(FormClassName)).Create(Application);

В случае, когда имя класса не найдено, возникает исключительная ситуация. Возможно, перед данным вызовом необходимо вызвать RegisterClasses, делающий класс формы членом набора параметров.

{/codecitation}

Клонирование формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

procedure TForm1.Button1Click(Sender: TObject);

var

ms: TMemoryStream;

newform: TForm1;

begin

ms := TMemoryStream.Create;

try

ms.WriteComponent(Form1);

newform := TForm1.CreateNew(Application);

ms.Position := 0;

ms.ReadComponent(newform);

{ show the new form. Note that it will appear exactly on top of the

original! You may want to change its Left and Top property to move it

a bit.

Zeigt die neue Form. Die neue Form erscheint genau oberhalb der

original form. Die Left, Top Properties mussen evtl. noch angepasst werden

}

newform.Show;

finally

ms.Free

end;

end;

{/codecitation}

Как сохранить всю форму в файл (как Delphi в .dfm)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

constructor TForm1.Create(AOwner: TComponent); // override;

var

fname: string;

begin

{ Для динамически создаваемых контролов, может требоваться

RegisterClasses(..); }

fname := FormFilename;

if FileExists( fname ) then

begin

CreateNew(AOwner);

ReadComponentResFile(fname, Self);

end

else

inherited Create( AOwner );

end;

procedure TForm1.FormCloseQuery( Sender: TObject;

var CanClose: Boolean);

begin

WriteComponentResFile(FormFileName, Self);

end;

{/codecitation}

Как создать новую форму, которая бы не отбирала фокус у существующей

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Олег Кулабухов

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form2 := TForm2.Create(Application);

Form2.Visible := FALSE;

ShowWindow(Form2.Handle, SW_SHOWNA);

end;

{/codecitation}