Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.06.26;
Скачать: [xml.tar.bz2];

Вниз

Плавный переход цвета из одного в другой   Найти похожие ветки 

 
McSimm2   (2003-06-11 10:33) [0]

Как осуществить сабж?


 
Юрий Федоров   (2003-06-11 10:51) [1]

Нашел вот такую функцию, она не моя, так что чур не ругаться :-)

procedure GradFill(xC: tCanvas; xR: tRect; Clr1, Clr2: TColor; xVert: boolean);
var
RGBFrom: array[0..2] of Byte; { from RGB values }
RGBDiff: array[0..2] of integer; { difference of from/to RGB values }
ColorBand: TRect; { color band rectangular coordinates }
I: Integer; { color band index }
R: Byte; { a color band"s R value }
G: Byte; { a color band"s G value }
B: Byte; { a color band"s B value }
begin
{ extract from RGB values}
RGBFrom[0] := GetRValue(ColorToRGB(Clr1));
RGBFrom[1] := GetGValue(ColorToRGB(Clr1));
RGBFrom[2] := GetBValue(ColorToRGB(Clr1));
{ calculate difference of from and to RGB values}
RGBDiff[0] := GetRValue(ColorToRGB(Clr2)) - RGBFrom[0];
RGBDiff[1] := GetGValue(ColorToRGB(Clr2)) - RGBFrom[1];
RGBDiff[2] := GetBValue(ColorToRGB(Clr2)) - RGBFrom[2];
{ set pen sytle and mode}
xC.Pen.Style:= psSolid;
xC.Pen.Mode:= pmCopy;
{ set color band"s left and right coordinates}
if xVert
then begin
ColorBand.Left:= xR.Left;
ColorBand.Right:= xR.Right;
end
else begin
ColorBand.top:= xR.top;
ColorBand.bottom:= xR.bottom;
end;
for I := 0 to $ff do
begin
{ calculate color band"s top and bottom coordinates}
if xVert
then begin
ColorBand.Top:=xR.top+ MulDiv (I, xR.bottom-xR.top, $100);
ColorBand.Bottom:=xR.top+ MulDiv (I + 1, xR.bottom-xR.top, $100);
end
else begin
ColorBand.left:=xR.left+ MulDiv (I, xR.right-xR.left, $100);
ColorBand.right:=xR.left+ MulDiv (I + 1, xR.right-xR.left, $100);
end;

{ calculate color band color}
R := RGBFrom[0] + MulDiv(I, RGBDiff[0], $ff);
G := RGBFrom[1] + MulDiv(I, RGBDiff[1], $ff);
B := RGBFrom[2] + MulDiv(I, RGBDiff[2], $ff);
{ select brush and paint color band}
xC.Brush.Color := RGB(R, G, B);
xC.FillRect(ColorBand);
{ xC.pen.Color := RGB(R, G, B);
if xVert
then with ColorBand do for j:=top to bottom do begin xC.MoveTo(left,j); xC.LineTo(right,j) end
else with ColorBand do for j:=left to right do begin xC.MoveTo(j,top); xC.LineTo(j,bottom) end;}
end;
end; { GradFill }
{***************************************************************************}


 
Dimka Maslov   (2003-06-11 10:54) [2]

http://delphibase.endimus.com/?action=viewfunc&topic=mediaimg&id=10438


 
McSimm2   (2003-06-11 13:08) [3]

Спасибо огромное...
А как выцепить из системных настроек винды 2 цвета перехода ??


 
Dimka Maslov   (2003-06-11 13:42) [4]

http://delphibase.endimus.com/?action=viewfunc&topic=sysparams&id=10008



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

Форум: "Основная";
Текущий архив: 2003.06.26;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.025 c
8-84456
Zakus
2003-01-14 17:12
2003.06.26
TImage - Чтобы не мелькал


3-83998
off
2003-05-27 06:43
2003.06.26
Считаем баланс?


14-84664
sapsi
2003-06-10 09:17
2003.06.26
Где вы отдыхаете (туристические туры)?


3-83894
DreamDesire
2003-06-03 10:32
2003.06.26
Master-Details в TClientDataSet: касадное удаление


6-84494
sapsi
2003-04-22 10:26
2003.06.26
NMSMTP





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский