Формы нестандартного вида

Автор статьи: нет ©

Сайт Автора: нет

E-mail Автора: нет

Дата публикации: 20.01.2006

Как сделать развернуть окно на весь экран?
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;