Преобразовать в оттенки серого и потом в ч/б

Question

Преобразовать в оттенки серого и потом в ч/б

Рейтинг: 0Ответов: 1Опубликовано: 28.04.2023

В Виндовс преобразование в оттенки серого делал по схеме телевизионщиков. Т.е. составляющие перемножал на коэффициенты R0.3+G0.59+B*0.11. (Сумма коэффициентов =1) Попробовал такое применить здесь. Не получаю серого. Ну и скорость преобразования оставляет желать сильно лучшего. Может есть какие то готовые функции? Ну и тогда уж просветите как в ч\б перекинуть изображение?

function ARGB(const A, R, G, B: byte): TAlphaColor;
begin
  Result := B + G SHL 8 + R SHL 16 + A SHL 24;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  X, Y, i, j: Integer;
  Data: TBitmapData;
  bmp: TBitmap;
  color: TAlphaColor;
  R, G, B, A: byte;
  AC: TAlphaColor;
  s: String;
begin
  bmp := TBitmap.Create;
  bmp.Assign(Image1.Bitmap);
  bmp.Canvas.BeginScene;
  bmp.Map(TMapAccess.Write, Data);
  for X := 0 to Image1.Bitmap.Width - 2 do
    for Y := 0 to Image1.Bitmap.Height - 2 do
    begin
      try
        color := Data.GetPixel(X, Y);
        for i := 0 to 3 do
        begin
          s := copy(IntToHex(color, 8), (i * 2) + 1, 2);
          case i of
            0:A :=   StrToInt('$' + s);
            1:R := Round(StrToInt('$' + s) * 0.3 );
            2:G := Round(StrToInt('$' + s) * 0.59);
            3:B := Round(StrToInt('$' + s) * 0.11);
          end;
        end;

       // AC := ARGB(A, R, G, B);
        Data.SetPixel(X, Y, ARGB(A, R, G, B));
        application.ProcessMessages;
        Invalidate;
      finally
      end;
    end;
  Image1.Bitmap.Assign(bmp);
  bmp.Canvas.EndScene;

  bmp.Unmap(Data);
  bmp.Free;
end;

android delphi

Источник: Stack Overflow на русском

Answer 1

▲ 0Принят

У вас логика совсем не такая. Если не обращать внимания на эффективность:

sum := 0;
for i := 0 to 3 do
        begin
          s := copy(IntToHex(color, 8), (i * 2) + 1, 2);
          case i of
            0:A :=   StrToInt('$' + s);
            1: sum := sum + StrToInt('$' + s) * 30;
            2: sum := sum + StrToInt('$' + s) * 59;
            3: sum := sum + (StrToInt('$' + s) * 11;
          end;
        end;
gray := sum div 100;
AC := ARGB(A, gray, gray, gray);

Более эффективное выделение компонентов (проверьте порядок, может быть обратный), цикл не нужен

A := (color shr 24) and $FF;
R := (color shr 16) and $FF;
G := (color shr 8) and $FF;
B := color and $FF;
sum := R * 30 + G * 59 + B * 11;  //Integer
gray := sum div 100;  //Byte
AC := ARGB(A, gray, gray, gray);

Или используйте структуру TAlphaColorRec для доступа к полям

Преобразовать в оттенки серого и потом в ч/б

Ответы