Программирование Delphi

В следующем примере будем преобразовывать изображение на Canvas в градации серого.

procedure GrauStufen(C:TCanvas);
var x, y: integer;
   Color: LongInt;
   R, G, B, Gr: Byte;
begin
   with C do begin
     for x:= ClipRect.Left to ClipRect.Right do
       for y:= ClipRect.Top to ClipRect.bottom do
       begin
         Color:=ColorToRGB(Pixels[x,Y]);

         R := GetRValue(Color);
         G := GetGValue(Color);
         B := GetBValue(Color);

         Gr:= Trunc(B*0.11+G*0.59+R*0.3);
         Pixels[x,Y] := RGB(Gr, Gr, Gr);
       end;
   end;
end;

В следующем примере код работает гораздо быстрее. Разработано Robert Schiebel:

type
   TPixelBMP24 = packed record
     R: byte;
     G: byte;
     B: byte;
end;

var
   SrcBMP, DstBMP24: TBitmap;

procedure TForm1.FormCreate(sender: TObject);
begin
   SrcBMP:=TBitmap.Create;  {Src Bitmap erstellen}
   SrcBMP.LoadFromFile('datei'); //sollte 24Bit sein

   DstBMP24:=TBitmap.Create;  {24-Bit Dst Bitmap erstellen}
   DstBMP24.PixelFormat:=pf24bit;
   DstBMP24.Width:=SrcBmp.Width;
   DstBMP24.Height:=SrcBmp.Height;
end;

function BMPRGBtoYUV(rgb: TPixelBMP24): TPixelBMP24;
var y,u,v:longint;
begin
   y := rgb.G*150 + rgb.B*29 + rgb.R*77; // 0.587 x 256, 0.114 x 256, 0.299 x 256
   u := (rgb.B shl 8 - y) * 144;         // 0.564 x 256
   v := (rgb.R shl 8 - y) * 183;         // 0,713 x 256
   Result.G :=y shr 8;
   Result.B :=u shr 16 + $80;
   Result.R :=v shr 16 + $80;
end;

function BMPYUVtoRGB(yuv: TPixelBMP24): TPixelBMP24;
var temp: integer;
begin
   temp := yuv.G + (yuv.B - $80) * 256 div 144  ;
   if temp > 0 then Result.B:=temp else Result.B:=0;
   if temp > 255 then Result.B:=255;

   temp := yuv.G + (yuv.R - $80) * 256 div 183  ;
   if temp > 0 then Result.R:=temp else Result.R:=0;
   if temp > 255 then Result.R:=255;

   temp := (yuv.G shl 8 - Result.B*29 - Result.R*77) div 150;
   if temp > 0 then Result.G:=temp else Result.G:=0;
   if temp > 255 then Result.G:=255;
end;

procedure TForm1.Button4Click(Sender: TObject);
var x, y: integer;
   SrcPixel: ^TPixelBMP24;
   DstPixel: ^TPixelBMP24;
   yuv: TPixelBMP24;
begin
   for y:=0 to SrcBMP.Height-1 do   // SrcBMP и DstBMP24 равны!!!
   begin
     SrcPixel:=SrcBMP.ScanLine[y];
     DstPixel:=DstBMP24.ScanLine[y];
     for x:=0 to SrcBMP.Width-1 do
     begin
       yuv:=BMPRGBtoYUV(SrcPixel^);
       yuv.R:=$80;
       yuv.B:=$80;
       DstPixel^ := BMPYUVtoRGB(yuv);
       inc(SrcPixel);
       inc(DstPixel);
     end;
   end;

   Image1.Picture.Graphic:=DstBMP24;
end;