Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.02.03;
Скачать: [xml.tar.bz2];

Вниз

Antialiasing   Найти похожие ветки 

 
Барковъ   (2008-01-04 13:50) [0]

type

PixArray = Array [0..2] of Byte;

....

procedure Antialiasing(Bitmap: TBitmap; Rect: TRect; Percent: Integer);
var
 pix, prevscan, nextscan, hpix: ^PixArray;
 l, p: Integer;
 R, G, B: Integer;
 R1, R2, G1, G2, B1, B2: Byte;
begin
 Bitmap.PixelFormat := pf24bit;
 with Bitmap.Canvas do
 begin
   Brush.Style := bsclear;
   for l := Rect.Top to Rect.Bottom - 1 do
   begin
     pix:= Bitmap.ScanLine[l];
     if l <> Rect.Top then prevscan := Bitmap.ScanLine[l-1]
     else prevscan := nil;
     if l <> Rect.Bottom - 1 then nextscan := Bitmap.ScanLine[l+1]
     else nextscan := nil;

     for p := Rect.Left to Rect.Right - 1 do
     begin
       R1 := pix^[2];
       G1 := pix^[1];
       B1 := pix^[0];

       if p <> Rect.Left then
       begin
         //Pixel links
         //Pixel left

         hpix := pix;
         dec(hpix);
         R2 := hpix^[2];
         G2 := hpix^[1];
         B2 := hpix^[0];

         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := R1 + (R2 - R1) * 50 div (Percent + 50);
           G := G1 + (G2 - G1) * 50 div (Percent + 50);
           B := B1 + (B2 - B1) * 50 div (Percent + 50);
           hpix^[2] := R;
           hpix^[1] := G;
           hpix^[0] := B;
         end;
       end;

       if p <> Rect.Right - 1 then
       begin
         //Pixel rechts
         //Pixel right
         hpix := pix;
         inc(hpix);
         R2 := hpix^[2];
         G2 := hpix^[1];
         B2 := hpix^[0];

         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := R1 + (R2 - R1) * 50 div (Percent + 50);
           G := G1 + (G2 - G1) * 50 div (Percent + 50);
           B := B1 + (B2 - B1) * 50 div (Percent + 50);
           hpix^[2] := R;
           hpix^[1] := G;
           hpix^[0] := B;
         end;
       end;

       if prevscan <> nil then
       begin
         //Pixel oben
         //Pixel up
         R2 := prevscan^[2];
         G2 := prevscan^[1];
         B2 := prevscan^[0];

         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := R1 + (R2 - R1) * 50 div (Percent + 50);
           G := G1 + (G2 - G1) * 50 div (Percent + 50);
           B := B1 + (B2 - B1) * 50 div (Percent + 50);
           prevscan^[2] := R;
           prevscan^[1] := G;
           prevscan^[0] := B;
         end;
         Inc(prevscan);
       end;

       if nextscan <> nil then
       begin
         //Pixel unten
         //Pixel down
         R2 := nextscan^[2];
         G2 := nextscan^[1];
         B2 := nextscan^[0];

         if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
         begin
           R := R1 + (R2 - R1) * 50 div (Percent + 50);
           G := G1 + (G2 - G1) * 50 div (Percent + 50);
           B := B1 + (B2 - B1) * 50 div (Percent + 50);
           nextscan^[2] := R;
           nextscan^[1] := G;
           nextscan^[0] := B;
         end;
         Inc(nextscan);
       end;
       Inc(pix);
     end;
   end;
 end;
end;

...
  bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
  bmp.Canvas.TextOut(0,0, IntToStr(Random(9999999999)));
  Antialiasing(bmp, Rect(0, 0, bmp.Width, bmp.Height), 50);
  form.Canvas.Draw(0,0, bmp);

по идее канвас я очищаю, но при многократном использовании
остаётся размытое предыдущее изображение при отрисовке на форме bmp.
Не подскажите где туплю?
и может у кого есть в загашнике какая шустрая отработка сглаживания?


 
Барковъ   (2008-01-04 15:19) [1]

блин,  Brush.Style := bsclear устанавливается :)

а насчет самого алгоритма может есть у кого пошустрей?


 
Amoeba ©   (2008-01-05 21:36) [2]

Может имеет смысл воспользоваться готовым решением (библиотекой):
http://g32.org/graphics32/index.html


 
homm ©   (2008-01-05 21:50) [3]

> [1] Барковъ   (04.01.08 15:19)
> а насчет самого алгоритма может есть у кого пошустрей?

Алгоритма чего?



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.02.03;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.047 c
2-1199296031
Alik
2008-01-02 20:47
2008.02.03
Блокировка повторного запуска программы


15-1198944919
niKo
2007-12-29 19:15
2008.02.03
прием файла скриптом


6-1179280426
Ш-К
2007-05-16 05:53
2008.02.03
Изменения в TWebBrowser


15-1198830321
fevadmin
2007-12-28 11:25
2008.02.03
Помогите в выборе оборудования


3-1190642401
novill
2007-09-24 18:00
2008.02.03
Как без UDF реализоывать в IB7.5 обрезать строки до нужной длины?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский