TForm
|
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. |
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
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.
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
Здесь приведён полный пример того, как создать круглую форму.
Не забудьте создать 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. |
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
|
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; |
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
|
Code: |
|
procedure TForm1.FormCreate(Sender: TObject); var Region: HRGN; begin Region := CreateEllipticRgn(0, 0, 300, 300); SetWindowRgn(Handle, Region, True); end; |
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
Обычная форма:
|
Code: |
|
TForm.Style:=bsNone |
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
Общее описание
Windows API предоставляет набор функций, позволяющих описать произвольную (при желании - достаточно сложную) геометрическую фигуру, которая потом может использоваться при работе с окнами, или, в терминологии Delphi, элементами управления. Использование может заключаться, например, в отрисовке на холсте, в задании специфического региона обновления окна, и т.д. Помимо таких вот относительно невинных возможностей, технология регионов позволяяет также глумиться над благородными очертаниями любого потомка TWinControl (иными словами, любым контролом, имеющим Handle, aka TForm, TButton, и т.д.). Особенно широко регионы используются в формах, при их отрисовке и обновлении.
Итак, для начала, давайте разберёмся, что такое этот самый регион.
Win32 SDK регион определяет следующим образом:
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
|
Code: |
|
PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 1); |
Автор ответа: Baa
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
Вопрос создания непрямоугольных окон часто интересует начинающих программистов и время от времени обсуждается на форумах разработчиков в среде Delphi. А вообще, нужно ли это кому-нибудь? Ответ - да! Это уже было нужно таким известным фирмам, как Symantec (Norton Utilities, Norton CrashGuard), Microsoft (Приложение "
Часы" в Windows NT4 может принимать круглую форму, Deluxe CD Player из MS Plus! 98 имеет вид прямоугольника со скругленными краями). У Borland Jbuilder 2 в окне начальной загрузки стрела крана "выскочила" за пределы прямоугольника. Программы для видеокарт TV Capture фирмы AverMedia имитируют пульт управления. Окно переводчика Magic Goody принимает вид гуся, разгуливающего по экрану.
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
Всё, что нам нужно, это HRGN и дескриптор (handle) элемента управления. SetWindowRgn имеет три параметра: дескриптор окна, которое будем менять, дескритор региона и булевый (boolean) параметр, который указывает - перерисовывать или нет после изменения. Как только у нас есть дескриптор и регион, то можно вызвать SetWindowRgn(Handle, Region, True) и вуаля!
Здесь приведён пример использования функции BitmapToRgn (описанной в примере Как создать регион(HRNG) по маске).
Заметьте, что Вы не должны освобождать регион при помощи DeleteObject, так как после вызова SetWindowRgn владельцем региона становится операционная система.
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
|
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
- Подробности
- Родительская категория: TForm
- Категория: Формы нестандартного вида
Страница 1 из 8