Сглаживание Anti-aliasing

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем -, 6 май 2004.

Статус темы:
Закрыта.
  1. Гость

    Как сделать чтобы можно было рисовать линии сглаженными?
     
  2. admin

    admin Well-Known Member

    Регистрация:
    8 авг 2003
    Сообщения:
    2.811
    Симпатии:
    0
    Дущы
    FAAlias.pas
    Код (Text):
    {***************************************************************
    *
    * Project : FastAntiAlias
    * Unit  : FAAlias
    * Purpose : To demonstrate the use of super-sampling technique
    *      to anti-alias an image, as well to fast access to
    *      a bitmap image pixels using the ScanLine property
    * Author : Nacho Urenda (based on an example project by Rod
    *      Stephens published on Delphi Informant,
    *      april 98 issue)
    * Date  : 15/08/2000
    *
    ***************************************************************}


    unit FAAlias;

    interface

    uses
    Windows, SysUtils, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
    ComCtrls, ShellApi, Classes;

    type
    TAntiAliasForm = class(TForm)
     PageControl1: TPageControl;
     TabSheet1: TTabSheet;
     TabSheet2: TTabSheet;
     OutBox: TPaintBox;
     OrigBox: TPaintBox;
     Label1: TLabel;
     Label2: TLabel;
     Label4: TLabel;
     Label5: TLabel;
     ProcessBtn: TButton;
     ZoomOutBox: TCheckBox;
     ZoomOrigBox: TCheckBox;
     Method: TRadioGroup;
     Memo1: TMemo;
     TabSheet3: TTabSheet;
     Label3: TLabel;
     Label6: TLabel;
     Label7: TLabel;
     Label8: TLabel;
     Label9: TLabel;
     Label10: TLabel;
     Label11: TLabel;
     Label12: TLabel;
     OrigVScrollBar: TScrollBar;
     OutVScrollBar: TScrollBar;
     OrigHScrollBar: TScrollBar;
     OutHScrollBar: TScrollBar;
     procedure SeparateColor(color : TColor; var r, g, b : Integer);
     procedure OutBoxPaint(Sender: TObject);
     procedure DrawFace(bm : TBitmap; pen_width : Integer);
     procedure OrigBoxPaint(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure ProcessBtnClick(Sender: TObject);
     procedure DrawBigBmp;
     procedure FormCreate(Sender: TObject);
     procedure ZoomOrigBoxClick(Sender: TObject);
     procedure ZoomOutBoxClick(Sender: TObject);
     procedure Label10Click(Sender: TObject);
     procedure Label12Click(Sender: TObject);
     procedure OrigScrollBarChange(Sender: TObject);
     procedure OutScrollBarChange(Sender: TObject);
    private
     { Private declarations }
    public
     { Public declarations }
     procedure AntiAliasPicture;
     procedure FastAntiAliasPicture;
    end;

    var
    AntiAliasForm: TAntiAliasForm;



    const
     MaxPixelCount  = 32768;

    type
     pRGBArray = ^TRGBArray;
     TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;

    implementation

    {$R *.DFM}

    var
     orig_bmp, big_bmp, out_bmp : TBitmap;


    {***************************************************************
    TAntiAliasForm.SeparateColor
     15/08/2000

     The original procedure by Rod Stephens has been somewhat
     fastened
    ***************************************************************}
    procedure TAntiAliasForm.SeparateColor(color : TColor;
    var r, g, b : Integer);
    begin
    r := Byte(color);
    g := Byte(color shr 8);
    b := Byte(color shr 16);
    end;


    {***************************************************************
    TAntiAliasForm.AntiAliasPicture
     15/08/2000

     The original AAliasPicture procedure by Rod Stephens has been
     rewritten to improve the supersampling from double to triple
     factor, and somewhat simplified...
    ***************************************************************}
    procedure TAntiAliasForm.AntiAliasPicture;
    var
    x, y: integer;
    totr, totg, totb, r, g, b : integer;
    i, j: integer;
    begin
    // For each row
    for y := 0 to orig_bmp.Height - 1 do
    begin
     // For each column
     for x := 0 to orig_bmp.Width - 1 do
     begin
      totr := 0;
      totg := 0;
      totb := 0;

      // Read each of the sample pixels
      for i := 0 to 2 do
      begin
       for j := 0 to 2 do
       begin
        SeparateColor(big_bmp.Canvas.Pixels[(x*3) + j, (y*3) + i], r, g, b);
        totr := totr + r;
        totg := totg + g;
        totb := totb + b;
       end;
      end;

      out_bmp.Canvas.Pixels[x,y] := RGB(totr div 9,
                       totg div 9,
                       totb div 9);
     end; // end for columns
    end; // end for rows
    end;



    {***************************************************************
    TAntiAliasForm.FastAAliasPicture
     20/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.FastAntiAliasPicture;
    var
    x, y, cx, cy : integer;
    totr, totg, totb : integer;
    Row1, Row2, Row3, DestRow: pRGBArray;
    i: integer;
    begin
    // For each row
    for y := 0 to orig_bmp.Height - 1 do
    begin
     // We compute samples of 3 x 3 pixels
     cy := y*3;
     // Get pointers to actual, previous and next rows in supersampled bitmap
     Row1 := big_bmp.ScanLine[cy];
     Row2 := big_bmp.ScanLine[cy+1];
     Row3 := big_bmp.ScanLine[cy+2];

     // Get a pointer to destination row in output bitmap
     DestRow := out_bmp.ScanLine[y];

     // For each column...
     for x := 0 to orig_bmp.Width - 1 do
     begin
      // We compute samples of 3 x 3 pixels
      cx := 3*x;

      // Initialize result color
      totr := 0;
      totg := 0;
      totb := 0;

      // For each pixel in sample
      for i := 0 to 2 do
      begin
       // New red value
       totr := totr + Row1[cx + i].rgbtRed
          + Row2[cx + i].rgbtRed
          + Row3[cx + i].rgbtRed;
       // New green value
       totg := totg + Row1[cx + i].rgbtGreen
          + Row2[cx + i].rgbtGreen
          + Row3[cx + i].rgbtGreen;
       // New blue value
       totb := totb + Row1[cx + i].rgbtBlue
          + Row2[cx + i].rgbtBlue
          + Row3[cx + i].rgbtBlue;
      end;

      // Set output pixel colors
      DestRow[x].rgbtRed := totr div 9;
      DestRow[x].rgbtGreen := totg div 9;
      DestRow[x].rgbtBlue := totb div 9;
     end;
    end;
    end;


    {***************************************************************
    TAntiAliasForm.OrigBoxPaint
    TAntiAliasForm.OutBoxPaint
     15/08/2000

     The original procedures by Rod Stephens have been modified
     to allow the zooming and panning effects
    ***************************************************************}
    procedure TAntiAliasForm.OrigBoxPaint(Sender: TObject);
    var ZoomRect: TRect;
    begin
    // If zoomed display an enlarged protion of the bitmap
    if ZoomOrigBox.Checked then
    begin
     ZoomRect := Rect(OrigHScrollBar.Position,
              OrigVScrollBar.Position,
              OrigHScrollBar.Position+60,
              OrigVScrollBar.Position+60);
     OrigBox.Canvas.CopyRect(OrigBox.ClientRect, orig_bmp.Canvas, ZoomRect)
    end else
     OrigBox.Canvas.Draw(0, 0, orig_bmp);
    end;

    procedure TAntiAliasForm.OutBoxPaint(Sender: TObject);
    var ZoomRect: TRect;
    begin
    if ZoomOutBox.Checked then
    begin
     ZoomRect := Rect(OutHScrollBar.Position,
              OutVScrollBar.Position,
              OutHScrollBar.Position+60,
              OutVScrollBar.Position+60);
     OutBox.Canvas.CopyRect(OutBox.ClientRect, out_bmp.Canvas, ZoomRect)
    end else
     OutBox.Canvas.Draw(0, 0, out_bmp);
    end;


    {***************************************************************
    TAntiAliasForm.DrawFace
     15/08/2000

     Procedure written by Rod Stephens (unmodified)
    ***************************************************************}
    procedure TAntiAliasForm.DrawFace(bm : TBitmap;
                    pen_width : Integer);
    var
    x1, y1, x2, y2, x3, y3, x4, y4 : Integer;
    old_width           : Integer;
    old_color           : TColor;
    begin
    // Save the original brush color and pen width.
    old_width := bm.Canvas.Pen.Width;
    old_color := bm.Canvas.Brush.Color;

    // Erase background;
    bm.Canvas.Pen.Color := clwhite;
    bm.Canvas.Brush.Color := clwhite;
    bm.Canvas.Rectangle(0, 0, bm.width, bm.height);

    // Draw the head.
    bm.Canvas.Pen.Color := clBlack;
    bm.Canvas.Pen.Width := pen_width;
    bm.Canvas.Brush.Color := clYellow;
    x1 := Round(bm.Width * 0.05);
    y1 := x1;
    x2 := Round(bm.Height * 0.95);
    y2 := x2;
    bm.Canvas.Ellipse(x1, y1, x2, y2);

    // Draw the eyes.
    bm.Canvas.Brush.Color := clWhite;
    x1 := Round(bm.Width * 0.25);
    y1 := Round(bm.Height * 0.25);
    x2 := Round(bm.Width * 0.4);
    y2 := Round(bm.Height * 0.4);
    bm.Canvas.Ellipse(x1, y1, x2, y2);
    x1 := Round(bm.Width * 0.75);
    x2 := Round(bm.Width * 0.6);
    bm.Canvas.Ellipse(x1, y1, x2, y2);

    // Draw the pupils.
    bm.Canvas.Brush.Color := clBlack;
    bm.Canvas.Refresh;
    x1 := Round(bm.Width * 0.275);
    y1 := Round(bm.Height * 0.3);
    x2 := Round(bm.Width * 0.375);
    y2 := Round(bm.Height * 0.4);
    bm.Canvas.Ellipse(x1, y1, x2, y2);
    x1 := Round(bm.Width * 0.725);
    x2 := Round(bm.Width * 0.625);
    bm.Canvas.Ellipse(x1, y1, x2, y2);

    // Draw the nose.
    bm.Canvas.Brush.Color := clAqua;
    x1 := Round(bm.Width * 0.425);
    y1 := Round(bm.Height * 0.425);
    x2 := Round(bm.Width * 0.575);
    y2 := Round(bm.Height * 0.6);
    bm.Canvas.Ellipse(x1, y1, x2, y2);

    // Draw a crooked smile.
    x1 := Round(bm.Width * 0.25);
    y1 := Round(bm.Height * 0.25);
    x2 := Round(bm.Width * 0.75);
    y2 := Round(bm.Height * 0.75);
    x3 := Round(bm.Width * 0.4);
    y3 := Round(bm.Height * 0.6);
    x4 := Round(bm.Width * 0.8);
    y4 := Round(bm.Height * 0.6);
    bm.Canvas.Arc(x1, y1, x2, y2, x3, y3, x4, y4);

    bm.Canvas.Brush.Color := old_color;
    bm.Canvas.Pen.Width := old_width;
    end;


    {***************************************************************
    TAntiAliasForm.FormDestroy
     15/08/2000

     We must free the memory bitmaps before exiting
    ***************************************************************}
    procedure TAntiAliasForm.FormDestroy(Sender: TObject);
    begin
    orig_bmp.Free;
    big_bmp.Free;
    out_bmp.Free;
    end;


    {***************************************************************
    TAntiAliasForm.Button1Click
     15/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.ProcessBtnClick(Sender: TObject);
    var IniTime, ElapsedTime: DWord;
    begin
    // Display the hourglass cursor.
    Screen.Cursor := crHourGlass;

    // Erase the time elapsed label
    Label4.Caption := '';
    Label4.Refresh;

    // Erase the result PaintBox.
    out_bmp.Canvas.Brush.color := clWhite;
    out_bmp.Canvas.FillRect(out_bmp.Canvas.ClipRect);
    // Force repaint of outbox
    OutBox.Refresh;

    // Draw the supersampled image
    DrawBigBmp;

    // Create the anti-aliased version.
    if Method.ItemIndex = 0 then
    begin
     IniTime := GetTickCount;
     AntiAliasPicture;
     ElapsedTime := GetTickCount - IniTime;
    end else begin
     IniTime := GetTickCount;
     FastAntiAliasPicture;
     ElapsedTime := GetTickCount - IniTime;
    end;

    // Force repaint of output PaintBox
    OutBox.Invalidate;

    // Just to display calculation time
    Label4.Caption := IntToStr(ElapsedTime) + ' ms';
    Label4.Refresh;

    // Force repaint of outbox
    OutBox.Invalidate;

    // Remove the hourglass cursor.
    Screen.Cursor := crDefault;
    end;


    {***************************************************************
    TAntiAliasForm.DrawBigBmp
     15/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.DrawBigBmp;
    begin
    // Draw the supersampled image
    DrawFace(big_bmp, 6);
    end;



    {***************************************************************
    TAntiAliasForm.FormCreate
     15/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.FormCreate(Sender: TObject);
    begin
    // Create the necessary memory bitmaps.
    orig_bmp := TBitmap.Create;
    orig_bmp.Width := OrigBox.ClientWidth;
    orig_bmp.Height := OrigBox.ClientHeight;
    // Bitmap MUST be 24 bits to get ScanLine[] to work
    orig_bmp.PixelFormat := pf24bit;

    // Initialize original bitmap
    DrawFace(Orig_bmp, 2);

    // Create supersampled bitmap
    big_bmp := TBitmap.Create;
    big_bmp.Width := orig_bmp.Width * 3;
    big_bmp.Height := orig_bmp.Height * 3;
    big_bmp.PixelFormat := pf24bit;

    // Create output bitmap
    out_bmp := TBitmap.Create;
    out_bmp.Width := orig_bmp.Width;
    out_bmp.Height := orig_bmp.Height;
    out_bmp.PixelFormat := pf24bit;

    // Make sure the 'Example' page is visible on startup
    PageControl1.ActivePage := TabSheet1;

    // Initialize Scroll Bars
    OrigHScrollBar.Min := 0;
    OrigHScrollBar.Max := OrigBox.Width - (OrigBox.Width div 5);
    OrigHScrollBar.LargeChange := OrigBox.Width div 5;
    OrigVScrollBar.Min := 0;
    OrigVScrollBar.Max := OrigBox.Height - (OrigBox.Height div 5);
    OrigVScrollBar.LargeChange := OrigBox.Height div 5;

    OutHScrollBar.Min := 0;
    OutHScrollBar.Max := OutBox.Width - (OutBox.Width div 5);
    OutHScrollBar.LargeChange := OutBox.Width div 5;
    OutVScrollBar.Min := 0;
    OutVScrollBar.Max := OutBox.Height - (OutBox.Height div 5);
    OutVScrollBar.LargeChange := OutBox.Height div 5;

    // Load text into the 'How it works...' memo
    Memo1.Lines.LoadFromFile('ReadMe.txt');
    end;


    {***************************************************************
    TAntiAliasForm.ZoomOrigBoxClick
     15/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.ZoomOrigBoxClick(Sender: TObject);
    begin
    with TCheckBox(Sender) do
    begin
     OrigHScrollBar.Visible := Checked;
     OrigVScrollBar.Visible := Checked;
    end;
    OrigBox.Invalidate;
    end;


    {***************************************************************
    TAntiAliasForm.ZoomOutBoxClick
     15/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.ZoomOutBoxClick(Sender: TObject);
    begin
    with TCheckBox(Sender) do
    begin
     OutHScrollBar.Visible := Checked;
     OutVScrollBar.Visible := Checked;
    end;
    OutBox.Invalidate;
    end;




    {***************************************************************
    TAntiAliasForm.Label10Click
     16/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.Label10Click(Sender: TObject);
    begin
    ShellExecute(ValidParentForm(Self).Handle, 'open',
          PChar(TLabel(Sender).Caption),
          NIL, NIL, SW_SHOWNORMAL);
    end;


    {***************************************************************
    TAntiAliasForm.Label12Click
     16/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.Label12Click(Sender: TObject);
    begin
    ShellExecute(ValidParentForm(Self).Handle, 'open',
          PChar('mailto:nurenda@wanadoo.es?subject=Fast antialias'),
          NIL, NIL, SW_SHOWNORMAL);
    end;


    {***************************************************************
    TAntiAliasForm.OrigScrollBarChange
     20/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.OrigScrollBarChange(Sender: TObject);
    begin
    OrigBox.Invalidate;
    end;


    {***************************************************************
    TAntiAliasForm.OutScrollBarChange
     20/08/2000
    ***************************************************************}
    procedure TAntiAliasForm.OutScrollBarChange(Sender: TObject);
    begin
    OutBox.Invalidate
    end;

    end.
    FastAntiAlias.dpr

    Код (Text):
    program FastAntiAlias;

    uses
    Forms,
    FAAlias in 'FAAlias.pas' {AntiAliasForm};

    {$R *.RES}

    begin
    Application.Initialize;
    Application.CreateForm(TAntiAliasForm, AntiAliasForm);
    Application.Run;
    end.
    FAAlias.dfm

    Код (Text):
    object AntiAliasForm: TAntiAliasForm
    Left = 262
    Top = 193
    BorderIcons = [biSystemMenu]
    BorderStyle = bsDialog
    Caption = 'Antialiasing Pictures'
    ClientHeight = 450
    ClientWidth = 671
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = True
    OnCreate = FormCreate
    OnDestroy = FormDestroy
    PixelsPerInch = 96
    TextHeight = 13
    object PageControl1: TPageControl
     Left = 0
     Top = 0
     Width = 671
     Height = 450
     ActivePage = TabSheet1
     Align = alClient
     TabOrder = 0
     object TabSheet1: TTabSheet
      Caption = 'Example'
      object OutBox: TPaintBox
       Left = 336
       Top = 32
       Width = 300
       Height = 300
       OnPaint = OutBoxPaint
      end
      object OrigBox: TPaintBox
       Left = 8
       Top = 32
       Width = 300
       Height = 300
       OnPaint = OrigBoxPaint
      end
      object Label1: TLabel
       Left = 8
       Top = 8
       Width = 69
       Height = 13
       Caption = 'Normal Picture'
      end
      object Label2: TLabel
       Left = 336
       Top = 8
       Width = 87
       Height = 13
       Caption = 'Antialiased Picture'
      end
      object Label4: TLabel
       Left = 520
       Top = 384
       Width = 89
       Height = 13
       AutoSize = False
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clRed
       Font.Height = -11
       Font.Name = 'MS Sans Serif'
       Font.Style = [fsBold]
       ParentFont = False
      end
      object Label5: TLabel
       Left = 440
       Top = 384
       Width = 63
       Height = 13
       Caption = 'Elapsed time:'
      end
      object ProcessBtn: TButton
       Left = 328
       Top = 376
       Width = 105
       Height = 33
       Caption = 'Process...'
       TabOrder = 0
       OnClick = ProcessBtnClick
      end
      object ZoomOutBox: TCheckBox
       Left = 456
       Top = 8
       Width = 49
       Height = 17
       Caption = 'Zoom'
       TabOrder = 1
       OnClick = ZoomOutBoxClick
      end
      object ZoomOrigBox: TCheckBox
       Left = 112
       Top = 8
       Width = 49
       Height = 17
       Caption = 'Zoom'
       TabOrder = 2
       OnClick = ZoomOrigBoxClick
      end
      object Method: TRadioGroup
       Left = 8
       Top = 368
       Width = 313
       Height = 41
       Caption = 'Pixel access method'
       Columns = 2
       ItemIndex = 0
       Items.Strings = (
        'Bitmap.Canvas.Pixels[x,y]'
        'Bitmap.ScanLine[y]')
       TabOrder = 3
      end
      object OrigVScrollBar: TScrollBar
       Left = 310
       Top = 32
       Width = 16
       Height = 300
       Kind = sbVertical
       PageSize = 0
       TabOrder = 4
       Visible = False
       OnChange = OrigScrollBarChange
      end
      object OutVScrollBar: TScrollBar
       Left = 638
       Top = 32
       Width = 16
       Height = 300
       Kind = sbVertical
       PageSize = 0
       TabOrder = 5
       Visible = False
       OnChange = OutScrollBarChange
      end
      object OrigHScrollBar: TScrollBar
       Left = 8
       Top = 333
       Width = 300
       Height = 17
       PageSize = 0
       TabOrder = 6
       Visible = False
       OnChange = OrigScrollBarChange
      end
      object OutHScrollBar: TScrollBar
       Left = 336
       Top = 333
       Width = 300
       Height = 17
       PageSize = 0
       TabOrder = 7
       Visible = False
       OnChange = OutScrollBarChange
      end
     end
     object TabSheet2: TTabSheet
      Caption = 'How it works'
      object Memo1: TMemo
       Left = 8
       Top = 16
       Width = 641
       Height = 393
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWindowText
       Font.Height = -11
       Font.Name = 'Courier'
       Font.Style = []
       ParentFont = False
       ReadOnly = True
       ScrollBars = ssVertical
       TabOrder = 0
      end
     end
     object TabSheet3: TTabSheet
      Caption = 'About...'
      object Label3: TLabel
       Left = 16
       Top = 32
       Width = 593
       Height = 49
       Alignment = taCenter
       AutoSize = False
       Caption =
        'This programming example is based on an algorithm and sample cod' +
        'e published in the april 98 issue of ''Delphi Informant'' magazine' +
        ', written by Rod Stephens.'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWindowText
       Font.Height = -13
       Font.Name = 'MS Sans Serif'
       Font.Style = []
       ParentFont = False
       WordWrap = True
      end
      object Label6: TLabel
       Left = 16
       Top = 88
       Width = 593
       Height = 65
       Alignment = taCenter
       AutoSize = False
       Caption =
        'The code has been rewritten to improve sampling quality (from do' +
        'uble to triple size) and speed by Nacho Urenda, a senior program' +
        'mer from Barcelona, Spain. Any possible error in the code must b' +
        'e imputed to him, and not to the original author and publisher.'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWindowText
       Font.Height = -13
       Font.Name = 'MS Sans Serif'
       Font.Style = []
       ParentFont = False
       WordWrap = True
      end
      object Label7: TLabel
       Left = 16
       Top = 160
       Width = 593
       Height = 65
       Alignment = taCenter
       AutoSize = False
       Caption =
        'LEGAL DISCLAIMER: You may use and distribute this code freely, b' +
        'ut the author cannot give any guarantees, explicit or implicit, ' +
        'that it will work properly under every possible circumstance. Us' +
        'e it at your own risk... Sorry. '
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWindowText
       Font.Height = -13
       Font.Name = 'MS Sans Serif'
       Font.Style = []
       ParentFont = False
       WordWrap = True
      end
      object Label8: TLabel
       Left = 16
       Top = 224
       Width = 593
       Height = 49
       Alignment = taCenter
       AutoSize = False
       Caption =
        'If you should find an error or have a suggestion to improve the ' +
        'code quality, you are invited to contact the author at the e-mai' +
        'l address below.'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWindowText
       Font.Height = -13
       Font.Name = 'MS Sans Serif'
       Font.Style = []
       ParentFont = False
       WordWrap = True
      end
      object Label9: TLabel
       Left = 24
       Top = 312
       Width = 125
       Height = 13
       Caption = '''Delphi informant'' web site:'
      end
      object Label10: TLabel
       Left = 24
       Top = 336
       Width = 170
       Height = 16
       Cursor = crHandPoint
       Caption = 'http://www.informant.com'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clBlue
       Font.Height = -13
       Font.Name = 'MS Sans Serif'
       Font.Style = [fsBold, fsUnderline]
       ParentFont = False
       OnClick = Label10Click
      end
      object Label11: TLabel
       Left = 336
       Top = 312
       Width = 71
       Height = 13
       Caption = 'Author''s e-mail:'
      end
      object Label12: TLabel
       Left = 336
       Top = 336
       Width = 156
       Height = 16
       Cursor = crHandPoint
       Caption = 'nurenda@wanadoo.es'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clBlue
       Font.Height = -13
       Font.Name = 'MS Sans Serif'
       Font.Style = [fsBold, fsUnderline]
       ParentFont = False
       OnClick = Label12Click
      end
     end
    end
    end
     
  3. RAIN

    RAIN Гость

    Или Вот этот маленький кодик:
    Код (Text):
    {
    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;
     
Загрузка...
Похожие Темы - Сглаживание Anti aliasing
  1. lazybiz
    Ответов:
    18
    Просмотров:
    8.024
Статус темы:
Закрыта.

Поделиться этой страницей