postmessage(application.handle, wm_syscommand, sc_maximize, 1);
Как сделать форму без caption?
Обычная форма:
tform.style:=bsnone
mdichild форма:
setwindowlong (handle,gwl_style,getwindowlong(handle, gwl_style) and not ws_caption);
width:=width+1;
width:=width-1;
{ private declaration }
procedure createparams(var params : tcreateparams); override;
...
procedure tform1.createparams(var params : tcreateparams);
begin
inherited createparams(params);
with params do
style := (style or ws_popup) and not ws_dlgframe;
end;
Как создавать не прямоугольные формы и контролы?
Всё, что нам нужно, это hrgn и дескриптор (handle) элемента управления. setwindowrgn имеет три параметра: дескриптор окна, которое будем менять, дескритор региона и булевый (boolean) параметр, который указывает - перерисовывать или нет после изменения. Как только у нас есть дескриптор и регион, то можно вызвать setwindowrgn(handle, region, true) и вуаля!
Здесь приведён пример использования функции bitmaptorgn (описанной в примере Как создать регион(hrng) по маске).
Заметьте, что Вы не должны освобождать регион при помощи deleteobject, так как после вызова setwindowrgn владельцем региона становится операционная система.
var
maskbmp: tbitmap;
begin
maskbmp := tbitmap.create;
try
maskbmp.loadfromfile('formshape.bmp');
height := maskbmp.height;
width := maskbmp.width;
// ОС владеет регионом, после вызова setwindowrgn
setwindowrgn(self.handle, bitmaptorgn(maskbmp), true);
finally
maskbmp.free;
end;
end;
Как создать круглую форму?
Здесь приведён полный пример того, как создать круглую форму.
Не забудьте создать tbutton, чтобы окно можно было закрыть.
unit unit1;
interface
uses
windows, messages, sysutils, classes, graphics, controls,
forms, dialogs, extctrls, buttons, stdctrls;
type
tform1 = class(tform)
button1: tbutton;
procedure formcreate(sender: tobject);
procedure button1click(sender: tobject);
private
{ private-deklarationen}
procedure createparams(var params: tcreateparams); override;
public
{ public-deklarationen}
end;
var
form1: tform1;
implementation
{$r *.dfm}
{ tform1 }
procedure tform1.createparams(var params: tcreateparams);
begin
inherited createparams(params);
{ удаляем заголовок и рамку }
params.style := params.style or ws_popup xor ws_dlgframe;
end;
procedure tform1.formcreate(sender: tobject);
var
formrgn: hrgn;
begin
{clear form}
form1.brush.style := bssolid; //bsclear;
{ делаем круг формы }
getwindowrgn(form1.handle, formrgn);
{ удаляем старый объект }
deleteobject(formrgn);
{ делаем прямоугольник формы }
form1.height := 500;
form1.width := form1.height;
{ создаём круглую форму }
formrgn := createroundrectrgn(1, 1, form1.width - 1,
form1.height - 1, form1.width, form1.height);
{ устанавливаем новое круглое окно }
setwindowrgn(form1.handle, formrgn, true);
end;
procedure tform1.button1click(sender: tobject);
begin
form1.close;
end;
end.
Как сделать дырку в окне?
procedure tform1.button4click(sender: tobject);
var
hregion1, hreg2, hreg3: thandle;
col: tcolor;
begin
showmessage ('ready for a real crash?');
col := color;
color := clred;
playsound ('boom.wav', 0, snd_sync);
hregion1 := createpolygonrgn (pts,
sizeof (pts) div 8,
alternate);
setwindowrgn (
handle, hregion1, true);
showmessage ('now, what have you done?');
color := col;
showmessage ('Смените монитор!');
end;