Форум: "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