procedure GrayScale(PICT: TPicture);
const
MaxPixelCount = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..MaxPixelCount-1] of TRGBTriple;
var
i, j, Colr : Integer;
sl : pRGBArray; bmp : TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf24bit;
bmp.Width := PICT.Graphic.Width;
bmp.Height := PICT.Graphic.Height;
bmp.Canvas.Draw(0,0,PICT.Graphic);
if bmp.PixelFormat <> pf24bit then begin
Exit;
end;
for j:=0 to bmp.Height-1 do begin
sl := bmp.ScanLine[j];
for i:=0 to bmp.Width-1 do begin
Colr:=HiByte(sl[i].rgbtRed * 77 + sl[i].rgbtGreen * 151 +
sl[i].rgbtBlue * 28);
sl[i].rgbtRed := Colr;
sl[i].rgbtGreen := Colr;
sl[i].rgbtBlue := Colr;
end;
end;
PICT.Assign(bmp);
finally
bmp.Free;
end;
end;