Перемещение формы, "захватывая" клиентскую часть
Изображение заставки во время загрузки программы
Как заблокировать кнопку закрытия в заголовке формы
Вывод в заголовке формы текущего времени
Добавление пункта в системное меню формы
Создание 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);