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

Вниз

О том, как превратить один цвет в другой…   Найти похожие ветки 

 
New_256   (2003-02-21 03:03) [0]

Поясню. Дан один цвет (например: черный), дан другой цвет (например: синий).
clBlack & clBlue собственно.
Нужно на канве формы, программно, нарисовать градиентную заливку, т. е. черный цвет плавно переходит в синий.
Проблема в общем такая.
Помогите чем можете, пожалуйста.


 
MBo   (2003-02-21 07:09) [1]

в данном случае начальный цвет $00000, а конечный $FF0000, т.е. нужно в цикле к начальному цвету добавлять по $010000.
В общем случае придется разложить цвета на составляющие RGB, и делать интерполяцию по каждой сост.


 
Palladin   (2003-02-21 07:44) [2]

тупая процедура для создания градиента от одного цвета к другому с заданым шагом
ногами не пинать, ибо писал для себя... а человек сам никак...

function GetSubStr(sStr:string;sSep:char;n:integer):string;
var
i:integer;
begin
result:="";
for i:=1 to n-1 do sStr:=copy(sStr,pos(sSep,sStr)+1,length(sStr));
if pos(sSep,sStr)<>0 then result:=copy(sStr,1,pos(sSep,sStr)-1)
else result:=sStr;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i,
s:integer;
r2,g2,b2,
r1,g1,b1:byte;
rs,gs,bs:real;
begin
r1:=strtoint(GetSubStr(edit1.text,".",1));
g1:=strtoint(GetSubStr(edit1.text,".",2));
b1:=strtoint(GetSubStr(edit1.text,".",3));
r2:=strtoint(GetSubStr(edit2.text,".",1));
g2:=strtoint(GetSubStr(edit2.text,".",2));
b2:=strtoint(GetSubStr(edit2.text,".",3));
s:=strtoint(edit3.text);
rs:=(r2-r1)/s;
gs:=(g2-g1)/s;
bs:=(b2-b1)/s;
Memo1.Clear;
for i:=0 to s do
Memo1.Lines.add(inttostr(round(r1+rs*i))+"."+inttostr(round(g1+gs*i))+"."+inttostr(round(b1+bs*i)));
end;


Edit1 - начальный цвет
Edit2 - конечный цвет
Edit3 - количество шагов
цвет в виде r.g.b
все атрибуты в цифрах 0-255


 
REA   (2003-02-21 10:06) [3]

Дык эта: GradientFill
Или я что-то путаю?


 
New_256   (2003-02-21 14:12) [4]


> Palladin © (21.02.03 07:44)

Пасибо, будет время посмотрю...


 
[lamer]Barmaglot   (2003-02-21 15:14) [5]

Насколько я помню (Где-то читал), GradientFill неправильно отдает ресурсы... Так что помоему лучше писать свою процедуру.

Для интересующихся этим вопросом, вот какой ответ дали мне МАСТЕРА.
[quote]
Описание есть в MSDN, даже с примером.

ОДНАКО!!!!
Структура TTriVertex содержит поля типа Сolor16, а в Windows.pas
этот тип почему-то описан как ShortInt - очевидно, баг позорный.

Придется делать так:
1) Переопределяем тип:
type
TRIVERTEXNew = packed record
X:Integer;
Y:Integer;
R,G,B,Alpha: SmallInt;
end;
2) переимпортируем функцию

function GradientFill(DC:hDC; pVertex : Pointer; dwNumVertex : DWORD;
pMesh : Pointer; dwNumMesh, dwMode: DWORD) : DWord; stdcall;
external "msimg32.dll";


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:= $7FFF;
v[0].R:=$7FFF;
v[0].G:=$7FFF;
m[0]:=0;
m[1]:=1;
Gradientfill(image1.canvas.handle,@v,2,@m,1,Gradient_Fill_Rect_H);
end;

[/quote]


 
MBo   (2003-02-21 15:26) [6]

в той ветке был и второй мой постинг, позволяющий избавиться от реимпорта функции, и с более корректным объявлением TRIVERTEXNew

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;


 
LongIsland   (2003-02-21 15:37) [7]

А что... простое определение разницы между цветами по R, G, B значениям и MulDiv уже не устраивают?


 
New_256   (2003-02-21 18:02) [8]

Мы далеко зашли…
На самом деле мне надо другое, не заливка…
Надо конкретно в цикле преобразовывать один цвет в другой, и ничего больше.
Что-то в этом роде:

procedure TForm1.Button1Click(Sender: TObject);
var
Clr,
x,y: Integer;
begin
Clr := 0;
for x:=0 to 250 do
begin
Inc(Clr,1);
for y:=100 to 150 do
Form1.Canvas.Pixels[x+100,y] := Clr;
end;
end;


В этом случае постепенно выйдет из черного цвета – красный, а как сделать с другими цветами, допустим они записаны в переменные типа Integer;

Мне надо что-то вроде такого способа, просто вместо Form1.Canvas.Pixels[x+100,y] := Clr;
будет другой код, это для примера.
Заранее благодарен.


 
New_256   (2003-02-21 19:00) [9]

Помогите, пожалуйста!


 
New_256   (2003-02-21 20:59) [10]

Что, никто не знает?


 
Alex44   (2003-02-21 21:13) [11]


// To blend two RGB colors (roughly,
// (P*Clrl + (Factor - P)*Clr2)/Factor)
// No check is done
// If colors are not RGB, use ColorToRGB first

const Factor = 256;

function BlendColors(Clr1, Clr2: TColor; P: Integer): TColor;
type TColorBytes = packed array[0..3] of Byte;
var I: Integer;
begin
Result := 0;
for I := 0 to 3 do
TColorBytes(Result)[I] :=
(P*TColorBytes(Clr1)[I] +
(Factor - P)*TColorBytes(Clr2)[I]) div Factor;
end;


 
New_256   (2003-02-21 21:22) [12]


> Alex44 (21.02.03 21:13)

Спасибо.


 
paul_shmakov   (2003-02-22 15:13) [13]

на самом деле лучше генерировать градиентную палитру. и этой палитрой закрашивать. тогда ваш градиент будет нормально смотреться и в 256-ти цветах.


 
TButton   (2003-02-22 20:07) [14]


procedure Gradient(c1,c2: TColor; n:integer);
var
r,g,b:real;
gr,gg,gb:byte;
c:TColor;
i:integer;
begin
r:=(getRValue(c1)-getRValue(c2))/n; //шаги градиента
g:=(getGValue(c1)-getGValue(c2))/n;
b:=(getBValue(c1)-getBValue(c2))/n;
for i:=0 to n do
begin
gr:=Round(getRValue(c1)+i*r);
gg:=Round(getGValue(c1)+i*g);
gb:=Round(getBValue(c1)+i*b);
c:=RGB(gr,gg,gb);
//рисуй с на канве
end;
end;



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

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

Наверх





Память: 0.6 MB
Время: 0.045 c
3-16976
mate
2003-02-16 17:13
2003.03.06
ADO и Базы Данных.


1-17043
Wizzard
2003-02-25 12:44
2003.03.06
Конвертация чисел в разных нац.версиях Виндовса


14-17285
Vitus
2003-02-19 10:48
2003.03.06
Как проверить есть ли подключение к Инету?


3-16866
JibSkeart
2003-02-03 16:32
2003.03.06
Отправить данные сторонней программе из


9-16849
officeman
2002-10-03 12:35
2003.03.06
2D ДВИЖКИ! построение игрового мира





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский