Code:

unit testmain;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, StdCtrls, Buttons, ShellAPI;

 

type

TForm1 = class(TForm)

   procedure FormCreate(Sender: TObject);

private

   { Private declarations }

   FOldHeight: Integer;

   procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown);

     message WM_NCRBUTTONDOWN;

public

   { Public declarations }

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.FormCreate(Sender: TObject);

begin

FOldHeight := ClientHeight;

end;

 

procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown);

var

I: Integer;

begin

if (Msg.HitTest = HTCAPTION) then

   if (ClientHeight = 0) then

   begin

     I := 0;

     while (I < FOldHeight) do

     begin

       I := I + 40;

       if (I > FOldHeight) then

         I := FOldHeight;

       ClientHeight := I;

       Application.ProcessMessages;

     end;

   end

   else

   begin

     FOldHeight := ClientHeight;

     I := ClientHeight;

     while (I > 0) do

     begin

       I := I - 40;

       if (I < 0) then

         I := 0;

       ClientHeight := I;

       Application.ProcessMessages;

     end;

   end;

end;

 

end.

 

 

Those programmers who use the Win API in their programs know that Win32 allows you to insert one dialog box into another one and you'll can deal with subdialog's controls as them were in parent dialog. The good example of it is PropertySheet. I don't know why Borland hided this ability from us and why didn't it insert 'subforming' ability in TForm control. Here I can tell how to use a form as control (subform) in other one and how to create subform controls. It will work in D2, D3 and may be D4 (unfortunatelly, I have not it and can't check). The next steps shows how to make subform component:

 

First, we have to make the form to be a child. For this we need to override the method CreateParams.

 

 

 

Здесь приведён полный пример того, как создать круглую форму.

Не забудьте создать TButton, чтобы окно можно было закрыть.

Code:

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.

 

  

Code:

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;

 

 

  

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

Region: HRGN;

begin

Region := CreateEllipticRgn(0, 0, 300, 300);

SetWindowRgn(Handle, Region, True);

end;

 

 

 

 

Обычная форма:

Code:

TForm.Style:=bsNone

 

Общее описание

 Windows API предоставляет набор функций, позволяющих описать произвольную (при желании - достаточно сложную) геометрическую фигуру, которая потом может использоваться при работе с окнами, или, в терминологии Delphi, элементами управления. Использование может заключаться, например, в отрисовке на холсте, в задании специфического региона обновления окна, и т.д. Помимо таких вот относительно невинных возможностей, технология регионов позволяяет также глумиться над благородными очертаниями любого потомка TWinControl (иными словами, любым контролом, имеющим Handle, aka TForm, TButton, и т.д.). Особенно широко регионы используются в формах, при их отрисовке и обновлении.

 Итак, для начала, давайте разберёмся, что такое этот самый регион.

 

Win32 SDK регион определяет следующим образом:

 

 

Code:

PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 1);

       

  

Автор ответа: Baa

 

Вопрос создания непрямоугольных окон часто интересует начинающих программистов и время от времени обсуждается на форумах разработчиков в среде Delphi. А вообще, нужно ли это кому-нибудь? Ответ - да! Это уже было нужно таким известным фирмам, как Symantec (Norton Utilities, Norton CrashGuard), Microsoft (Приложение "

Часы" в Windows NT4 может принимать круглую форму, Deluxe CD Player из MS Plus! 98 имеет вид прямоугольника со скругленными краями). У Borland Jbuilder 2 в окне начальной загрузки  стрела крана "выскочила" за пределы прямоугольника. Программы для видеокарт TV Capture фирмы AverMedia имитируют пульт управления. Окно переводчика Magic Goody принимает вид гуся, разгуливающего по экрану.

 

 

Всё, что нам нужно, это HRGN и дескриптор (handle) элемента управления. SetWindowRgn имеет три параметра: дескриптор окна, которое будем менять, дескритор региона и булевый (boolean) параметр, который указывает - перерисовывать или нет после изменения. Как только у нас есть дескриптор и регион, то можно вызвать SetWindowRgn(Handle, Region, True) и вуаля!

 

Здесь приведён пример использования функции BitmapToRgn (описанной в примере Как создать регион(HRNG) по маске).

 

Заметьте, что Вы не должны освобождать регион при помощи DeleteObject, так как после вызова SetWindowRgn владельцем региона становится операционная система.

 

Code:

{

Die CreateRoundRectRgn lasst eine Form mit abgerundeten Ecken erscheinen.

 

The CreateRoundRectRgn function creates a rectangular

region with rounded corners

}

 

procedure TForm1.FormCreate(Sender: TObject);

var

  rgn: HRGN;

begin

  Form1.Borderstyle := bsNone;

  rgn := CreateRoundRectRgn(0,// x-coordinate of the region's upper-left corner

   0,            // y-coordinate of the region's upper-left corner

   ClientWidth,  // x-coordinate of the region's lower-right corner

   ClientHeight, // y-coordinate of the region's lower-right corner

   40,           // height of ellipse for rounded corners

   40);          // width of ellipse for rounded corners

SetWindowRgn(Handle, rgn, True);

end

 

 

{ The CreatePolygonRgn function creates a polygonal region. }

 

 

procedure TForm1.FormCreate(Sender: TObject);

const

  C = 20;

var

  Points: array [0..7] of TPoint;

  h, w: Integer;

begin

  h := Form1.Height;

  w := Form1.Width;

  Points[0].X := C;     Points[0].Y := 0;

  Points[1].X := 0;     Points[1].Y := C;

  Points[2].X := 0;     Points[2].Y := h - c;

  Points[3].X := C;     Points[3].Y := h;

 

  Points[4].X := w - c; Points[4].Y := h;

  Points[5].X := w;     Points[5].Y := h - c;

 

  Points[6].X := w;     Points[6].Y := C;

  Points[7].X := w - C; Points[7].Y := 0;

 

  SetWindowRgn(Form1.Handle, CreatePolygonRgn(Points, 8, WINDING), True);

end;

Автор: winsoft