Преобразование изображения в оттенки серого

// Используется функция преобразования изображения в оттенки серого
 // взятая из UBPFD - <a href="http://delphibase.endimus.com/
" title="http://delphibase.endimus.com/
">http://delphibase.endimus.com/
</a> // автор: Николай Федоровских - mailto: chook_nu@uraltc.ru
 procedure ModColors(Bitmap: TBitmap; Color: TColor);
  function GetR(const Color: TColor): Byte;
  //извлечение красного
  begin
  Result := Lo(Color);
  end;
  function GetG(const Color: TColor): Byte;
  //извлечение зелёного
  begin
  Result := Lo(Color shr 8);
  end;
  function GetB(const Color: TColor): Byte;
  //извлечение синего
  begin
  Result := Lo((Color shr 8) shr 8);
  end;
  function BLimit(B: Integer): Byte;
  begin
  if B < 0 then Result := 0
  else if B > 255 then Result := 255
  else Result := B;
  end;
 type TRGB = record
  B, G, R: Byte;
  end;
  pRGB = ^TRGB;
 var r1, g1, b1: Byte;
  x, y: Integer;
  Dest: pRGB;
  A: Double;
 begin
  Bitmap.PixelFormat := pf24Bit;
  r1 := Round(255 / 100 * GetR(Color));
  g1 := Round(255 / 100 * GetG(Color));
  b1 := Round(255 / 100 * GetB(Color));
  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
  A := (r + b + g) / 300;
  with Dest^ do begin
  R := BLimit(Round(r1 * A));
  G := BLimit(Round(g1 * A));
  B := BLimit(Round(b1 * A));
  // Небольшая поправка к оригинальной функции
  if (R=255) and (G=255) and (B=255) then begin
  R:= 216;
  G:= 212;
  B:= 240;
  end;
  end;
  end;
  Inc(Dest);
  end;
  end;
 end;

пример использования:

ModColors(BitMap, RGB(150,150,150));

Взято из http://forum.sources.ru

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...