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

Вниз

Затемнение   Найти похожие ветки 

 
Грибовод   (2003-11-09 10:57) [0]

Здраствуйте.
Может глупый вопрос: нужно преобразовать цвет в немного более тёмный (выделение).Как быть?


 
MBo   (2003-11-09 11:28) [1]

извлечь из цвета составляющие (GetRValue etc), уменьшить их, свести в TColor (функция RGB)


 
Грибовод   (2003-11-09 11:55) [2]

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


 
MBo   (2003-11-09 12:12) [3]

покажи код, дающий белиберду


 
Грибовод   (2003-11-09 12:24) [4]

Вычесть:

{M-min
Dark-коэф.затемнения}
R:=Color and $ff;
G:=Color and $ff00;
B:=Color and $ff0000;
if (R>G)and(R>B)then M:=R;
if (G>R)and(G>B)then M:=G;
if (B>R)and(B>G)then M:=B;
R:=R-trunc(M/Dark);
G:=G-trunc(M/Dark);
B:=B-trunc(M/Dark);
Result:=r+(G shl 8)+(B shl 16);


Делить:

R:=Round((Color and $ff)/dark);
G:=Round((Color and $ff00)/dark);
B:=Round((Color and $ff0000)/dark);
Result:=r+(G shl 8)+(B shl 16);


 
MBo   (2003-11-09 12:30) [5]

ты неправильно выделял составляющие - после маски AND их надо сдвигать SHR (8 и 16 - в сведении же правильно сделано) или воспользоваться вышеуказанными функциями-макросами Get*Value
Да и это странно как-то - R:=R-trunc(M/Dark);


 
Грибовод   (2003-11-09 13:50) [6]

Точно.Спасибо.


 
Fenik   (2003-11-09 15:53) [7]

Вот, пожалуйста:

function ColorLightness(Color: TColor; Value: Integer): TColor;

function BLimit(A: Integer): Byte;
begin
if A < 0 then Result := 0
else
if A > 255 then Result := 255
else Result := A;
end;

begin
Result := BLimit(Lo((Color shr 8) shr 8) + Value) shl 16 or
BLimit(Lo(Color shr 8) + Value) shl 8 or
BLimit(Lo(Color) + Value);
end;


Все просто. Затемнение будет при отрицательном Value, засветление - при положительном.
Но у меня есть подозрение, что вы, Грибовод, хотите использовать Canvas.Pixels. Так ли это? Если так, то выбросте это из головы.
Предлагаю сравнить скорость работы следующих процедур, делающих одно и то же: затемнение или засветление изображения.

1. С использованием нужной вам функции и Canvas.Pixels:

procedure BitmapLightness(Bitmap: TBitmap; Value: Integer);

function ColorLightness(Color: TColor; Value: Integer): TColor;
function BLimit(A: Integer): Byte;
begin
if A < 0 then Result := 0
else
if A > 255 then Result := 255
else Result := A;
end;
begin
Result := BLimit(Lo((Color shr 8) shr 8) + Value) shl 16 or
BLimit(Lo(Color shr 8) + Value) shl 8 or
BLimit(Lo(Color) + Value);
end;

var x, y: Integer;
begin
for y := 0 to Bitmap.Height - 1 do begin
for x := 0 to Bitmap.Width - 1 do begin
with Bitmap.Canvas do
Pixels[x, y] := ColorLightness(Pixels[x, y], Value);
end;
end;
end;


2. С использованием ScanLine

procedure BitmapLightness(Bitmap: TBitmap; Value: Integer);

function BLimit(A: Integer): Byte;
begin
if A < 0 then Result := 0
else if A > 255 then Result := 255
else Result := A;
end;

var x, y: Integer;
Dest: pRGBTriple;
begin
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
Dest := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do begin
with Dest^ do begin
rgbtBlue := BLimit(rgbtBlue + Value);
rgbtGreen := BLimit(rgbtGreen + Value);
rgbtRed := BLimit(rgbtRed + Value);
end;
Inc(Dest);
end;
end;
end;


Вторая работает во много раз быстрее.
Делайте выводы.



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

Форум: "Media";
Текущий архив: 2004.03.09;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.009 c
14-25853
Petr V. Abramov
2004-02-14 21:41
2004.03.09
Soft Must Be Free!


14-25923
Cardinal
2004-02-14 15:19
2004.03.09
UPX Shell с ее защитой от декомпрессии


14-25927
barby
2004-02-09 12:36
2004.03.09
---|Ветка была без названия|---


6-25842
csr
2003-12-31 11:10
2004.03.09
TidSMTP и результат его работы!


14-25903
Alex Konshin
2004-02-16 09:19
2004.03.09
Атака клонов





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