Сглаживание

Delphi , Графика и Игры , Изображения

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
Originally written by Horst Kniebusch, modified by alioth to make it(alot) faster. 
}

 procedure Antialiasing(Image: TImage; Percent: Integer);
 type
   TRGBTripleArray = array[0..32767] of TRGBTriple;
   PRGBTripleArray = ^TRGBTripleArray;
 var
   SL, SL2: PRGBTripleArray;
   l, m, p: Integer;
   R, G, B: TColor;
   R1, R2, G1, G2, B1, B2: Byte;
 begin
   with Image.Canvas do
   begin
     Brush.Style  := bsClear;
     Pixels[1, 1] := Pixels[1, 1];
     for l := 0 to Image.Height - 1 do
     begin
       SL := Image.Picture.Bitmap.ScanLine[l];
       for p := 1 to Image.Width - 1 do
       begin
         R1 := SL[p].rgbtRed;
         G1 := SL[p].rgbtGreen;
         B1 := SL[p].rgbtBlue;

         // Left 
        if (p < 1) then m := Image.Width
         else
           m := p - 1;
         R2 := SL[m].rgbtRed;
         G2 := SL[m].rgbtGreen;
         B2 := SL[m].rgbtBlue;
         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
           G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
           B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
           SL[m].rgbtRed := R;
           SL[m].rgbtGreen := G;
           SL[m].rgbtBlue := B;
         end;

         //Right 
        if (p > Image.Width - 2) then m := 0
         else
           m := p + 1;
         R2 := SL[m].rgbtRed;
         G2 := SL[m].rgbtGreen;
         B2 := SL[m].rgbtBlue;
         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
           G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
           B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
           SL[m].rgbtRed := R;
           SL[m].rgbtGreen := G;
           SL[m].rgbtBlue := B;
         end;

         if (l < 1) then m := Image.Height - 1
         else
           m := l - 1;
         //Over 
        SL2 := Image.Picture.Bitmap.ScanLine[m];
         R2  := SL2[p].rgbtRed;
         G2  := SL2[p].rgbtGreen;
         B2  := SL2[p].rgbtBlue;
         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
           G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
           B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
           SL2[p].rgbtRed := R;
           SL2[p].rgbtGreen := G;
           SL2[p].rgbtBlue := B;
         end;

         if (l > Image.Height - 2) then m := 0
         else
           m := l + 1;
         //Under 
        SL2 := Image.Picture.Bitmap.ScanLine[m];
         R2  := SL2[p].rgbtRed;
         G2  := SL2[p].rgbtGreen;
         B2  := SL2[p].rgbtBlue;
         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
           G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
           B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
           SL2[p].rgbtRed := R;
           SL2[p].rgbtGreen := G;
           SL2[p].rgbtBlue := B;
         end;
       end;
     end;
   end;
 end;


 //Example: 
procedure TForm1.Button1Click(Sender: TObject);
 begin
   Antialiasing(Image1, 80);
 end;

Статья Сглаживание раздела Графика и Игры Изображения может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Изображения ::