Foros Club Delphi

Foros Club Delphi (http://www.clubdelphi.com/foros/index.php)
-   Trucos (http://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Noche estrellada (http://www.clubdelphi.com/foros/showthread.php?t=80892)

coso 16-03-2009 22:17:47

Noche estrellada
 
Este codigo pinta, en principio, lo que es llamado en Física el campo de potencial de ciertas cargas electricas. Cambiando el valor de las constantes se consigue un efecto vistoso que recuerda a una noche con estrellas

Código Delphi [-]
unit potencial;

interface

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

type
     Carga = record
     x,y : integer;
     q : double;
end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
     Form1: TForm1;
     Carregues : array [0..50] of Carga;
//     Carregues : array [0..10] of Carga;
//     Carregues : array [0..1] of Carga;

implementation

{$R *.DFM}

function R(x1,y1,x2,y2 : integer): double;
begin
     result := sqrt ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2));
end;

function V(x,y : integer; q : Carga) : double; overload;
const
     K : double = $01;
//   K : double = $0100;
begin
     try
     result := q.q*K / R(q.x,q.y,x,y);
     except
     result := 0;
     end;
end;

function V(x,y : integer; q : array of Carga) : double; overload;
var
     i : integer;
begin
     result := 0;
     for i := Low(q) to High(q) do
     result := result + V(x,y,q[i]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
     i,j : integer;
     col : TColor;
const
     Colors    : array [boolean] of TColor = (clYellow, $80FF00);
begin
     for i := Low(Carregues) to High(Carregues) do
     begin
          Carregues[i].x := random(width);
          Carregues[i].y := random(Height);
          repeat
          Carregues[i].q := (random(2)-1)*random(5)/(random(2) + 0.01);
//          Carregues[i].q := (random(2)-1)*random(2)/(random(2) + 0.01);
          until Carregues[i].q <> 0;
     end;

     canvas.Brush.Color := clBlack;
     canvas.FillRect(Rect(0,0,ClientWidth,ClientHeight));
     canvas.Brush.Color := clRed;

//     col := random($010101);
//     col := 3872;
//     col := 53762;
//   col := 616;
//     col := $010000;
     col := $010101;
//     col := $01;
//     col := $010000;


     for i := 0 to ClientWidth do
     for j := 0 to ClientHeight do
          canvas.Pixels[i,j] := Col*Abs(Round(V(i,j,Carregues)));

     for i := low(Carregues) to High(Carregues) do
          canvas.Pixels[Carregues[i].x,Carregues[i].y] := Colors[Carregues[i].q > 0];

     tag := col;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     Caption := inttostr(Tag) + ' ' + FormatFloat('0.00000',V(X,Y,Carregues));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     randomize;
end;

end.

Estan comentadas varias combinaciones posibles

Neftali [Germán.Estévez] 17-03-2009 10:23:21

Muy espectacular.

Gracias coso.

jhonny 17-03-2009 23:19:56

Si, muy bonito, gracias coso :).

casacham 24-03-2009 06:00:09

Muy bonito programa, yo solo le agregaria esta parte a una de las funciones para que no de error de division por cero y pueda ser ejecutado desde delphi nomas

Código Delphi [-]
function V(x,y : integer; q : Carga) : double; overload;
const

   K : double = $0500;
var
   asa: double;
begin
     try
      asa:=R(q.x,q.y,x,y);
      if asa=0 then begin
       result:=0;
       asa:=1;
       exit;

      end;

     result := q.q*K / R(q.x,q.y,x,y) ;
     except
     result := 0;
     end;
end;

coso 24-03-2009 10:29:37

Tu codigo no hace falta casacham. La division por cero ya esta recogida en el bloque except. Precisamente para eso esto.


La franja horaria es GMT +2. Ahora son las 13:21:18.

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