Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 18-05-2007
Avatar de MaMu
MaMu MaMu is offline
Miembro
 
Registrado: abr 2006
Ubicación: Argentina
Posts: 863
Poder: 18
MaMu Va por buen camino
Alguien sabe como hacer esto?

Resulta que leyendo y leyendo post, encontre uno donde habia un componente freeware para bajar, y lo baje por curiosidad, el resultado es impresionante. El programa es el siguiente:

Código Delphi [-]
unit MainUnit;
// TPaintBox32 and DrawLineFSP example
// Author: Alex Denissov
// http://g32.org

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, GR32, GR32_Blend, ExtCtrls, GR32_Image;
type
  TVector2f = record
    X, Y: Single;
  end;
  TLine = class
  public
    Bitmap: TBitmap32;
    P1, P2: TVector2f;     // positions
    V1, V2: TVector2f;     // velocities
    C1, C2, C3: TColor32;  // colors that define gradient pattern
    t1, t2, t3: Single;
    MaxVelocity: Single;
    constructor Create(ABitmap: TBitmap32);
    procedure Advance(DeltaT: Single);
    function GetLength: Single;
    procedure Paint;
  end;
  TForm1 = class(TForm)
    PaintBox: TPaintBox32;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    Label1: TLabel;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure BitmapLayerMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure BitmapLayerMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RadioGroup1Click(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
  protected
    Lines: array of TLine;
    P: TPoint; // mouse shift
    M: Boolean; // mouse down flag
    FadeCount: Integer;
    Pass: Integer;
    DrawPasses: Integer;
    procedure AppEventsIdle(Sender: TObject; var Done: Boolean);
  public
    procedure AddLine;
    procedure AddLines(N: Integer);
  end;
var
  Form1: TForm1;
implementation
uses Math;
function vAdd(const A, B: TVector2f): TVector2f;
begin
  Result.X := A.X + B.X;
  Result.Y := A.Y + B.Y;
end;
function vSub(const A, B: TVector2f): TVector2f;
begin
  Result.X := A.X - B.X;
  Result.Y := A.Y - B.Y;
end;
function vLen(const A: TVector2f): Single;
begin
  Result := SqRt(SqR(A.X) + SqR(A.Y));
end;
function vDot(const A, B: TVector2f): Single;
begin
  Result := A.X * B.X + A.Y * B.Y;
end;
function vScale(const A: TVector2f; Factor: Single): TVector2f;
begin
  Result.X := A.X * Factor;
  Result.Y := A.Y * Factor;
end;
{$R *.DFM}

{ TLine }
procedure TLine.Advance(DeltaT: Single);
{}procedure AdvancePoint(var P, V: TVector2f; t: Single);
  begin
    { apply velocities }
    P.X := P.X + V.X * t;
    P.Y := P.Y + V.Y * t;
    { reflect from walls }
    if P.X < 0 then
    begin
      P.X := 0;
      V.X := -V.X;
    end;
    if P.X >= Form1.PaintBox.Width then
    begin
      P.X := Form1.PaintBox.Width - 1;
      V.X := - V.X;
    end;
    if P.Y < 0 then
    begin
      P.Y := 0;
      V.Y := -V.Y;
    end;
    if P.Y >= Form1.PaintBox.Height then
    begin
      P.Y := Form1.PaintBox.Height - 1;
      V.Y := - V.Y
    end;
    { change velocity a little bit }
    V.X := V.X + t * (Random - 0.5) / 4;
    V.Y := V.Y + t * (Random - 0.5) / 4;
    { limit velocity }
    if vLen(V1) > MaxVelocity then V1 := vScale(V1, 1 / vLen(V1));
    if vLen(V2) > MaxVelocity then V2 := vScale(V2, 1 / vLen(V2));
  end;
begin
  AdvancePoint(P1, V1, DeltaT);
  AdvancePoint(P2, V2, DeltaT);
  C1 := HSLtoRGB(t1, Sin(t1 / 1.8) * 0.4 + 0.6, 0.5);
  C1 := SetAlpha(C1, Round(Sin(t1) * 25 + 50));
  t1 := t1 + Random / 300;
  C2 := HSLtoRGB(t2, Sin(t2 / 1.8) * 0.4 + 0.6, 0.5);
  C2 := SetAlpha(C2, Round(Sin(t2) * 25 + 50));
  t2 := t2 + Random / 400;
  C3 := HSLtoRGB(t3, Sin(t3 / 1.8) * 0.4 + 0.6, 0.5);
  C3 := SetAlpha(C3, Round(Sin(t3) * 25 + 50));
  t3 := t3 + Random / 400;
end;
constructor TLine.Create(ABitmap: TBitmap32);
begin
  Bitmap := ABitmap;
  MaxVelocity := 1;
end;
function TLine.GetLength: Single;
begin
  Result := vLen(vSub(P1, P2));
end;
procedure TLine.Paint;
var
  L: Single;
begin
  // this shows how to draw a gradient line
  L := GetLength;
  if L < 1 then Exit;
  Bitmap.SetStipple([C1, C2, C3]);
  Bitmap.StippleStep := 2 / L; {2 = 3 - 1 = Number of colors in a pattern - 1}
  Bitmap.StippleCounter := 0;
  Bitmap.LineFSP(P1.X, P1.Y, P2.X, P2.Y);
end;
{ TForm1 }
procedure TForm1.AddLine;
var
  L: TLine;
begin
  SetLength(Lines, Length(Lines) + 1);
  L := TLine.Create(PaintBox.Buffer);
  Lines[High(Lines)] := L;
  L.t1 := Random * 3;
  L.t2 := Random * 3;
  L.t3 := Random * 3;
  L.P1.X := Random(PaintBox.Buffer.Width - 1);
  L.P2.X := Random(PaintBox.Buffer.Width - 1);
  L.P1.Y := Random(PaintBox.Buffer.Height - 1);
  L.P2.Y := Random(PaintBox.Buffer.Height - 1);
  Panel1.Caption := IntToStr(Length(Lines));
end;
procedure TForm1.AddLines(N: Integer);
var
  i: Integer;
begin
  for i := 0 to N - 1 do AddLine;
end;
procedure TForm1.AppEventsIdle(Sender: TObject; var Done: Boolean);
var
  I, J: Integer;
  P: PColor32;
begin
  for J := 0 to DrawPasses - 1 do
    for I := 0 to High(Lines) do
    begin
      Lines[i].Advance(1);
      Lines[i].Paint;
    end;
  if FadeCount > 0 then
  begin
    if Pass = 0 then with PaintBox.Buffer do
    begin
      P := @Bits[0];
      for I := 0 to Width * Height do
      begin
        BlendMem($10000000, P^);
        Inc(P);
      end;
      EMMS;
    end;
    Dec(Pass);
    if (Pass < 0) or (Pass > FadeCount) then Pass := FadeCount;
  end;
  PaintBox.Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  FadeCount := 7;
  DrawPasses := 2;
  Application.OnIdle := AppEventsIdle;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  AddLine;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  AddLines(10);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
  I: Integer;
begin
  for I := High(Lines) downto 0 do Lines[i].Free;
  Lines := nil;
  PaintBox.Buffer.Clear;
  Panel1.Caption := '0';
end;
procedure TForm1.BitmapLayerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  // X and Y here are relative to layer origin
  P := Point(X, Y);
  M := True;
end;
procedure TForm1.BitmapLayerMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  M := False;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
const
  FC: array [0..2] of Integer = (0, 7, 1);
begin
  FadeCount := FC[RadioGroup1.ItemIndex];
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
  DrawPasses := (RadioGroup2.ItemIndex + 1) * 3 - 2;
end;
end.

Alguien lo usó??? porque me gustaria saber como hacer para cambiar el color de forndo del PaintBox (TPaintBox32) o hacerlo transparente, la verdad no se como.
Si alguien sabe, se lo agradeceré, me gustaria poder modificar el componente y hacer uno con esos cambios ya listos.

Saludos y Gracias
__________________
Código Delphi [-]
 
try 
ProgramarMicro(80C52,'Intel',MnHex,True);
except
On Exception do
MicroChip.IsPresent(True);
end;
Responder Con Cita
  #2  
Antiguo 18-05-2007
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Poder: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
Hola, creo que ya tienes suficientes mensajes como para saber titular adecuadamente tus hilos. Te pido tener más cuidado en ello.

// Saludos
Responder Con Cita
  #3  
Antiguo 18-05-2007
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.267
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Además de lo comentado por Román, decirte que has subido "lo que sea que es" a medias. Has copiado el PAS, pero te has dejado el DFM.

Supongo qu debrías comprimir ambos y subirlos como adjunto. Pero lo que has subido nos da pocas opciones...
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #4  
Antiguo 18-05-2007
Avatar de Caral
[Caral] Caral is offline
Miembro Premium
 
Registrado: ago 2006
Posts: 7.659
Poder: 25
Caral Va por buen camino
Hola
Verdad, o me equivoco, si no se sube e instala en componente, dara error al compilar.
Me parece que si se quiere una opinion de algo seria bueno enseñar con que y como se trabaja.
Por que por lo demas, seria un simple revision del codigo e imaginarse como trabaja o que hace el componente.
Saludos
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Alguien sabe como hacer que una query sea modificable pjmedina Varios 20 12-04-2007 11:17:27
alguien sabe como es esto me tira error en la lineadel where "invalid use of keyword" todook Conexión con bases de datos 5 16-11-2006 21:58:02
Alguien sabe como hacer que tu aplicacion se ejecute... Supra Varios 7 05-02-2005 21:10:09
Alguien sabe como hacer un ShotDown a Firebird 1.51???? AGAG4 Conexión con bases de datos 3 28-10-2004 18:02:21
¿alguien sabe hacer esto? (conexion a mySQL desde delphi pero sin acceso...) seccion31 Internet 24 27-08-2004 17:14:23


La franja horaria es GMT +2. Ahora son las 01:54:16.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi