Delphi World - Сглаживание
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Сглаживание

Оформил: 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 World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования