Преобразовать цветную картинку в чёрно белую

[bulldog5293]

Получаю цветную картинку в image, а как её преобразовать в чёрно белую, пробывал так

procedure TForm18.Button1Click(Sender: TObject);
var
 x, y : integer;
 r, g, b : byte;
 c : dword;
begin
  Image1.Picture.LoadFromFile('d:\1.png');
  for y := 0 to Image1.Height-1 do
  begin
    for x := 0 to Image1.Width-1 do
    begin
      c := Image1.Canvas.Pixels[x,y];
      r := GetRValue(c);
      g := GetGValue(c);
      b := GetBValue(c);

      if (r + g + b) div 3 > 128 then
      begin
        Image1.Canvas.Pixels[x,y] := clWhite;
      end
      else
      begin
        Image1.Canvas.Pixels[x,y] := clBlack;
      end;
    end;
  end;
end;

но не тот результат, просто вырезается цвет

[Format C:]

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

То есть:

Color:=Round((R+G+B)/3);

[bulldog5293]

А можно подробней, а то первый раз с таким столкнулся

[asmodey1]

Преобразование RGB в черно-белый рисунок:

function RgbToGray(RGBColor : TColor) : TColor;
var Gray : byte;
begin
Gray:=Round((0.30*GetRValue(RGBColor))+
(0.59*GetGValue(RGBColor))+(0.11*GetBValue(RGBColor)));
Result:=RGB(Gray, Gray, Gray);
end;

procedure TForm1.Go1Click(Sender: TObject);
var i,j: integer;
    c,d: TColor;
begin
Label1.Visible:=True; //текст метки - "Подождите, пожалуйста..."
Application.ProcessMessages;
for i:=Image1.Left to Image1.Left+Image1.Width do
for j:=Image1.Top to +Image1.Top+Image1.Height do
begin
c:=Image1.Picture.Bitmap.Canvas.Pixels[i-Image1.Left,j-Image1.Top];
d:=RgbToGray(c);
Image1.Picture.Bitmap.Canvas.Pixels[i-Image1.Left,j-Image1.Top]:=d;
end;
Label1.Visible:=False;
Application.ProcessMessages;
end;