Вопрос # 1 272: … статью Создание непрямоугольных форм в Delphi, но никак не могу ёе ис… (Прочее)

Здравствуйте!
Я прочитал статью Создание непрямоугольных форм в Delphi, но никак не могу ёе использовать в программе.
Напишите пожалуйста какой-нибудь пример.
Заранее спасибо

Здравствуйте, John!
Держите несколько примеров:
1. Как создавать не квадратные формы и контролы?
2. Как создать круглую форму?
3. Как сделать дырку в окне?
4. Как сделать roll-up форму?
5. Как создать форму в форме эллипса ?
6. Создание форм с закругленными краями
А так же в атаче две статьи: «Создание окон произвольной формы и Работа с регионами».
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Приложение:

var
MaskBmp: TBitmap;
begin
MaskBmp := TBitmap.Create;
try
MaskBmp.LoadFromFile('FormShape.bmp');
Height := MaskBmp.Height;
Width := MaskBmp.Width;
SetWindowRgn(Self.Handle, BitmapToRgn(MaskBmp), True);
finally
MaskBmp.Free;
end;
end;
===============
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;
end;
===============
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.
First, by way of synopsis, the roll-up/down occurs in response to a WM_NCRBUTTONDOWN message firing off and the WMNCRButtonDown procedure handling the message, telling the window to roll up/down depending upon the height of the client area. WM_NCRBUTTONDOWN fires whenever the right mouse button is clicked in a "non-client" area, such as a border, menu or, for our purposes, the caption bar of a form. (The client area of a window is the area within the border where most of the interesting activity usually occurs. In general, the Windows API restricts application code to drawing only within the client area.)
Delphi encapsulates the WM_NCRBUTTONDOWN in a TWMNCRButtonDown type, which is actually an assignment from a TWMNCHitMessage type that has the following structure:
type
TWMNCHitMessage = record
Msg: Cardinal;
HitTest: Integer;
XCursor: SmallInt;
YCursor: SmallInt;
Result: Longint;
end;
It's easy to create message wrappers in Delphi to deal with messages that aren't handled by an object by default. Since a right-click on the title bar of a form isn't handled by default, I had to create a wrapper. The procedure procedure WMNCRButtonDown(var Msg : TWMNCRButtonDown); message WM_NCRBUTTONDOWN; is the wrapper I created. All that goes on in the procedure is the following:
In order to make this work, I had to create a variable called FOldHeight and set its value at FormCreate whenever the form was to be rolled up. FOldHeight is used as a place for the form to remember what size it was before it was re-sized to 0. When a form is to be rolled up, FOldHeight is immediately set to the current ClientHeight, which means you can interactively set the form's size, and the function will always return the form's ClientHeight to what it was before you rolled it up.
So what use is this? Well, sometimes I don't want to iconize a window; I just want to get it out of the way so I can see what's underneath. Having the capability to roll a form up to its title bar makes it a lot easier to see underneath a window without iconizing it, then having to Alt-tab back to it. (If you are familiar with the Macintosh platform, the System 7.5 environment offers a very similar facility called a "window shade," and makes a roll-up sound when the shade goes up.)
=================
procedure TForm1.FormCreate(Sender: TObject);
var
Region: HRGN;
begin
Region := CreateEllipticRgn(0, 0, 300, 300);
SetWindowRgn(Handle, Region, True);
end;
=============
{
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;

Мини-форум вопроса

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 272

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 272

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом