Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.11.20;
Скачать: CL | DM;

Вниз

Цветной TBitmap -> Черно-белый TBitmap   Найти похожие ветки 

 
Evgeniy_K   (2003-11-09 18:12) [0]

У меня есть TBimtap картинка. Как сделать ее монохромной?


 
крот   (2003-11-09 18:53) [1]

Есть такая идея. Цвет каждого пикселя можно представить не только в ргб но и в формате HBS (Heu, Saturation, Brightness). Saturation - Это интенсивность цвета

Далее так:

1. Цвет каждого пикселя перевести в формат HSB
2. Убрать saturation до нуляю
3. Из формата HSB получить цвет и назначить его пикселю.

Вот здесь есть статья про HSB и пример на паскале по переводу
RGB>>HSB и HSB>>RGB

http://www.uni-vologda.ac.ru/students/lav&pan/data/hsv_hsl_hsb_hsi/hsv_hsl_hsb_hsi.html

Я сам не пробовал, надеюсь получиться, удачи.


 
wnew   (2003-11-09 21:51) [2]

PROCEDURE TForm1.RGBToGRay;
TYPE
PixelArray = ARRAY[1..3] OF Byte;
VAR
PPixels : ^PixelArray;
i,u : Integer;
NewColor : Byte;
BEGIN;
WITH Image1.Picture.Bitmap DO
BEGIN;
FOR i:= 0 TO Height-1 DO
BEGIN;
PPixels := Scanline[i];
FOR u:=0 TO width-1 DO
BEGIN;
NewColor := HiByte(PPixels^[1]*76+PPixels^[2]*149+PPixels^[3]*28);
PPixels^[1] := NewColor;
PPixels^[2] := NewColor;
PPixels^[3] := NewColor;
inc(PPixels);
END;
END;
END;
Image1.Refresh;
END;


 
Fenik ©   (2003-11-09 22:20) [3]

procedure GrayBmp(Bitmap: TBitmap);

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

var n: Byte;
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
n := BLimit(Round((rgbtBlue + rgbtGreen + rgbtRed)/3));
rgbtBlue := n;
rgbtGreen := n;
rgbtRed := n;
end;
Inc(Dest);
end;
end;
end;



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

Текущий архив: 2003.11.20;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.029 c
1-65851
ZioN
2003-11-09 22:14
2003.11.20
данные в variant


1-65934
BlackKing
2003-11-11 12:39
2003.11.20
Как определить, есть ли у компонента заданная функция?


3-65738
Verba
2003-10-31 18:24
2003.11.20
Обновление Select


14-66104
VictorT
2003-10-28 22:05
2003.11.20
Ищется рассказ.


14-66073
dvs
2003-10-30 09:30
2003.11.20
безделье