ANTICHAT — форум по информационной безопасности, OSINT и технологиям
ANTICHAT — русскоязычное сообщество по безопасности, OSINT и программированию.
Форум ранее работал на доменах antichat.ru, antichat.com и antichat.club,
и теперь снова доступен на новом адресе —
forum.antichat.xyz.
Форум восстановлен и продолжает развитие: доступны архивные темы, добавляются новые обсуждения и материалы.
⚠️ Старые аккаунты восстановить невозможно — необходимо зарегистрироваться заново.
 |
Формы причудливых форм Delphi |

02.12.2009, 19:44
|
|
Banned
Регистрация: 03.11.2009
Сообщений: 112
Провел на форуме: 98006
Репутация:
17
|
|
Формы причудливых форм Delphi
Давайте тут выкладывать регионы для рисования интересных форм???
вот например, бабочка
Код:
procedure TForm1.FormCreate(Sender: TObject);
var
R1, R2 : HRgn;
P : array [0..2] of TPoint;
X : Word;
begin
// левое верхнее крыло
R1 :=CreateEllipticRgn(Round(-Width*0.4),
0,Round(Width*0.49),Round(Height*1.1));
// правое верхнее крыло
R2 :=CreateEllipticRgn(Round(Width*0.51),
0,Round(Width*1.4),Round(Height*1.1));
CombineRgn(R2,R1,R2,RGN_OR);
// отсекаем лишнее от верхних крыльев,
// остаются линзы на пересечении эллипсов
R1 :=CreateEllipticRgn(0,Round(-Height*0.3),
Width,Round(Height*0.71));
CombineRgn(R1,R1,R2,RGN_AND);
//эллипс - основа нижних крыльев
R2 :=CreateEllipticRgn(Round(Width*0.1),
Round(Height*0.65), Round(Width*0.9), Height);
CombineRgn(R1,R1,R2,RGN_OR);
// вырезаем эллипс - разрез между нижних крыльев
R2 :=CreateEllipticRgn(Round(Width*0.3),
Round(Height*0.7), Round(Width*0.7), Round(Height*1.5));
CombineRgn(R1,R1,R2,RGN_DIFF);
// вертикальный эллипс - туловище бабочки
R2 :=CreateEllipticRgn(Round(Width*0.46),
Round(Height*0.3), Round(Width*0.54),
Round(Height*0.8));
CombineRgn(R1,R1,R2,RGN_OR);
// голова - круг; за основу берем меньшую
// из двух величин - высоты и ширины окна
X := Width;
if Height < X then X := Height;
X := Round(X/18);
R2 :=CreateEllipticRgn(Round(Width*0.5)-X,
Round(Height*0.3)-X, Round(Width*0.5)+X,
Round(Height*0.3)+X);
CombineRgn(R1,R1,R2,RGN_OR);
// левый усик
P[0] := Point(Round(Width*0.5), Round(Height*0.3));
P[1] := Point(Round(Width*0.35), Round(Height*0.01));
P[2] := Point(Round(Width*0.355)+1, 0);
R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);
// правый усик
P[0] := Point(Round(Width*0.5), Round(Height*0.3));
P[1] := Point(Round(Width*0.655+1), Round(Height*0.01));
P[2] := Point(Round(Width*0.65), 0);
R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);
// острие на крыле слева снизу
P[0] := Point(Round(Width*0.15), Height);
P[1] := Point(Round(Width*0.2), Round(Height*0.8));
P[2] := Point(Round(Width*0.3), Round(Height*0.9));
R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);
// острие на крыле справа снизу
P[0] := Point(Round(Width*0.85), Height);
P[1] := Point(Round(Width*0.8), Round(Height*0.8));
P[2] := Point(Round(Width*0.7), Round(Height*0.9));
R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);
// Назначаем полученный регион форме
SetWindowRgn(Handle, R1, True);
end;
кто может нарисовать бутылку???
Последний раз редактировалось slesh; 03.12.2009 в 11:00..
Причина: [code][/code]
|
|
|

02.12.2009, 20:28
|
|
Познавший АНТИЧАТ
Регистрация: 30.04.2007
Сообщений: 1,206
Провел на форуме: 4778940
Репутация:
1257
|
|
А не проще далеть форму=форме какой-либо картинки(гугл ит)? Зачем такие извращения?
|
|
|

02.12.2009, 20:58
|
|
Познавший АНТИЧАТ
Регистрация: 01.12.2006
Сообщений: 1,769
Провел на форуме: 3718311
Репутация:
1118
|
|
2mr.The
Дык. Имтереснее из Мозга фрэш делать =)
Мне вот раскажите как в NET с регионами работать =(
|
|
|

02.12.2009, 21:14
|
|
Banned
Регистрация: 03.11.2009
Сообщений: 112
Провел на форуме: 98006
Репутация:
17
|
|
Сообщение от mr.The
А не проще далеть форму=форме какой-либо картинки(гугл ит)? Зачем такие извращения?
ну вот так любой дурак может...
Код:
function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do
for Y := 0 to Height - 1 do
begin
X := 0;
while X < Width do
begin
while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;
while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);
if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result,
CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end;
end;
end;
Последний раз редактировалось slesh; 03.12.2009 в 11:01..
Причина: [code][/code]
|
|
|

02.12.2009, 21:28
|
|
Познавший АНТИЧАТ
Регистрация: 30.04.2007
Сообщений: 1,206
Провел на форуме: 4778940
Репутация:
1257
|
|
Ну дык зачем ещё что-то? Давайте ещё фракталы в формах строить, чего уж там.
|
|
|
|
 |
Похожие темы
|
| Тема |
Автор |
Раздел |
Ответов |
Последнее сообщение |
|
Литература Delphi
|
Sams |
С/С++, C#, Delphi, .NET, Asm |
2 |
19.03.2010 19:46 |
|
Скачать Delphi 7, помощь.
|
_casper_ |
С/С++, C#, Delphi, .NET, Asm |
20 |
08.12.2009 04:54 |
|
Books
|
PSalm69 |
Избранное |
248 |
27.10.2009 04:52 |
|
Virus.Win32.Induc.a – новый вирус для Delphi
|
ErrorNeo |
Уязвимости |
37 |
26.08.2009 00:33 |
|
Virus.Win32.Induc.a или "Снова записки новичка"
|
_=(mac)=_ |
Защита ОС: вирусы, антивирусы, файрволы. |
5 |
24.08.2009 23:34 |
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|