Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.06.20;
Скачать: CL | DM;

Вниз

Непрямоугольное меню   Найти похожие ветки 

 
Denis2003   (2004-06-04 16:38) [0]

Кто-нибудь создавал меню со скругленными углами?


 
Тимохов ©   (2004-06-04 16:51) [1]

у меня так было
без комментариев (писал 4 года назад)

UNIT FBCTitle;

INTERFACE

USES
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls;

TYPE
 TForm_BCTitle = class(TForm)
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 procedure FormPaint(Sender: TObject);

 private
 BackBMP: TBitmap;
 FullRgn, LTRgn, RTRgn, RBRgn, LBRgn: THandle;

 procedure CalcRgns;
 end;

IMPLEMENTATION

{$R *.DFM}

USES
ResManager;

PROCEDURE TForm_BCTitle.CalcRgns;
CONST
R = 15;
VAR
W,H: Integer;
P: array [0..7] of TPOINT;
BEGIN
W := Width; H := Height;

with P[0] do begin X := 0; Y := R end;
with P[1] do begin X := R; Y := 0 end;
with P[2] do begin X := W-R; Y := 0 end;
with P[3] do begin X := W; Y := R end;
with P[4] do begin X := W; Y := H-R end;
with P[5] do begin X := W-R; Y := H end;
with P[6] do begin X := R; Y := H end;
with P[7] do begin X := 0; Y := H-R end;
FullRgn := CreatePolygonRgn(P, 8, ALTERNATE);

LTRgn := CreateEllipticRgn(0,0, R*2, R*2);
RTRgn := CreateEllipticRgn(W-R*2,0, W, R*2);
RBRgn := CreateEllipticRgn(W-R*2,H-R*2, W, H);
LBRgn := CreateEllipticRgn(0,H-R*2, R*2, H);

CombineRgn(FullRgn, FullRgn, LTRgn, RGN_OR);
CombineRgn(FullRgn, FullRgn, RTRgn, RGN_OR);
CombineRgn(FullRgn, FullRgn, RBRgn, RGN_OR);
CombineRgn(FullRgn, FullRgn, LBRgn, RGN_OR);

SetWindowRgn(Handle, FullRgn, TRUE);
END;

// EVENTS

procedure TForm_BCTitle.FormCreate(Sender: TObject);
begin
Caption := "";

// Загрузка картинки
BackBMP := TBitmap.Create;
BackBMP.LoadFromResourceName(HInstance, ResMngr.TitleImageResName);

// Габариты экрана
Width := BackBMP.Width;
Height := BackBMP.Height;
CalcRgns;
end;

procedure TForm_BCTitle.FormDestroy(Sender: TObject);
begin
BackBMP.Free;
DeleteObject(FullRgn);
DeleteObject(LTRgn);
DeleteObject(RTRgn);
DeleteObject(RBRgn);
DeleteObject(LBRgn);
end;

procedure TForm_BCTitle.FormPaint(Sender: TObject);
begin
if Assigned(BackBMP) then Canvas.Draw(0,0,BackBMP);
end;

END.


 
Тимохов ©   (2004-06-04 16:54) [2]

что-то не внимательно прочел.
это вообще-то про форму, а не про менью, но межет пригодится:)))


 
имя   (2004-06-04 16:55) [3]

Удалено модератором


 
имя   (2004-06-04 16:59) [4]

Удалено модератором


 
Serge ©   (2004-06-04 16:59) [5]

Скачай компонент XPMenu - в сурсах его найди как реализованна отрисовка меню - пробуй.
Удачи.


 
имя   (2004-06-04 17:02) [6]

Удалено модератором


 
serge ©   (2004-06-04 17:04) [7]

Во понесло парня-то Ж:(


 
имя   (2004-06-04 17:05) [8]

Удалено модератором


 
DVM ©   (2004-06-04 20:51) [9]


> Кто-нибудь создавал меню со скругленными углами?

невозможно на стандартном меню.
Только иммитация из окон или других подручных средств.

> Скачай компонент XPMenu - в сурсах его найди как реализованна
> отрисовка меню - пробуй.
> Удачи.

Отрисовка меню - нечто неподконтрольное обычному прикладному программисту. Под XP не получается по-нормальному нарисовать что-то даже на рамке меню, я уже не говорю о том, чтобы придать ему нужную форму.


 
KilkennyCat ©   (2004-06-05 00:08) [10]

Я подделывал форму под меню - вполне успешно получается.


 
Глеб ©   (2004-06-05 05:31) [11]

Ответ [1] неверен.
Форму со скруглёнными углами нужно делать CreateRoundRectRgn (ИМХО).


 
Iraizor ©   (2004-06-05 05:48) [12]

зачем нужны эти округленные формы ? непойму =)

procedure TForm1.FormCreate(Sender: TObject);
var frgn:hrgn;
begin
frgn:=createellipticrgn(0,0,width,height);
setwindowrgn(handle,frgn,true);
end;



 
Тимохов ©   (2004-06-07 11:30) [13]


> Глеб ©   (05.06.04 05:31) [11]

тогда 4 года я г продаю...



Страницы: 1 вся ветка

Текущий архив: 2004.06.20;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.022 c
14-1085914580
DiamondShark
2004-05-30 14:56
2004.06.20
Посоветуйте программу тестирования ОЗУ


6-1083228771
-+= Evgeney =+-
2004-04-29 12:52
2004.06.20
SQL запрос через Socket


14-1086115649
YurikGL
2004-06-01 22:47
2004.06.20
Сегодня пропала строка статуса в IE


14-1085942124
RealRascal
2004-05-30 22:35
2004.06.20
Наши в Mathcad?


6-1083148113
snake1977
2004-04-28 14:28
2004.06.20
Прослушивание портов