Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

procedureTMainForm.CreateParams( varp: TCreateParams);

begin

inherited;

p.WndParent := 0;

end;

procedureTMainForm.WMSysCommand( varm: TMessage);

begin

m.Result := DefWindowProc(Handle, m.Msg, m.wParam, m.lParam);

end;

Вместо SetWindowLong в MDI-приложениях лучше использовать

ShowWindow(Application.Handle, SW_HIDE);

Ситников Митрийсоветует:

В следующем примере показано как можно передвигать форму если пользователь "захватил" Client-пространство:

unitMain;

interface

usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

typeTForm1 = class(TForm)

Button1: TButton;

procedureButton1Click(Sender: TObject);

procedureFormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

MX: integer;

MY: integer;

implementation

{$R *.DFM}

procedureTForm1.Button1Click(Sender: TObject);

begin

Close;

end;

procedureTForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

ifShift<>[ssLeft] then begin

MX:=X;

MY:=Y;

end else begin

Left:=Left+X-MX;

Top:=Top+Y-MY;

end;

end;

end.

Как мне переместить форму, не имеющую заголовка?

Выберите элемент управления (или саму форму) и напишите это в его (ее) обработчике события OnMouseDown (данный пример дан только для формы):

procedureTForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Perform(WM_SYSCOMMAND, SC_MOVE+2, 0);

end;

Классно! Намного проще метода NCHitTest, который я предлагал. Хотя многое из того, чтобы вы мне написали, я не понял. Для чего нужно прибавлять 2 к параметру SC_MOVE? В справке по API об этом ничего не сказано.

Ну хорошо, есть недокументированный способ сообщить Windows о необходимости перемещения окна таким же способом, что и с помощью заголовка (это может вызвать неадекватную реакцию системы, не делайте этого!). Другим способом перемещения окна является перекрытие WMNCHITTEST и возвращения им значения HTCAPTION. Тем не менее, обычно я предпочитаю пользоваться методом SC_MOVE+2, поскольку он не требует создания потомков, а только создание обработчика OnMouseDown. Отчасти аналогично, вы можете добавлять константы SC_SIZE к WM_SYSCOMMAND для получения размера окна подобно тому, как если бы вы потянули его за бордюрчик. В основном мы добавляем код hittest – 9. В следующем классе определена панель, которая сама изменяет свои размеры при щелчке в ее нижнем правом углу, и сама перемещается, если вы щелкнули по ней где-то еще.

TypeTMovablePanel = Class(TPanel)

Private

ProcedurewmNCHitTest( Var Message: TWMNCHitTest); messageWM_NCHITTEST;

Protected

ProcedureMouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer); override;

End;

ProcedureTMovablePanel.wmNCHitTest( Var Message: TWMNCHitTest);

Begin

With Message,ScreenToClient(Pos) Do

If(X < Width - 10) And(Y < Height - 10) Then

Message.Result := HTCAPTION

Else Message.Result := HTCLIENT;

End;

ProcedureTMovablePanel.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);

Begin

IfButton = mbLeft Then Begin

ReleaseCapture;

Perform(WM_SYSCOMMAND, SC_SIZE + HTBOTTOMRIGHT - 9, 0);

End Else InheritedMouseDown(Button, SHift, X, Y);

End;

– Robert Wittig

Nomadicсоветует:

Кидаю проект-болванку, сделанную перед началом работы над основным -

unitUnit1; //базовая форма хранителя страницы

interface

uses ...

typeTBPgFrm = class(TForm)

Panel1: TPanel;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

Label1: TLabel;

public

functionPgInit: boolean; virtual;

functionPgValid: boolean; virtual;

end;

implementation

{$R *.DFM}

functionTBPgFrm.PgInit: boolean;

begin

result:= MessageDlg(Label1.Caption+': PgInit', mtConfirmation, mbOkCancel, 0)=mrOK;

end;

functionTBPgFrm.PgValid: boolean;

begin

result:= MessageDlg(Label1.Caption+': PgValid', mtConfirmation, mbOkCancel, 0)=mrOK;

end;

end.

unitUnit2; //главная форма проекта; содержит первую страницу

interface//и кнопки Cancel, Prev & Next/Finish.

uses ...

typeTPagesDlg = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

Prev: TButton;

CancelBtn: TButton;

Next: TButton;

Label1: TLabel;

procedureCancelBtnClick(Sender: TObject);

procedureFormDestroy(Sender: TObject);

procedureNextClick(Sender: TObject);

procedurePrevClick(Sender: TObject);

privateFrms: TList;

procedureAddForms;

end;

varPagesDlg: TPagesDlg;

implementation

usesUnit1, Unit3, Unit4, Unit5;

{$R *.DFM}

procedureTPagesDlg.AddForms; //размещение динамических страниц

vari: word;

begin

Frms:= TList.Create;

Frms.Add(TBPgFrm1.Create(Self));

Frms.Add(TBPgFrm2.Create(Self));

fori:= 0 to1 doTBPgFrm(Frms[i]).TabSheet1.PageControl := PageControl1

end;

procedureTPagesDlg.CancelBtnClick(Sender: TObject);

begin

Close;

end;

procedureTPagesDlg.FormDestroy(Sender: TObject);

vari: word;

begin

fori:= Frms.Count-1 downto0 doTBPgFrm(Frms[i]).Free;

Frms.Free;

end;

procedureTPagesDlg.NextClick(Sender: TObject);

var

i: word;

vi: Boolean;

begin

Next.Enabled:= false;

ifPageControl1.PageCount=1 thenAddForms;

i:= PageControl1.ActivePage.PageIndex;

ifi=0 thenvi:= true

elsevi:= TBPgFrm(Frms[i-1]).PgValid;

ifvi then

withPageControl1 do

ifi=PageCount-1 then begin

CancelBtnClick(Sender);

exit;

end else begin

ActivePage:= FindNextPage(ActivePage, True, false);

ifActivePage.PageIndex=PageCount-1 thenNext.Caption:= 'Finish';