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

Вниз

Цвет формы в виде градиента не получается сделать ?   Найти похожие ветки 

 
AlexeyRov   (2003-02-26 16:29) [0]

Уважаемые Мастера Delphi ! Очень хочется сделать, чтобы форма имела заливку в виде градиента: т. е. плавно переходил цвет из одного в другой!!
Нашел я программку на VB и "перевел" в Delphi, но наверное перевел криво: компилится, но вызывает ошибку kernell32.dll. Мож кто подскажет что тут не так? Или это можно сделать как-то по-другому?
Текст следующий:

Type
TRIVERTEX= record
x :Longint;
y :Longint;
Red :Integer; //Ushort value
Green :Integer; //Ushort value
Blue :Integer; //ushort value
Alpha :Integer; //ushort
end;

Type GRADIENT_RECT=record
UpperLeft : Longint; //In reality this is a UNSIGNED Long
LowerRight: Longint; //In reality this is a UNSIGNED Long
end;

Const
GRADIENT_FILL_RECT_H : Longint = $0; //In this mode, two endpoints describe a rectangle. The rectangle is
GRADIENT_FILL_RECT_V : Longint = $1; //In this mode, two endpoints describe a rectangle. The rectangle
GRADIENT_FILL_TRIANGLE : Longint = $2; //In this mode, an array of TRIVERTEX structures is passed to GDI
GRADIENT_FILL_OP_FLAG : Longint = $FF;

VAR Vert : array[0..1] of TRIVERTEX;
gRect : GRADIENT_RECT;

Function GradientFillRect(hdc: Longint; pVertex: TRIVERTEX;
dwNumVertex :Longint; pMesh :GRADIENT_RECT; dwNumMesh :Longint; dwMode :Longint):Longint ;
external "msimg32.dll" name "GradientFill";


Function LongToUShort(Unsigned : Longint) : Integer;
begin
//A small function to convert from long to unsigned short
LongToUShort := Integer(Unsigned - $FF10000)
End;

procedure TForm1.FormPaint(Sender: TObject);
begin
//из черного
vert[0].x:=0;
vert[0].y:=0;
vert[0].Red:=0;
vert[0].Green:=0;
vert[0].Blue:=0;
vert[0].Alpha:=0;

// в синий
vert[1].x:=form1.Width;
vert[1].y:=form1.Height;
vert[1].Red:=0;
vert[1].Green:=0;
vert[1].Blue:=LongToUShort($FF00);
vert[1].Alpha:=0;

grect.UpperLeft:=0;
gRect.LowerRight:=1;

GradientFillRect(GetDC(form1.Handle), vert[0], 2, gRect, 1, GRADIENT_FILL_RECT_H);
end;

Заранее спасибо !


 
Игорь Шевченко ©   (2003-02-26 16:51) [1]

type
THSTriVertex = packed record
x : LongInt;
y : LongInt;
Red : Word;
Green : Word;
Blue : Word;
Alpha : Word;
end;


 
AlexeyRov   (2003-02-26 17:23) [2]

> Игорь Шевченко © (26.02.03 16:51)

Поменял как Вы написали, но ошибка та же...
Возможно, собака зарыта здесь:
VAR Vert : array[0..1] of THSTriVertex;

И в GradientFillRect(GetDC(form1.Handle), vert[0], 2, gRect, 1, GRADIENT_FILL_RECT_H);
... а как же тогда быть с vert[1] ?
Но в VB передавалось именно vert[0] как Вы думаете?


 
AlexeyRov   (2003-02-26 17:39) [3]

Кстати если описать
VAR Vert : array[0..1] of THSTriVertex;
gRect : GRADIENT_RECT;

не глобально, а в методе FormPant, то ошибка
вылетает другая - AV in module msimg32.dll ...


 
Игорь Шевченко ©   (2003-02-26 17:40) [4]

Function GradientFillRect(hdc: Longint; pVertex: TRIVERTEX;
dwNumVertex :Longint; pMesh :GRADIENT_RECT; dwNumMesh :Longint; dwMode :Longint):Longint ; stdcall


 
icWasya ©   (2003-02-26 17:41) [5]

может так ??
var
DC: HDC;
....
DC := GetDC(form1.Handle);
try
GradientFillRect(DC, vert[0], 2, gRect, 1, GRADIENT_FILL_RECT_H);

finally
ReleaseDC(form1.Handle, DC);
end


 
AlexeyRov   (2003-02-26 23:36) [6]

>> Игорь Шевченко © (26.02.03 17:40)
Добавил StdCall но ошибка все равно осталась...

>>icWasya © (26.02.03 17:41)

Сделал замену, вставил try finally Ошибка вроде бы исчезла, но форма не меняет свой цвет... :((

Ребят, может еще чего посоветуете, уж больно хочется сделать красивую форму. ПлиииииЗ!


 
AlexeyRov   (2003-02-26 23:36) [7]

>> Игорь Шевченко © (26.02.03 17:40)
Добавил StdCall но ошибка все равно осталась...

>>icWasya © (26.02.03 17:41)

Сделал замену, вставил try finally Ошибка вроде бы исчезла, но форма не меняет свой цвет... :((

Ребят, может еще чего посоветуете, уж больно хочется сделать красивую форму. ПлиииииЗ!


 
MBo ©   (2003-02-27 09:02) [8]


type
TRIVERTEXNew = packed record
X,Y:Integer;
R,G,B,Alpha: Word;
end;

procedure TForm1.Button1Click(Sender: TObject);
var v:array [0..1] of TrivertexNew;
m:array[0..1] of integer;
begin
FillChar(v,SizeOf(TriVertexNew)*2,0);
v[1].x:= 100;
v[1].y:= 100;
v[1].B:= $FFFF;
v[0].R:=$FFFF;
v[0].G:=$FFFF;
m[0]:=0;
m[1]:=1;
Gradientfill(image1.canvas.handle,PTriVertex(@v)^, 2,@m, 1,Gradient_Fill_Rect_H);
end;


Это все. Реимпортировать при таком обращении не надо.


 
AlexeyRov   (2003-02-27 10:00) [9]

> MBo © (27.02.03 09:02)
:) Спасибо огромное - всё заработало !!!



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

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

Наверх




Память: 0.49 MB
Время: 0.02 c
1-76908
Brand2000
2003-04-15 01:48
2003.04.24
Смена разрешения экрана не отображает панель задач


14-77167
Frist_May
2003-04-08 17:14
2003.04.24
Сервис


14-77156
Vlad Oshin
2003-04-07 08:54
2003.04.24
Supreme 2 посвящается. Таки и всколыхнул старое...


14-77105
[NIKEL]
2003-04-05 11:02
2003.04.24
Кто что знает про фирму BSS Systems?


4-77216
afalic
2003-02-26 13:49
2003.04.24
Сетевые сообщения