Ver Mensaje Individual
  #5  
Antiguo 14-06-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Reputación: 0
coso Va por buen camino
Te dejo aqui la ventana con fondo degradado, esquinas redondeadas y antialiasing. De antialias seguro q hay funciones mas buenas por internet. Lo dejo por si alguien quiere cojer la idea.

Código Delphi [-]
unit antialias;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Antialias(Rt : TRect);
    procedure Degradado;
    procedure FormPaint(Sender: TObject);
    function Red(c : TColor) : integer;
    function Green(c : TColor) : integer;
    function Blue(c : TColor) : integer;
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
        Desktop : TControlCanvas;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  f: HRGN;
begin
        Desktop := TControlCanvas.Create;

        try
                Desktop.Handle := GetDC(0);
        except
        end;

  Form1.Borderstyle := bsNone;
  f := CreateRoundRectRgn(
          0,            // x-coordinate of the region's upper-left corner
          0,            // y-coordinate of the region's upper-left corner
          clientwidth,  // x-coordinate of the region's lower-right corner
          clientheight, // y-coordinate of the region's lower-right corner
          40,           // height of ellipse for rounded corners
          40);          // width of ellipse for rounded corners
  SetWindowRgn(Handle,f,True);
  Left := 40;
  Top := 200;
end;

procedure TForm1.Degradado;
var
        ri,gi,bi : integer;
        rf,gf,bf : integer;
        pr,pg,pb : double;
        r,g,b    : integer;
        x : integer;
        c : TColor;
begin
        ri := 255;
        gi := 255;
        bi := 255;

        rf := $8B;
        gf := $9B;
        bf := $D1;

        pr := (rf - ri) / (2*Height/3);
        pg := (gf - gi) / (2*Height/3);
        pb := (bf - bi) / (2*Height/3);

        c := 0;
        for x := 0 to (2*Height div 3) - 1 do
        begin
          r := ri + round(pr * x);
          g := gi + round(pg * x);
          b := bi + round(pb * x);

          c := RGB(r,g,b);

          Canvas.Pen.Color := c;
          Canvas.MoveTo(0,x);
          Canvas.LineTo(Width,x);
        end;

        for x := (2*Height div 3) to Height do
        begin
          Canvas.Pen.Color := c;
          Canvas.MoveTo(0,x);
          Canvas.LineTo(Width,x);
        end;
end;

procedure TForm1.Antialias(Rt : TRect);
var
        x,y,i : integer;
        r,g,b : longint;
        cl : array [0..8] of TColor;
begin
        for x := Rt.Left -1 to Rt.Right + 1 do
        for y := Rt.Top - 1 to Rt.Bottom + 1 do
        begin
              r := 0;
              g := 0;
              b := 0;

              cl[0] := desktop.Pixels[Left + x-1,Top + y-1];
              cl[1] := desktop.Pixels[Left + x-1,Top + y];
              cl[2] := desktop.Pixels[Left + x-1,Top + y+1];

              cl[3] := desktop.Pixels[Left + x,Top + y-1];
              cl[8] := desktop.Pixels[Left + x,Top + y];
              cl[4] := desktop.Pixels[Left + x,Top + y+1];

              cl[5] := desktop.Pixels[Left + x+1,Top + y-1];
              cl[6] := Desktop.Pixels[Left + x+1,Top + y];
              cl[7] := Desktop.Pixels[Left + x+1,Top + y+1];

                for i := 0 to 7 do
                begin
                        r := r + Red(cl[i]);
                        g := g + Green(cl[i]);
                        b := b + Blue(cl[i]);
                end;

                r := (r div 8);
                g := (g div 8);
                b := (b div 8);

                Canvas.Pixels[x,y] := RGB(r,g,b);
        end;
end;

function TForm1.Red(c : TColor) : integer;
begin
        Red := c and $FF;
end;

function TForm1.Green(c : TColor) : integer;
begin
        Green := (c and $FF00) div $100;
end;

function TForm1.Blue(c : TColor) : integer;
begin
        Blue := (c and $FF0000) div $10000;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
        inherited;
        Degradado;
        Antialias(Rect(0,0,30,30));
        Antialias(Rect(Width-30,0,Width,30));
        Antialias(Rect(0,Height - 30,30,Height));
        Antialias(Rect(Width-30,Height - 30, Width, Height));
        Antialias(Rect(0,0,Width,2));
        Antialias(Rect(0,0,2,Height));
        Antialias(Rect(Width-2,0,Width,Height));
        Antialias(Rect(0,Height-2,Width,Height));

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
        Desktop.Free;
end;

end.

Saludos
Responder Con Cita