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

← →
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]

← →
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]

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