Получить информацию обо всех формах проекта

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

Оформил: DeeCo

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

function EnumResTypes(hMod: THandle; restype, resname: PChar; Lines: TStrings): BOOL; stdcall;

var

ms: TMemoryStream;

rs: TResourceStream;

S: string;

i: Integer;

begin

Result := True;

SetLength(S, 10000);

if Assigned(resname) then

begin

rs := TResourceStream.Create(hinstance, resname, restype);

try

try

ms := TMemoryStream.Create;

try

ObjectBinaryToText(rs, ms);

SetLength(S, ms.Size);

ms.Position := 0;

ms.read(S[1], ms.Size);

Lines.Add(resname);

Lines.Add(‘Length of data is ‘ IntToStr(Length(S)));

i := Pos(#13, S);

if i > 0 then

begin

SetLength(S, i — 1);

Lines.Add(S);

i := Pos(‘object’, S);

if i > 0 then

begin

Delete(S, 1, i 6);

i := Pos(‘ ‘, S);

if i > 0 then

begin

Lines.Add(‘Form name is: ‘ Copy(S, 1, i — 2));

Delete(S, 1, i);

Lines.Add(‘Form class is: ‘ S);

end;

end

end

else

begin

// Lines.Add(‘This resource seems not to hold a form’);

end;

finally

ms.Free

end;

except

// Lines.Add(‘This resource is not a form resource’);

end;

finally

rs.Free;

end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if not EnumResourceNames(0, RT_RCDATA, @EnumResTypes, Integer(Memo1.Lines)) then

Memo1.Lines.Add(‘Error, GetLastError Returns ‘ IntToHex(GetLastError, 8));

end;

{/codecitation}

Получение родительской формы компонента

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

Автор: VID

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Получение родительской формы компонента

Функция возвращает TForm который является родительской

формой передаваемого в функцию компонента.

Зависимости: classes

Автор: VID, snap@iwt.ru, ICQ:132234868, Махачкала

Copyright: VID

Дата: 27 марта 2003 г.

***************************************************** }

function GetParentForm(Component: TComponent): TForm;

var

C: TComponent;

begin

Result := nil;

if Component = nil then

exit;

C := Component;

repeat

Component := C;

try

C := Component.Owner except C := Component;

end;

until (C is TForm) or (C = Component);

if C is TForm then

Result := C as TForm;

end;

// Пример использования:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(GetParentForm(Sender as TComponent).Name);

end;

{/codecitation}

Полезные команды для редактирования формы

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

Оформил: DeeCo

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

To select the form when its surface is covered by components, simpy Shift-Click the form.

Manchmal ist eine Form voll bedeckt mit Komponenten und die Form kann nicht mehr per Klick ausgewдhlt werden.

Um sie dennoch schnell auszuwдhlen, einfach die Shift-Taste gedrьckt halten und zugleich einen Maus-Klick irgendwo auf der Form ausьben.

***

To fine move (a pixel) a selected component:

Press Ctrl whilst pressing the cursor keys.

Um eine ausgewдhlte Komponente einen Pixel zu verschieben, halte die Ctrl-Taste gedrьckt und beweg die Komponente mit den Pfeiltasten in die gewьnschte Richtung.

***

To fine resize a component:

Press Shift whilst pressing the cursor keys.

Um die Grцsse einer Komponente um einen Pixel zu дndern, halte die Shift-Taste gedrьckt und drьcke die Pfeiltasten, um die Komponente zu vergrцssern resp. zu verkleinern.

{/codecitation}

Перечислить формы и дочерние формы

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

Оформил: DeeCo

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

type

PWindows = ^TWindows;

TWindows = record

WindowHandle: HWND;

WindowText: string;

end;

type

TForm1 = class(TForm)

Button1: TButton;

TreeView1: TTreeView;

procedure Button1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

PNode, CNode: TTreeNode;

AWindows: PWindows;

implementation

{$R *.DFM}

function EnumChildWindowsProc(Wnd: HWnd; Form: TForm1): Bool; export;

{$ifdef Win32} stdcall; {$endif}

var

Buffer: array[0..99] of Char;

begin

GetWindowText(Wnd, Buffer, 100);

//if StrLen(Buffer) 0 then

if StrPas(Buffer) = » then Buffer := ‘Empty’;

new(AWindows);

with AWindows^ do

begin

WindowHandle := Wnd;

WindowText := StrPas(Buffer);

end;

CNode := Form1.TreeView1.Items.AddChildObject(PNode,

AWindows^.WindowText ‘:’

IntToHex(AWindows^.WindowHandle, 8), AWindows);

if GetWindow(Wnd, GW_CHILD) 0 then

begin

PNode := CNode;

Enumchildwindows(Wnd, @EnumChildWindowsProc, 0);

end;

Result := True;

end;

function EnumWindowsProc(Wnd: HWnd; Form: TForm1): Bool;

export; {$ifdef Win32} stdcall; {$endif}

var

Buffer: array[0..99] of Char;

begin

GetWindowText(Wnd, Buffer, 100);

//if StrLen(Buffer) 0 then

if StrPas(Buffer) = » then Buffer := ‘Empty’;

new(AWindows);

with AWindows^ do

begin

WindowHandle := Wnd;

WindowText := StrPas(Buffer);

end;

PNode := Form1.TreeView1.Items.AddObject(nil, AWindows^.WindowText ‘:’

IntToHex(AWindows^.WindowHandle, 8), AWindows);

EnumChildWindows(Wnd, @EnumChildWindowsProc, 0);

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EnumWindows(@EnumWindowsProc, Longint(Self));

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Dispose(AWindows);

end;

end.

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

{ Other Code by NicoDE

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

type

PMyEnumParam = ^TMyEnumParam;

TMyEnumParam = record

Nodes: TTreeNodes;

Current: TTreeNode;

end;

function EnumWindowsProc(Wnd: HWND; Param: PMyEnumParam): BOOL; stdcall;

const

MyMaxName = 64;

MyMaxText = 64;

var

ParamChild: TMyEnumParam;

ClassName: string;

WindowText: string;

begin

Result := True;

SetLength(ClassName, MyMaxName);

SetLength(ClassName, GetClassName(Wnd, PChar(ClassName), MyMaxName));

SetLength(WindowText, MyMaxText);

SetLength(WindowText, SendMessage(Wnd, WM_GETTEXT, MyMaxText, lParam(PChar(WindowText))));

ParamChild.Nodes := Param.Nodes;

ParamChild.Current := Param.Nodes.AddChildObject(Param.Current,

‘[‘ ClassName ‘] «‘ WindowText ‘»‘ ‘ Handle: ‘ IntToStr(Wnd), Pointer(Wnd));

EnumChildWindows(Wnd, @EnumWindowsProc, lParam(@ParamChild));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Param: TMyEnumParam;

begin

Param.Nodes := TreeView1.Items;

Param.Current := TreeView1.TopItem;

TreeView1.Items.BeginUpdate;

EnumWindows(@EnumWindowsProc, lParam(@Param));

TreeView1.Items.EndUpdate;

end;

{/codecitation}

Переопределение оконной процедуры и метода для другой формы

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

unit SubSecon;

interface

uses

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

type

TForm2 = class(TForm)

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

Caption := Format (‘Cursor in %d, %d’, [X, Y]);

end;

end.

unit SubMain;

interface

uses

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

StdCtrls;

type

TForm1 = class(TForm)

BtnShow: TButton;

BtnProc: TButton;

BtnMeth: TButton;

procedure BtnShowClick(Sender: TObject);

procedure BtnMethClick(Sender: TObject);

procedure BtnProcClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

OldWndMeth, NewWndMeth: Pointer;

SubControl: TWinControl;

public

procedure NewWinMethod (var Msg: TMessage);

end;

var

Form1: TForm1;

implementation

uses SubSecon;

{$R *.DFM}

var

OldWndProc: Pointer = nil;

function NewWinProc (Handle: THandle;

Msg, wParam, lParam: LongInt): LongInt; stdcall;

begin

if Msg = wm_RButtonDown then

begin

Beep;

SetWindowText (Handle,

PChar (Format (‘Right click in %d, %d’, [

LoWord (lParam), HiWord (lParam)])));

end;

// pass call to old window proc

Result := CallWindowProc (OldWndProc, Handle,

Msg, wParam, lParam);

end;

procedure TForm1.NewWinMethod (var Msg: TMessage);

begin

if Msg.Msg = wm_LButtonDown then

begin

Beep;

SubControl.SetTextBuf (

PChar (Format (‘Left click in %d, %d’, [

LoWord (Msg.lParam), HiWord (Msg.lParam)])));

end

else

Msg.Result := CallWindowProc (OldWndMeth,

SubControl.Handle, Msg.Msg, Msg.WParam, Msg.LParam);

end;

procedure TForm1.BtnShowClick(Sender: TObject);

begin

Form2.Show;

end;

procedure TForm1.BtnProcClick(Sender: TObject);

begin

OldWndProc := Pointer (SetWindowLong

(Form2.Handle, gwl_WndProc, LongInt (@NewWinProc)));

BtnProc.Enabled := False;

end;

procedure TForm1.BtnMethClick(Sender: TObject);

begin

SubControl := Form2;

NewWndMeth := MakeObjectInstance (NewWinMethod);

OldWndMeth := Pointer (SetWindowLong (

SubControl.Handle, gwl_WndProc, Longint (NewWndMeth)));

BtnMeth.Enabled := False;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

if Assigned (NewWndMeth) then

FreeObjectInstance (NewWndMeth);

end;

end.

Загрузить исходный код проекта

{/codecitation}

Передача переменных форме

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

Автор: Ed Jordan

…поможете мне создать функцию, с помощью которой я передам переменные в TFormClass? Проблема в том, что MyDlg.Execute() не захотела компилироваться, поскольку, как сообщил мне компилятор, я не могу использовать MyDlg (определенный как: TForm).

Эта функция может выглядеть примерно так:

function ExecuteDialog( FormClass: TFormClass; var Data ): Boolean;

Я могу вам дать еще один совет: сделать все ваши формы наследниками одного класса, в котором объявлены виртуальные методы SetData и GetData.

{ ———————— }

unit ExecFrms;

interface

uses Forms, Controls;

type

TExecForm = class(TForm)

public

procedure GetData(var Data); virtual; abstract;

procedure SetData(var Data); virtual; abstract;

end;

TExecFormClass = class of TExecForm;

function ExecuteDialog(FormClass: TExecFormClass;

var Data): Boolean;

implementation

function ExecuteDialog(FormClass: TExecFormClass;

var Data): Boolean;

begin

with FormClass.Create(Application) do

try

SetData(Data);

Result := ShowModal = mrOK;

if Result then

GetData(Data);

finally

Release;

end;

end;

end.

{ ———————— }

Как вы можете видеть, я поместил функцию ExecuteDialog в тот же самый модуль.

После того как Delphi создаст форму, вы должны в модуле формы сделать четыре вещи:

вручную измените предка формы, с TForm на TExecForm;

добавьте ExecFrms в список используемых модулей;

добавьте тип записи для хранения данных, необходимых диалогу; и

перекрыть методы SetData и GetData.

{ ———————— }

unit MyDlgs;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms,

Controls, Buttons, StdCtrls, Spin, ExtCtrls,

ExecFrms;

type

{ Запись для данных, необходимых модальной форме… }

TMyDlgData = record

FormCaption: string;

FormWidth: Integer;

end;

TMyDlg = class(TExecForm)

OKBtn: TBitBtn;

CancelBtn: TBitBtn;

HelpBtn: TBitBtn;

Bevel1: TBevel;

Edit1: TEdit;

SpinEdit1: TSpinEdit;

public

procedure SetData(var Data); override;

procedure GetData(var Data); override;

end;

var

MyDlg: TMyDlg;

implementation

{$R *.DFM}

procedure TMyDlg.SetData(var Data);

begin

with TMyDlgData(Data) do

begin

Edit1.Text := FormCaption;

SpinEdit1.Value := FormWidth;

end;

end;

procedure TMyDlg.GetData(var Data);

begin

with TMyDlgData(Data) do

begin

FormCaption := Edit1.Text;

FormWidth := SpinEdit1.Value;

end;

end;

end.

{ ———————— }

Затем создаем и выполняем диалог, который должен выглядеть приблизительно так:

{ Добавьте ExecFrms и MyDlgs в список USES вызывающего модуля. }

procedure TForm1.GetNewCaptionAndWidthBtnClick(Sender: TObject);

var

Data: TMyDlgData;

begin

Data.FormCaption := Caption;

Data.FormWidth := Width;

if ExecuteDialog(TMyDlg, Data) then

begin

Caption := Data.FormCaption;

Width := Data.FormWidth;

end;

end;

Не поверите: данный код работает еще со времён Turbo Vision!

{/codecitation}

Освобождение экземпляров формы

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

Автор: Jeff Fisher

В нашем примере для решения задачи мы передаем конструктору переменную формы. Затем, при закрытии формы, мы сбрасываем эту переменную.

Естественно, эта технология подразумевает написание некоторого кода, поэтому, если вы не расположены к этому действию, пропустите мое дальнейшее повествование.

TMyForm = class(TForm)

private

FormVar: ^TMyForm;

public

constructor Create(AOwner: TComponent; var AFormVar: TMyForm);

destructor Destroy; override;

end;

constructor TMyForm.Create(AOwner: TComponent; var AFormVar: TMyForm);

begin

FormVar := @AFormVar;

inherited Create;

…..

end;

destructor TMyForm.Destroy;

begin

FormVar^ := nil;

inherited Destroy;

end;

MyForm := TMyForm.Create(Self, MyForm);

MyOtherForm := TMyForm.Create(Self, MyOtherForm);

Этот код при разрушении окна автоматически сбрасывает все, что вы передаете в AFormVar, в nil.

Как вы, наверное, заметили, частный член FormVar реально является указателем на указатель. Так, читая содержимое памяти, адрес которой содержится в FormVar, мы реально получаем переменную формы. Таким образом мы можем просто установить ее в nil.

{/codecitation}

Не закрывающееся окно

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

Приходит как-то Билли Гейтс в Массачусетский технологический и начинает вешать на уши лапшу про то, как у них там в ГигаСофте круто и какие у них программы пишутся.

А ему в ответ:

— Alt F4!!!

Например вы отключили Ctrl Alt Delete, сделали неактивной кнопку закрытия окна, удалили саму команду «Закрыть» в системном меню («модификация системного меню») — всё это мы уже знаем как делать, но… глупый ламерюга может попросту нажать Alt F4… вот это у нас ещё не учтено! Так как же запретить закрытие окна?

Делать это будем так: вызываем событие OnCloseQuery для формы и пишем туда два слова!!!

CanClose:=false;

Посмотрите внимательнее на параметры, переданные в вызванном нами событии. Там вы и увидите то самое «CanClose», которое мы использовали. Всё довольно таки легко: если этот параметр установить в false пользователь не сможет закрыть окно, в противном случае — сможет. Ну вот теперь мы добились того, что «ждал от нас юзверь»… так не будем и впредь разочаровывать его!

Кстати, чуть не забыл… даже компьютер нельзя будет выключить, пока не закончит сеанс наша прога!!! Круто!

{/codecitation}

Наполовину активное окно

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

Как сделать так, чтобы окно было неактивно? Вы скажите: «Ничего сложного. Нужно только свойство окна Enabled установить в false»… но, так как окно является владельцем компонентов, находящихся на нём, то и все компоненты станут неактивными! Но был найден способ избежать этого!

private

{ Private declarations }

procedure WMNCHitTest (var M: TWMNCHitTest); message wm_NCHitTest;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest (var M:TWMNCHitTest);

begin

if M.Result = htClient then

M.Result := htCaption;

end;

{/codecitation}