首页  编辑  

一个位图黑白化效果代码

Tags: /超级猛料/Picture.图形图像编程/图形处理算法/   Date Created:

一个位图黑白化效果代码

type

 TRGBTripleArray = array[0..10000] of TRGBTriple;

 PRGBTripleArray = ^TRGBTripleArray;

 T3x3FloatArray = array[0..2] of array[0..2] of Extended;

function Convolve(ABitmap: TBitmap; AMask: T3x3FloatArray;

 ABias: Integer): TBitmap;

var

 LRow1, LRow2, LRow3, LRowOut: PRGBTripleArray;

 LRow, LCol: integer;

 LNewBlue, LNewGreen, LNewRed: Extended;

 LCoef: Extended;

begin

 LCoef := 0;

 for LRow := 0 to 2 do

   for LCol := 0 to 2 do

     LCoef := LCoef + AMask[LCol, LRow];

 if LCoef = 0 then LCoef := 1;

 Result := TBitmap.Create;

 Result.Width := ABitmap.Width - 2;

 Result.Height := ABitmap.Height - 2;

 Result.PixelFormat := pf24bit;

 LRow2 := ABitmap.ScanLine[0];

 LRow3 := ABitmap.ScanLine[1];

 for LRow := 1 to ABitmap.Height - 2 do  

 begin

   LRow1 := LRow2;

   LRow2 := LRow3;

   LRow3 := ABitmap.ScanLine[LRow + 1];

   LRowOut := Result.ScanLine[LRow - 1];

   for LCol := 1 to ABitmap.Width - 2 do  

   begin

     LNewBlue :=

       (LRow1[LCol - 1].rgbtBlue * AMask[0,0]) + (LRow1[LCol].rgbtBlue * AMask[1,0]) +

       (LRow1[LCol + 1].rgbtBlue * AMask[2,0]) +

       (LRow2[LCol - 1].rgbtBlue * AMask[0,1]) + (LRow2[LCol].rgbtBlue * AMask[1,1]) +

       (LRow2[LCol + 1].rgbtBlue * AMask[2,1]) +

       (LRow3[LCol - 1].rgbtBlue * AMask[0,2]) + (LRow3[LCol].rgbtBlue * AMask[1,2]) +

       (LRow3[LCol + 1].rgbtBlue * AMask[2,2]);

     LNewBlue := (LNewBlue / LCoef) + ABias;

     if LNewBlue > 255 then

       LNewBlue := 255;

     if LNewBlue < 0 then

       LNewBlue := 0;

     LNewGreen :=

       (LRow1[LCol - 1].rgbtGreen * AMask[0,0]) + (LRow1[LCol].rgbtGreen * AMask[1,0]) +

       (LRow1[LCol + 1].rgbtGreen * AMask[2,0]) +

       (LRow2[LCol - 1].rgbtGreen * AMask[0,1]) + (LRow2[LCol].rgbtGreen * AMask[1,1]) +

       (LRow2[LCol + 1].rgbtGreen * AMask[2,1]) +

       (LRow3[LCol - 1].rgbtGreen * AMask[0,2]) + (LRow3[LCol].rgbtGreen * AMask[1,2]) +

       (LRow3[LCol + 1].rgbtGreen * AMask[2,2]);

     LNewGreen := (LNewGreen / LCoef) + ABias;

     if LNewGreen > 255 then

       LNewGreen := 255;

     if LNewGreen < 0 then

       LNewGreen := 0;

     LNewRed :=

       (LRow1[LCol - 1].rgbtRed * AMask[0,0]) + (LRow1[LCol].rgbtRed * AMask[1,0])

       + (LRow1[LCol + 1].rgbtRed * AMask[2,0]) +

       (LRow2[LCol - 1].rgbtRed * AMask[0,1]) + (LRow2[LCol].rgbtRed * AMask[1,1])

       + (LRow2[LCol + 1].rgbtRed * AMask[2,1]) +

       (LRow3[LCol - 1].rgbtRed * AMask[0,2]) + (LRow3[LCol].rgbtRed * AMask[1,2])

       + (LRow3[LCol + 1].rgbtRed * AMask[2,2]);

     LNewRed := (LNewRed / LCoef) + ABias;

     if LNewRed > 255 then

       LNewRed := 255;

     if LNewRed < 0 then

       LNewRed := 0;

     LRowOut[LCol - 1].rgbtBlue  := trunc(LNewBlue);

     LRowOut[LCol - 1].rgbtGreen := trunc(LNewGreen);

     LRowOut[LCol - 1].rgbtRed   := trunc(LNewRed);

   end;

 end;

end;

// example use

// edge detection

procedure TForm1.Button1Click(Sender: TObject);

var

 LMask: T3x3FloatArray;

begin

 LMask[0,0] := -1;

 LMask[1,0] := -1;

 LMask[2,0] := -1;

 LMask[0,1] := -1;

 LMask[1,1] := 8;

 LMask[2,1] := -1;

 LMask[0,2] := -1;

 LMask[1,2] := -1;

 LMask[2,2] := -1;

 Image1.Picture.Bitmap := Convolve(Image1.Picture.Bitmap, LMask, 0);

end;