Замена всех цветов на оттенки одного
01.01.2007
{ **** UBPFD *********** by delphibase.endimus.com **** >> Замена всех цветов на оттенки одного Зависимости: Graphics Автор: Fenik, chook_nu@uraltc.ru, Новоуральск Copyright: Собственное написание (Николай федоровских) Дата: 1 июня 2002 г. ***************************************************** } 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)); end; end; Inc(Dest); end; end; end; Пример использования: ModColors(FBitmap, RGB(218, 219, 230));