Как нарисовать форму?

← →
Юлиана (2003-12-06 03:04) [0]

Подскажите, пожалуйста, как самой нарисовать форму для приложения?

← →
aus (2003-12-06 03:59) [1]

Если имеется ввиду форма нестандартная (круглая, например), то об этом где-то в FAQ есть.

← →
Юлиана (2003-12-06 10:29) [2]

если честно, не нашла... может будут еще какие-нибудь предложения?

← →
Zacho (2003-12-06 10:44) [3]

См. Region Creation and Selection и Region Functions в win32.hlp

← →
TUser (2003-12-06 10:46) [4]

Для формы нестандарной формы - надо задать ей SewWindowRgn. Но перед этим регион нужно сотворить - CreateEllipticRgn, например. Для создания совсем наворотистой формы - надо комбинировать много разных регионов.

← →
Intell (2003-12-06 11:46) [5]

У меня есть исходник как рисовать любую форму, кому нужен?

← →
Донской (2003-12-06 14:47) [6]

Эх, хотел по почте кинуть, да ссылки на мыло Юлианы нет.

Вот несколько примеров, буду по одному кидать

Умея создавать окно эллипсовидной формы, для вас не составит большого труда слепить что-нибудь наподобие того, что показано на рисунке. Всё, что вам нужно сделать - это создать не один, а два региона и объединить их, используя функцию CombineRgn, т.е. теперь по созданию окна можно написать что-то вроде этого:

procedure TForm1.FormCreate(Sender: TObject);
var
hsWindowRegion, hsWindowRegion2:Integer;
begin
hsWindowRegion:=CreateEllipticRgn(50,50,350,200);
hsWindowRegion2:=CreateEllipticRgn(80,80,200,150);
CombineRgn(hsWindowRegion,hsWindowRegion, hsWindowRegion2,RGN_DIFF);
SetWindowRgn(Handle,hsWindowRegion,true);
end;

Как это сделано?

Мы уже знаем какую функцию нужно использовать для объединения регионов, но как же она действует и что же ей нужно указывать?

Вводятся следующие параметры:

1) Дескриптор региона назначения,

2) Дескриптор первого региона источника,

3) Дескриптор второго региона источника,

4) Режим взаимодействия регионов источников.

В качестве режима мы указали константу RGN_DIFF, а использовать можем:

RGN_AND - Создает пересечение из двух смешанных областей,
RGN_COPY - Создает копию области, идентифицированной дескриптором первой области источника,
RGN_DIFF - Выводит части первой области источника, которые не пересекаются со второй,

RGN_OR - Создает объединение двух смешанных областей,
RGN_XOR - Создает объединение двух смешанных областей за исключением зоны перекрытия.

← →
Донской (2003-12-06 14:48) [7]

Вот еще что-то

Окно в виде крутого кольца
------------------------------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls;

type
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
rTitleBar : THandle;
Center : TPoint;
CapY : Integer;
Circum : Double;
SB1 : TSpeedButton;
RL, RR : Double;
procedure TitleBar(Act : Boolean);
procedure WMNCHITTEST(var Msg: TWMNCHitTest);
message WM_NCHITTEST;
procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE);
message WM_NCACTIVATE;
procedure WMSetText(var Msg: TWMSetText);
message WM_SETTEXT;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
CONST TitlColors : ARRAY[Boolean] OF TColor = (clInactiveCaption, clActiveCaption); TxtColors : ARRAY[Boolean] OF TColor = (clInactiveCaptionText, clCaptionText);
procedure TForm1.FormCreate(Sender: TObject);
VAR
rTemp, rTemp2 : THandle;
Vertices : ARRAY[0..2] OF TPoint;
X, Y : INteger;
begin
Caption := "OOOH! Doughnuts!";
BorderStyle := bsNone; {required}
IF Width > Height THEN Width := Height
ELSE Height := Width; {harder to calc if width <> height}
Center := Point(Width DIV 2, Height DIV 2);
CapY := GetSystemMetrics(SM_CYCAPTION)+8;
rTemp := CreateEllipticRgn(0, 0, Width, Height);
rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),
3*(Width DIV 4), 3*(Height DIV 4));
CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);
SetWindowRgn(Handle, rTemp, True);
DeleteObject(rTemp2);
rTitleBar := CreateEllipticRgn(4, 4, Width-4, Height-4);
rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);
CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);
Vertices[0] := Point(0,0);
Vertices[1] := Point(Width, 0);
Vertices[2] := Point(Width DIV 2, Height DIV 2);
rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);
CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);
DeleteObject(rTemp);
RL := ArcTan(Width / Height);
RR := -RL + (22 / Center.X);
X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));
Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));
SB1 := TSpeedButton.Create(Self);
WITH SB1 DO
BEGIN
Parent := Self;
Left := X;
Top := Y;
Width := 14;
Height := 14;
OnClick := Button1Click;
Caption := "X";
Font.Style := [fsBold];
END;
end;

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
Inherited;
WITH Msg DO
WITH ScreenToClient(Point(XPos,YPos)) DO
IF PtInRegion(rTitleBar, X, Y) AND
(NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN
Result := htCaption;
end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
Inherited;
TitleBar(Msg.Active);
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
Inherited;
TitleBar(Active);
end;

procedure TForm1.TitleBar(Act: Boolean);
VAR
TF : TLogFont;
R : Double;
N, X, Y : Integer;
begin
IF Center.X = 0 THEN Exit;
WITH Canvas DO
begin
Brush.Style := bsSolid;
Brush.Color := TitlColors[Act];
PaintRgn(Handle, rTitleBar);
R := RL;
Brush.Color := TitlColors[Act];
Font.Name := "Arial";
Font.Size := 12;
Font.Color := TxtColors[Act];
Font.Style := [fsBold];
GetObject(Font.Handle, SizeOf(TLogFont), @TF);
FOR N := 1 TO Length(Caption) DO
BEGIN
X := Center.X-Round((Center.X-6)*Sin(R));
Y := Center.Y-Round((Center.Y-6)*Cos(R));
TF.lfEscapement := Round(R * 1800 / pi);
Font.Handle := CreateFontIndirect(TF);
TextOut(X, Y, Caption[N]);
R := R - (((TextWidth(Caption[N]))+2) / Center.X);
IF R < RR THEN Break;
END;
Font.Name := "MS Sans Serif";
Font.Size := 8;
Font.Color := clWindowText;
Font.Style := [];
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
WITH Canvas DO
BEGIN
Pen.Color := clBlack;
Brush.Style := bsClear;
Pen.Width := 1;
Pen.Color := clWhite;
Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);
Arc((Width DIV 4)-1, (Height DIV 4)-1,
3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0);
Pen.Color := clBlack;
Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);
Arc((Width DIV 4)-1, (Height DIV 4)-1,
3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height);
TitleBar(Active);
END;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;

end.

← →
Донской (2003-12-06 14:50) [8]

или так

В общем, все взято с сайта HiTech.ru (сейчас его кажется закрыли)

Окно по рисунку
------------------------------------
TStretchHandle = class(TCustomControl)
private
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
protected
procedure Paint; override;
property Canvas;
public
procedure CreateParams(var Params: TCreateParams); override;
end;

procedure TStretchHandle.CreateParams(var Params: TCreateParams);
begin
{ set default Params values }
inherited CreateParams(Params);
{ then add transparency }
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure TStretchHandle.WMGetDLGCode(var Message: TMessage);
begin
{ completely fake erase, don"t call inherited, don"t collect $200 }
Message.Result := DLGC_WANTARROWS;
end;

procedure TStretchHandle.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
{ completely fake erase, don"t call inherited, don"t collect $200 }
Message.Result := 1;
end;

procedure TStretchHandle.Paint;
begin

inherited Paint;
with Canvas do
begin
// рисуете что нужно -
// где не рисовали, там будет "прозрачно"
end;
end;

← →
Intell (2003-12-06 15:55) [9]

У меня в примере форма задаётся рисунком. Что нарисовал, то и будет.

← →
Sacred (2003-12-06 23:58) [10]

2 Intel!
Кинь мне на мыло плиз свой пример, давно хотел заняться такой фичей...спасибо

← →
Intell (2003-12-07 07:08) [11]

Кому ещё нужен?

← →
mfender (2003-12-07 07:27) [12]

В ABC есть TabcShapeForm. Я даже ею как-то пользовался. Довольно забавный выбор базы получился при старте программы.

← →
Intell (2003-12-07 07:34) [13]

Это что такое? Компонент?

← →
mfender (2003-12-07 07:36) [14]

> Intell © (07.12.03 07:34) [13]
> Это что такое? Компонент?

Ну да. ABC - это, если мне что-то там не изменяет, не помню что - Advanced Business Components или что-то такое. Там множество всякой фичи. Ну и вот это.

← →
intell (2003-12-07 07:38) [15]

Интерестно, надо глянуть. А он платный?

← →
mfender (2003-12-07 07:42) [16]

> intell © (07.12.03 07:38) [15]
> Интерестно, надо глянуть. А он платный?

Да. Он же Advanced Business...
Но для ознакомления и личного использования всегда пойдет.

Как нарисовать форму? Найти похожие ветки