|
|
Перемещение формы,
"захватывая" клиентскую часть
Изображение заставки во время
загрузки программы
Как заблокировать кнопку
закрытия в заголовке формы
Вывод в заголовке формы
текущего времени
Добавление пункта в системное
меню формы
Создание MIDI-child формы без
названия
Иммитация нажатия TAB в
диалоге
Ключом к созданию прозрачных форм и компонентов является функция SetWindowRgn:
unit TransparentForm;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TTransparentForm = class(TForm)
// это просто кнопка на форме - для демонстрации
Button1: TButton;
protected
procedure RebuildWindowRgn;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
end;
var
TransparentForm: TTransparentForm;
implementation
// ресурс этой формы
{$R *.DFM}
{ TTransparentForm }
constructor TTransparentForm.Create(AOwner: TComponent);
begin
inherited;
// убираем сколлбары, чтобы не мешались
// при изменении размеров формы
HorzScrollBar.Visible:= False;
VertScrollBar.Visible:= False;
// строим новый регион
RebuildWindowRgn;
end;
procedure TTransparentForm.Resize;
begin
inherited;
// строим новый регион
RebuildWindowRgn;
end;
procedure TTransparentForm.RebuildWindowRgn;
var FullRgn, Rgn: THandle;
ClientX, ClientY, I: Integer;
begin
// определяем относительные координаты клиенской части
ClientX:= (Width - ClientWidth) div 2;
ClientY:= Height - ClientHeight - ClientX;
// создаем регион для всей формы
FullRgn:= CreateRectRgn(0, 0, Width, Height);
// создаем регион для клиентской части формы
// и вычитаем его из FullRgn
Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +
ClientHeight);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
// теперь добавляем к FullRgn регионы каждого контрольного элемента
for I:= 0 to ControlCount -1 do
with Controls[I] do begin
Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +
Width, ClientY + Top + Height);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
end;
// устанавливаем новый регион окна
SetWindowRgn(Handle, FullRgn, True);
end;
end.
procedure WMNCHitTest (VAR Msg : TWMNCHitTest); message WM_NCHitTEst; procedure TForm1.WMNCHitTest; // Для перетаскивания формы begin Inherited; if Msg.Result = htClient then Msg.Result:=htCaption; end; procedure TForm1.FormCreate(Sender: TObject); var hsWindowRegion: Integer; begin hsWindowRegion:=CreateEllipticRgn(40,40,700,500); SetWindowRgn(Handle, hsWindowRegion, True); end;
В следующем примере показано как можно передвигать форму
если пользователь "захватил" Client-пространство.
Наиболее простое решение -
"обмануть" Windows и Client-пространство выдать за заголовок окна.
unit DragMain;
interface
uses SysUtils, WinTypes, WinProcs, Messages,
Classes, Graphics, Controls, Forms, Dialogs, StdCrtls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure ButtonClick(Sender: TObject);
private
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1. WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then
M.Result := htCaption;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
end.
unit UnitMain;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TFrmRestrictSize = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
// You must handle the WM_GETMINMAXINFO message
procedure RestrictSize(var msg: TMessage); message WM_GETMINMAXINFO;
end;
var
FrmRestrictSize: TFrmRestrictSize;
implementation
{$R *.DFM}
procedure TfrmRestrictSize.RestrictSize(var Msg: TMessage);
var p: PMinMaxInfo;
begin
// The lParam contains a pointer on a structure of type TMinMaxInfo
p := PMinMaxInfo(Msg.lParam);
// This represents the size of the Window when Maximized
p.ptMaxSize.x := 320;
p.ptMaxSize.y := 240;
// This represents the position of the Window when Maximized
p.ptMaxPosition.x := 10;
p.ptMaxPosition.y := 10;
// This represents the minimum size of the Window
p.ptMinTrackSize.x := 320;
p.ptMinTrackSize.y := 240;
// This represents the maximum size of the Window
p.ptMaxTrackSize.x := 400;
p.ptMaxTrackSize.y := 320;
end;
end.
ptMaxSize Размер окна при его максимизации.
ptMaxPosition Положение левого верхнего угла окна при его максимизации.
ptMaxTrackSize Максимальный размер окна при увеличении его размеров.
ptMinTrackSize Минимальный размер окна при уменьшении его размеров.
В основной файл проекта(.dpr) вносятся следующие изменения:
В отдельном модуле splash создается необходимая форма.
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
splash; // здесь хранится форма заставки
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
SplashScreen := TSplashScreen.Create(Application);
try
SplashScreen.Show;
SplashScreen.Update; {Process any pending Windows paint messages}
finally {Make sure the splash screen gets released}
SplashScreen.Free;
end;
Application.Run;
end.
procedure TForm1.FormCreate(Sender: TObject);
var hMenuHandle:HMENU;
begin
hMenuHandle := GetSystemMenu(Handle, FALSE);
if (hMenuHandle <> 0) then begin
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var dc: HDC;
cc: TCanvas;
s: string;
begin
dc:=GetWindowDC(Handle);
cc:=TCanvas.Create;
cc.Handle:=dc;
s:=TimeToStr(time);
cc.Brush.Color:=8388608;
cc.Font.Size:=10;
cc.Font.Color:=clWhite;
cc.TextOut(Width div 2,5,s);
ReleaseDc(Handle,dc);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var RecS, RecL: TRect;
begin
RecS:= rect(0,0,0,0);
RecL:= Form1.BoundsRect;
DrawAnimatedRects(GetDesktopWindow, IDANI_CAPTION, RecL,RecS);
end;
procedure TForm1.FormShow(Sender: TObject);
var RecS, RecL: TRect;
begin
RecS:= rect(0,0,0,0);
RecL:= Form1.BoundsRect;
{ only possible with IDANI_CAPTION }
DrawAnimatedRects(GetDesktopWindow, IDANI_CAPTION, RecS,RecL);
end;
type
TForm1 = class(TForm)
. . .
procedure HookSysCommand(var message:TWMSYSCOMMAND);message WM_SYSCOMMAND;
end;
implementation
const
My_MenuItem=$4000;
procedure TForm1.HookSysCommand(var message:TWMSYSCOMMAND);
begin
inherited;
if message.CmdType=My_MenuItem then
ShowMessage('Пункт активизирован');
end;
procedure TForm1.FormCreate(Sender: TObject);
var SMenu : THandle;
begin
SMenu:=GetSystemMenu(Handle, False);
InsertMenu(SMenu, 1, MF_Byposition, My_MenuItem, 'Новый пункт');
end;
type
TForm2 = class(TForm)
procedure CreateParams(var Params: TCreateParams); override;
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not WS_OVERLAPPEDWINDOW or WS_BORDER
end;
SendMessage(Form1.Handle,WM_NEXTDLGCTL,0,0);