Algoritmo de rebote de una pelota


Esta aplicación ofrece una simulación del rebote de una pelota sobre una superficie plana.
Permite indicar el coeficiente de elasticidad, que es la cantidad de energía que se pierde en cada rebote de la pelota y una escala de tiempo, para ir viendo lentamente el movimiento de caída y de rebote.




unit U_BBall1;
  {Copyright  © 2003, Gary Darby,  www.DelphiForFun.org
 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    DropBtn: TButton;
    Shape1: TShape;
    ResetBtn: TButton;
    TimescaleBar: TTrackBar;
    Label2: TLabel;
    Label1: TLabel;
    CEBar: TTrackBar;
    StaticText1: TStaticText;
    procedure FormActivate(Sender: TObject);
    procedure DropBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure StaticText1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    inittop:integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);
begin
   panel1.doublebuffered:=true; {for smoother animation}
   inittop:=shape1.top; {save first ball position so we can reset it after a drop}
end;

procedure TForm1.DropBtnClick(Sender: TObject);
var
  v:real;     {current velocity in pixles}
  nextV:real; {look ahead to next velocity}
  c:real;     {Coefficient of elasticity}
  stopped:boolean;  {stop flag}
  lastTop:integer;
Begin
  resetbtnclick(sender);
  V:=0;
  stopped:=false;
  tag:=0;
  lasttop:=0;
  with shape1 do {so all uses of 'top' and 'height' in this loop mean refer to shape1}
  repeat
    {increment velocity 1 pixel per loop, i.e. gravity = 1 pixel per loop per loop}
    nextv:=v+1.0;
    //*{debugging}listbox1.items.add(format('top %3d, v %5.1f, nextv %5.1f',[top,v,nextv]));
    If v>=0 then {moving down}
    Begin
      if (top+ round(nextv)>=panel1.height-height)
      then {next move would go below the floor}
      Begin
        LastTop:=top;
        top:=panel1.height-height; {so just set it on the floor}
        c:=sqrt(CEBar.position / CEBar.max); {set coefficient of elasticity}
        nextv:=-(nextv)*c; {lose a little energy and start it back up}
        if nextv>-3 then stopped:=true; {If we won't move at least 3 pixels, then stop}
      end
      else top:=top+round(nextv);
    end
    else {moving up}
    Begin
      If top+round(nextv)<0 but="" ceiling="" else="" goes="" happen="" if="" lasttop="" move="" next="" shouldn="" t="" the="" then="" through="" top:="0">0 then {first move up, use last move down position}
      begin
        top:=lasttop;
        lasttop:=0;
        nextv:=nextv-1;
      end
      else
      begin
         top:=top+round(nextv);
      end;
    end;
    v:=nextv;
    application.processmessages; {Let the screen update, etc.}
    sleep(timescalebar.max-timescalebar.position); {Wait a few milliseconds}
    if self.tag>0 then stopped:=true;
  until stopped;
end;

procedure TForm1.ResetBtnClick(Sender: TObject);
begin
  tag:=1;

  shape1.top:=inittop;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  tag:=1;
end;

procedure TForm1.StaticText1Click(Sender: TObject);
begin
   ShellExecute(Handle, 'open', 'http://www.delphiforfun.org/',
               nil, nil, SW_SHOWNORMAL);
end;

end.

Descargar aplicación


También te puede interesar

Simulación del movimiento de electrones en un campo eléctrico

Simulador de circuitos lógicos
Simulación del enfriamiento de una partícula en 2D

 
 

Diseñando hypercubos de N dimensiones en Delphi


Este programa te permite dibujar un hypercubo utilizando opengl

Hay varios modos de representación, estructura alámbrica, iluminación, estructura alámbrica con líneas ocultas, iluminación con líneas ocultas ... 

También hay una función que permite exportar los vértices calculados en un archivo * .inc que se puede usar con POV-Ray.


 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Opengl, StdCtrls, ComCtrls, Buttons;

const
  MaxDim=10;                        //Dimension maximale de travail
  GL_POLYGON_OFFSET_FILL=$8037;

type
  TVect=array[1..MaxDim] of Single;                //vecteur
  TMatrix=array[1..MaxDim,1..MaxDim] of Single;    //matrice

  TForm1 = class(TForm)
    Timer1: TTimer;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    GroupBox1: TGroupBox;
    RadioGroup1: TRadioGroup;
    CheckBox1: TCheckBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    FGLRC:HGLRC;                //contexte opengl
    FVertexes:array of TVect;   //les sommets des faces
    FDim:Integer;               //la dimension courante (inférieure à MaxDim)
    FMatrix:TMatrix;            //la matrice des rotations

    procedure TrackBarChange(Sender:TObject);          //événement lorsqu'un angle a changé
    procedure MakeMatrix;                              //génération de la matrice à partir des angles
    procedure DrawScene;                               //tracé de la scène
    procedure Animate;                                 //procédure appelée pour changer les angles lorsque l'animation est activée
  public
  end;

var
  Form1: TForm1;

procedure glPolygonOffset(factor:GLfloat;units:GLfloat);stdcall;external Opengl32;   //fonction Opengl non standard

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);       //initialisation d'opengl et des diverses variables
var
  PFd:TPixelFormatDescriptor;
  c:Integer;
begin
  WindowState:=wsMaximized;
  ZeroMemory(@PFD,SizeOf(PFD));
  PFD.nSize:=SizeOf(PFD);
  PFD.nVersion:=1;
  PFD.dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;     //on se met en mode doublebuffered pour éviter les clignotements
  PFD.iPixelType:=PFD_TYPE_RGBA;
  PFD.cColorBits:=GetDeviceCaps(Canvas.Handle,BITSPIXEL);
  PFD.cAlphaBits:=8;                   //8 bits pour le canal alpha
  PFD.cDepthBits:=16;                  //16 pour le test de profondeur (Z-buffer)
  PFD.cStencilBits:=16;                //on va effectuer de la géométrie cnstructive en utilisant le stencil buffer
  c:=ChoosePixelFormat(Canvas.Handle,@PFD);
  Assert(c<>0,'No valid pixel foprmat is supported: '+SysErrorMessage(GetLastError));
  Assert(SetPixelFormat(Canvas.Handle,c,@PFD),'Couldnt set the pixel format: '+SysErrorMessage(GetLastError));           //on active le pixel format du canvas pour supporter opengl
  FGLRC:=wglCreateContext(Canvas.Handle);       //on crée un contexte opengl
  Assert(FGLRC<>0,'Couldnt create a valid GL context: '+SysErrorMessage(GetLastError));
  Assert(wglMakeCurrent(Canvas.Handle,FGLRC),'Couldnt create use the GL context: '+SysErrorMessage(GetLastError));    //on active le contexte
  SetLength(FVertexes,0);
  ComboBox1Change(nil);                //on initialise le premier cube
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  DrawScene;                     //on trace la scène
  glFlush;                       //on notifie opengl que le tracé est fini
  SwapBuffers(Canvas.Handle);    //on "swap" les 2 buffers (puisqu'on est en mode doublebuffered)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Assert(wglMakeCurrent(Canvas.Handle,0),'Couldnt unlock the GL context: '+SysErrorMessage(GetLastError));   //on désactive le contexte
  Assert(wglDeleteContext(FGLRC),'Couldnt delete the GL context: '+SysErrorMessage(GetLastError));           //on le détruit
  SetLength(FVertexes,0);
end;

function PowerOfTwo(n:Integer):Integer;     //calcule une puissance de 2 (fonction peu optimisée mais peu utilisée)
begin
  Result:=Round(Exp(Ln(2)*n));
end;

procedure TForm1.ComboBox1Change(Sender: TObject);       //Changement de dimension
var
  a,b,c,n:Integer;
  t:TTrackBar;

  procedure MakeSubFaces;   //On crée tous les quadrilatères possibles qui sont situés dans les plans de directions numéro a et b. Il y en a 2^(FDim-2) en tout.
  var
    i,j,u,v:Integer;
  begin
    for i:=0 to n-1 do begin                              //pour a et b fixés, il y a n quadrilatères possibles, correspondant à toutes les combinaisons de coordonnées 1 et -1
      ZeroMemory(@FVertexes[c+4*i],SizeOf(TVect));        //dans les directions orthogonales à a et b. il suffit alors de prendre la représentation en base 2 de i variant
      ZeroMemory(@FVertexes[c+4*i+1],SizeOf(TVect));      //de 0 à n-1, et de dire que 0 correspond à la coordonnée -1, et 1 correspond à la coordonnée 1, ainsi on aura bien
      ZeroMemory(@FVertexes[c+4*i+2],SizeOf(TVect));      //toutes les combinaisons possibles de 1 et de -1 pour les directions orthogonales à a et b.
      ZeroMemory(@FVertexes[c+4*i+3],SizeOf(TVect));
      u:=1;
      for j:=1 to FDim do begin  //on parcourt toutes les coordonnées du vecteur
        if (j=a) or (j=b) then   //si ce sont les coordonnées a ou b, on ne fait rien
          Continue;
        if (u and i)=u then      //sinon, si le bit de i vaut 1, la coordonnée est 1, sinon elle vaut -1
          v:=1
        else
          v:=-1;
        FVertexes[c+4*i,j]:=v;         //on modifie la coordonnée correspondante pour les 4 sommets du quadrilatère
        FVertexes[c+4*i+1,j]:=v;
        FVertexes[c+4*i+2,j]:=v;
        FVertexes[c+4*i+3,j]:=v;
        u:=u*2;
      end;
      FVertexes[c+4*i,a]:=1;           //pour les coordonnées numéro a et b, on prend celles du carré usuel dans l'ordre: (1,1) (-1,1) (-1,-1) (1,-1) pour avoir une courbe fermée
      FVertexes[c+4*i+1,a]:=1;
      FVertexes[c+4*i+2,a]:=-1;
      FVertexes[c+4*i+3,a]:=-1;
      FVertexes[c+4*i,b]:=1;
      FVertexes[c+4*i+1,b]:=-1;
      FVertexes[c+4*i+2,b]:=-1;
      FVertexes[c+4*i+3,b]:=1;
    end;
    c:=c+4*n;  //on a calculé en tout 4*n coordonnées supplémentaires, on décale l'indice de base
  end;

begin
  Randomize;         //réinitialisation de la fonction random
  FDim:=ComboBox1.ItemIndex+3;     //calcul de la nouvelle dimension
  GroupBox1.DestroyComponents;     //on détruit les trackbars de controle des angles
  t:=nil;
  for a:=0 to 3*(FDim-3)+2 do begin   //on crée les nouvelles trackbar
    t:=TTrackBar.Create(GroupBox1);
    t.Align:=alTop;
    t.Top:=10000;
    t.Height:=26;
    t.Min:=0;
    t.Max:=3000;
    t.Position:=Random(3000);      //position aléatoire
    t.TickMarks:=tmBoth;
    t.TickStyle:=tsNone;
    t.Tag:=a;
    t.OnChange:=TrackBarChange;    //événement pour calculer la matrice si l'utilisateur change un angle
    t.Parent:=GroupBox1;
    t.Tag:=Random(11)-5;           //vitesse de déplacement pour le mode animation
  end;
  GroupBox1.ClientHeight:=t.Height+t.Top+3;                   //on ajuste la hauteur de la groupbox
  SetLength(FVertexes,(FDim-1)*FDim*PowerOfTwo(FDim-1));      //cette formule donne le nombre de faces pour l'hypercube (multiplié par 4 car une face a 4 sommets)
  c:=0;
  n:=PowerOfTwo(FDim-2);
  for a:=1 to FDim-1 do     //on va parcourir toutes les directions de plan possibles en dimension n. Un plan est défini par 2 directions orthogonales ici, elles ont pour numéro
    for b:=a+1 to FDim do   //a et b par rapport à la base canonique
      MakeSubFaces;         //on crée pour la direction du plan, tous les carrés possibles en prenant toutes les combinaisons de 1 et de -1 pour les coordonnées de numéro différent de a et b
  MakeMatrix;               //on actualise la matrice de rotations
  Caption:='Hypercube: '+IntToStr((High(FVertexes)+1) div 4)+' faces'; //nombre total de faces
end;

procedure TForm1.TrackBarChange(Sender: TObject);    //cet événement est appelé lorsqu'une des trackbars créées automatiquement est modifiée
begin
  MakeMatrix;     //si l'utilisateur a changé une des trackbars, on recalcule la matrice de rotation.
end;

function MultMatrix(m,n:TMatrix):TMatrix;  //multiplication de 2 matrices
var
  a,b,c:Integer;
  s:Single;
begin
  for a:=1 to MaxDim do
    for b:=1 to MaxDim do begin
      s:=0;
      for c:=1 to MaxDim do
        s:=s+m[a,c]*n[c,b];
      Result[a,b]:=s;
    end;
end;

function GetIdentity:TMatrix;    //la matrice identité
var
  a:Integer;
begin
  ZeroMemory(@Result,SizeOf(Result));
  for a:=1 to MaxDim do
    Result[a,a]:=1;
end;

function MakeRotation(ID,IDD:Integer;Angle:Single):TMatrix;        //calcule la matrice de rotation dans le plan défini par les directions canoniques de numéros ID et IDD
begin
  Result:=GetIdentity;
  Result[ID,ID]:=Cos(Angle);
  Result[IDD,IDD]:=Result[ID,ID];
  Result[IDD,ID]:=Sin(Angle);
  Result[ID,IDD]:=-Result[IDD,ID];
end;

procedure TForm1.MakeMatrix;
var
  a:Integer;
begin
  if Tag<>0 then    //cette condition est utile pour le mode animation, pour ne pas recalculer à chaque fois la matrice
    Exit;
  FMatrix:=GetIdentity;
  FMatrix:=MultMatrix(FMatrix,MakeRotation(2,3,TTrackBar(GroupBox1.Controls[0]).Position*2*pi/3000));   //les 3 premières rotations sont dans l'espace usuel à 3 dimensions
  FMatrix:=MultMatrix(FMatrix,MakeRotation(3,1,TTrackBar(GroupBox1.Controls[1]).Position*2*pi/3000));
  FMatrix:=MultMatrix(FMatrix,MakeRotation(1,2,TTrackBar(GroupBox1.Controls[2]).Position*2*pi/3000));
  for a:=0 to 3*(FDim-3)-1 do
    FMatrix:=MultMatrix(FMatrix,MakeRotation((a mod 3)+1,(a div 3)+4,TTrackBar(GroupBox1.Controls[a+3]).Position*2*pi/3000));  //les suivantes sont dans tous les plans qui contiennent un vecteur de l'espace usuel et un vecteur dans son orthogonal
end;

function MultVect(m:TMatrix;v:TVect):TVect;   //multiplication d'un vecteur par une matrice
var
  a,b:Integer;
  s:Single;
begin
  for a:=1 to MaxDim do begin
    s:=0;
    for b:=1 to MaxDim do
      s:=s+m[a,b]*v[b];
    Result[a]:=s;
  end;
end;

function CrossP(u,v:TVect):TVect;       //produit vectoriel en dimension 3 (les autres coordonnées sont ignorées)
begin
  Result[1]:=u[2]*v[3]-u[3]*v[2];
  Result[2]:=u[3]*v[1]-u[1]*v[3];
  Result[3]:=u[1]*v[2]-u[2]*v[1];
end;

function Minus(u,v:TVect):TVect;   //différence de 2 vecteurs
var
  a:Integer;
begin
  for a:=1 to MaxDim do
    Result[a]:=u[a]-v[a];
end;

procedure TForm1.DrawScene;     //la procédure qui trace l'hypercube
var
  a:Integer;

  procedure DrawVertex(v:TVect);      //pour dessiner un vecteur
  begin                               //ici, on fait une projection implicite: seule les 3 premières coordonnées du vecteur sont utilisées, ça correspond à projeter orthogonalement
    glVertex3f(v[1],v[2],v[3]);       //l'espace de dimension n sur l'espace usuel de dimension 3
  end;

  procedure DrawFace(Id:Integer;Mode:Cardinal);   //pour dessiner une face à 4 côtés en fonction d'un mode de primitive opengl (par exemple GL_QUADS ou GL_LINE_LOOP)
  var
    t,u,v,w,n:TVect;
  begin
    t:=MultVect(FMatrix,FVertexes[Id]);         //on calcule la projection des 4 sommets de la face en utilisant la matrice de rotations
    u:=MultVect(FMatrix,FVertexes[Id+1]);
    v:=MultVect(FMatrix,FVertexes[Id+2]);
    w:=MultVect(FMatrix,FVertexes[Id+3]);
    n:=Crossp(Minus(t,v),Minus(u,w));           //on calcule le produit vectoriel pour avoir la normale
    glBegin(Mode);
    glNormal3f(n[1],n[2],n[3]);                 //la normale...
    DrawVertex(t);                              //... et les 4 coordonnées
    DrawVertex(u);
    DrawVertex(v);
    DrawVertex(w);
    glEnd;
  end;

  procedure DrawFaces(Mode:Cardinal);         //pour dessiner toutes les faces de l'hypercube en fonction d'un mode de primitive unique
  var
    a:Integer;
  begin
    for a:=0 to ((High(FVertexes)+1) div 4)-1 do
      DrawFace(4*a,Mode);
  end;

const
  Specular:array[0..3] of GlFloat=(0.8,0.3,0.1,1.0);

begin
  if CheckBox1.Checked then   //si on est en mode animation, on fait varier les angles de rotation
    Animate;
  glClearColor(0,0,0,0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);     //on efface la scène d'avant
  glViewport(0,0,ClientWidth-Panel1.Width,ClientHeight);   //viewport en fonction de la zone de tracé
  glMatrixMode(GL_PROJECTION);                             //calcul de la matrice de projection Opengl
  glLoadIdentity;
  gluPerspective(100,(ClientWidth-Panel1.Width)/ClientHeight,0.001,10);   //calcul de la perspective, avec un angle de 100° pour la caméra
  gluLookAt(0,0,3,0,0,0,0,1,0);                            //position de la caméra
  glColor3f(1,1,1);                  //couleur par défaut
  glEnable(GL_NORMALIZE);            //renormalisation automatique des vecteurs normaux
  glPushAttrib(GL_ALL_ATTRIB_BITS);  //pour éviter d'avoir a réinitialiser les paramètres par défaut
  glEnable(GL_LINE_SMOOTH);          //plus joli
  glEnable(GL_POLYGON_SMOOTH);       //plus joli
  case RadioGroup1.ItemIndex of      //choix du mode de tracé
    0:DrawFaces(GL_LINE_LOOP);       //lignes simples
    1:begin                          //faces éclairées
      glColor3f(0.4,0.6,0.5);        //couleur de base
      glEnable(GL_DEPTH_TEST);       //on doit utiliser le Z-buffer pour la gestion des faces cachées
      glEnable(GL_LIGHTING);         //on active la gestion de la lumière
      glEnable(GL_LIGHT0);           //on active la première lampe
      glEnable(GL_COLOR_MATERIAL);   //le matériau est assujeti à la couleur courante
      glColorMaterial(GL_FRONT_AND_BACK,GL_DIFFUSE); //la couleur courante va modifier la diffusion uniquement
      glMaterial(GL_FRONT_AND_BACK,GL_SHININESS,5);  //pour faire des reflets avec la lampe (donne un aspect plus "métallique")
      glMaterialfv(GL_FRONT_AND_BACK,GL_SPECULAR,@Specular);  //couleur spéculaire du matériau
      glLightModel(GL_LIGHT_MODEL_TWO_SIDE,1);                //les faces doivent être éclairées des 2 côtés car on n'a pas gèré l'orientation de la normale
      DrawFaces(GL_QUADS);                                    //on dessine les faces pleines
    end;
    2:begin                          //lignes cachées
      glDepthMask(GL_FALSE);                                  //Z-buffer en lecture seule
      glColorMask(GL_FALSE,GL_FALSE,GL_FALSE,GL_FALSE);       //color buffer en lecture seule
      glEnable(GL_STENCIL_TEST);                              //activation du test de stencil
      glClear(GL_STENCIL_BUFFER_BIT);                         //on vide le buffer de stencil
      glStencilFunc(GL_ALWAYS,1,1);                           //on va mettre ddes 1 partout où l'on trace
      glStencilOp(GL_KEEP,GL_KEEP,GL_REPLACE);
      DrawFaces(GL_LINE_LOOP);                                //on trace les lignes

      glPolygonOffset(0.8,0.8);                               //permet d'éviter des effets gênants de crênelage
      glEnable(GL_POLYGON_OFFSET_FILL);
      glEnable(GL_DEPTH_TEST);                                //on active le test de profondeur
      glDepthMask(GL_TRUE);                                   //mode écriture pour le Z-Buffer
      glStencilFunc(GL_EQUAL,1,1);                            //on ne tracera que là où le stencil vaut 1, c'est à dire où on a tracé les arêtes précédemment
      glStencilOp(GL_KEEP,GL_KEEP,GL_KEEP);                   //on ne modifie pas le stencil
      DrawFaces(GL_QUADS);                                    //on trace les faces pleines

      glColorMask(GL_TRUE,GL_TRUE,GL_TRUE,GL_TRUE);           //color buffer en mode écriture
      DrawFaces(GL_LINE_LOOP);                                //cette fois on trace les lignes pour de vrai, le test de profondeur empèchera de tracer les morceaux de lignes recouvertes par des faces.
    end;
    3:begin
      glLineWidth(3);                                         //lignes de largeur 3
      glDepthMask(GL_FALSE);                                  //idem que précédemment: le stencil vaut 1 partout où on trace les lignes
      glColorMask(GL_FALSE,GL_FALSE,GL_FALSE,GL_FALSE);
      glEnable(GL_STENCIL_TEST);
      glClear(GL_STENCIL_BUFFER_BIT);
      glStencilFunc(GL_ALWAYS,1,2);
      glStencilOp(GL_KEEP,GL_KEEP,GL_REPLACE);
      DrawFaces(GL_LINE_LOOP);

      glPolygonOffset(0.8,0.8);                               //idem que précédemment: on a mis à jour le Z-buffer partout où il y a des faces
      glEnable(GL_POLYGON_OFFSET_FILL);
      glEnable(GL_DEPTH_TEST);
      glDepthMask(GL_TRUE);
      glStencilFunc(GL_EQUAL,1,2);
      glStencilOp(GL_KEEP,GL_KEEP,GL_KEEP);
      DrawFaces(GL_QUADS);

      glColor3f(1,0.5,0);                                     //couleur rouge-orangé
      glColorMask(GL_TRUE,GL_TRUE,GL_TRUE,GL_TRUE);           //idem que précédemment, on trace des lignes larges partout où le test de profondeur le permet...
      glStencilOp(GL_KEEP,GL_KEEP,GL_INCR);                   //...mais cette fois on stocke 2 dans le stencil partout où les lignes sont visibles
      DrawFaces(GL_LINE_LOOP);

      glColor3f(0.4,0.6,0.5);                                 //on trace les polygones avec la lumière comme précédemment...
      glDepthFunc(GL_LEQUAL);
      glStencilFunc(GL_NOTEQUAL,2,2);                         //...mais cette fois si uniquement où le stencil ne vaut pas 2, c'est à dire où il n'y a pas de lignes visibles
      glStencilOp(GL_KEEP,GL_KEEP,GL_KEEP);
      glEnable(GL_LIGHTING);
      glEnable(GL_LIGHT0);
      glEnable(GL_COLOR_MATERIAL);
      glColorMaterial(GL_FRONT_AND_BACK,GL_DIFFUSE);
      glMaterial(GL_FRONT_AND_BACK,GL_SHININESS,5);
      glMaterialfv(GL_FRONT_AND_BACK,GL_SPECULAR,@Specular);
      glLightModel(GL_LIGHT_MODEL_TWO_SIDE,1);
      DrawFaces(GL_QUADS);

      glLineWidth(1);                                    //cette fois on va tracer les lignes cachées (fines et avec de l'alpha)
      glEnable(GL_BLEND);
      glColor4F(1,0.5,1,0.5);                            //couleur bleu-violet avec transparence
      glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
      glDisable(GL_DEPTH_TEST);
      glStencilFunc(GL_EQUAL,1,2);                       //on aura le droit de tracer uniquement là où le stencil vaut 1
      glStencilOp(GL_KEEP,GL_KEEP,GL_INCR);              //et on modifie le stencil pour que les lignes ne puissent pas se recouvrir 2 fois
      glDisable(GL_LIGHTING);
//      glEnable(GL_LINE_STIPPLE);
      glLineStipple(1,$1);
      DrawFaces(GL_LINE_LOOP);
    end;
    4:begin
      glLineWidth(3);
      glDepthMask(GL_FALSE);
      glColorMask(GL_FALSE,GL_FALSE,GL_FALSE,GL_FALSE);
      glEnable(GL_STENCIL_TEST);
      glClear(GL_STENCIL_BUFFER_BIT);
      glStencilFunc(GL_ALWAYS,1,1);
      glStencilOp(GL_KEEP,GL_KEEP,GL_REPLACE);
      DrawFaces(GL_LINE_LOOP);

      glPolygonOffset(0.8,0.8);
      glEnable(GL_POLYGON_OFFSET_FILL);
      glEnable(GL_DEPTH_TEST);
      glDepthMask(GL_TRUE);
      glStencilFunc(GL_EQUAL,1,1);
      glStencilOp(GL_KEEP,GL_KEEP,GL_KEEP);
      DrawFaces(GL_QUADS);

      glColorMask(GL_TRUE,GL_TRUE,GL_TRUE,GL_TRUE);
      DrawFaces(GL_LINE_LOOP);                          //jusque là c'est semblable au mode avec les lignes cachées

      glDisable(GL_DEPTH_TEST);
      glClear(GL_STENCIL_BUFFER_BIT);
      glEnable(GL_STENCIL_TEST);
      for a:=0 to ((High(FVertexes)+1) div 4)-1 do begin   //cette fois on trace les lignes cachées en pointillé
        glLineWidth(1);                                    //largeur des lignes cachées: 1
        glColorMask(GL_TRUE,GL_TRUE,GL_TRUE,GL_TRUE);
        glStencilFunc(GL_EQUAL,0,1);
        glStencilOp(GL_KEEP,GL_KEEP,GL_KEEP);
        glEnable(GL_LINE_STIPPLE);
        glLineStipple(1,$1);                               //motif en pointillé
        DrawFace(4*a,GL_LINE_LOOP);

        glLineWidth(3);                                    //cette étape interdit de tracer les lignes qui se recouvrent 2 fois
        glColorMask(GL_FALSE,GL_FALSE,GL_FALSE,GL_FALSE);
        glDisable(GL_LINE_STIPPLE);
        glStencilFunc(GL_ALWAYS,1,1);
        glStencilOp(GL_KEEP,GL_KEEP,GL_REPLACE);
        DrawFace(4*a,GL_LINE_LOOP);
      end;
    end;
  end;
  glPopAttrib;
end;

procedure TForm1.Animate;
var
  a,b:Integer;
begin
  Tag:=1;           //pour ne pas recalculer la matrice à chaque fois
  for a:=0 to GroupBox1.ControlCount-1 do           //pour toutes les trackbars créées, on fait varier leur position en fonction de la vitesse de déplacement stockée dans Tag
    with TTrackBar(GroupBox1.Controls[a]) do begin
      b:=Position+Tag;
      if bMax then
          Position:=Min+(b-Max)
        else
          Position:=b;
      end;
    end;
  Tag:=0;
  MakeMatrix;        //on calcule la matrice à la fin, en une seule fois
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  ComboBox1Change(nil);     //reset des angles
end;

function FloatToStr2(x:Single):string;   //cette fonction transforme un nombre en une chaine dans un format utilisable par POV-Ray
begin
  Str(x,Result);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);         //on écrit le source pour POV-Ray dans le répertoire du programme
var
  f:TextFile;
  a,n:Integer;
  v:TVect;
begin
  AssignFile(f,ExtractFilePath(APplication.ExeName)+'Vertexes.inc');   //on ouvre le fichier...
  ReWrite(f);                                                          //...en mode écriture
  try
    n:=(High(FVertexes)+1) div 4;
    WriteLn(f,'#declare FacesCount='+IntToStr(n)+';');
    WriteLn(f,'');
    WriteLn(f,'#declare Vertexes=array['+IntToStr(4*n)+'][3]');
    WriteLn(f,'{');
    for a:=0 to High(FVertexes) do begin        //on écrit toutes les coordonnées des sommets dans le fichier...
      v:=MultVect(FMatrix,FVertexes[a]);
      if a


Descargar la aplicación
 
Autor


También te puede interesar

Rotaciones en 3D con RAD Studio 
Una app para visualizar moléculas en 3D
Angulo creado por 3 segmentos en 3D
Modelado 3D con Delphi
Ejemplo de uso de Kinect con Delphi 
 
 
 
 
 
 
 

Simular el movimiento de burbujas



Para los aficionados a la física aquí tienen una aplicación que simula muy realísticamente el movimiento de burbujas.
Para cambiar la velocidad de su movimiento sólamente hay que modificar la propiedad "interval" del componente Timer1.
Realizada por daniel.davies@blueyonder.co.uk



UNIT Unit1;

INTERFACE

USES
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

TYPE
  TForm1 = CLASS(TForm)
    Image1: TImage;
    Timer1: TTimer;
    PROCEDURE FormCreate(Sender: TObject);
    PROCEDURE Timer1Timer(Sender: TObject);
    PROCEDURE QuitClick(Sender: TObject);
    PROCEDURE Image1Click(Sender: TObject);
  PRIVATE
    { Private declarations }
  PUBLIC
    { Public declarations }
  END;

TYPE
  co_ordinate = RECORD
    x, y: integer;
  END;

TYPE
  scanline = ARRAY [0 .. 319] OF byte;

VAR
  Form1: TForm1;
  Threshold: integer;
  blobimage: tbitmap;
  blobs: ARRAY [0 .. 5] OF co_ordinate;
  Frame: Cardinal;
  drawing: boolean;

IMPLEMENTATION

{$R *.DFM}

PROCEDURE TForm1.FormCreate(Sender: TObject);
VAR
  Temp: integer;
  pal: PLogPalette;
  hpal: HPALETTE;
BEGIN
  Frame := 0;

  blobimage := tbitmap.create;
  blobimage.width := 320;
  blobimage.height := 240;
  blobimage.PixelFormat := pf8bit;
  Image1.Picture.Bitmap := blobimage;

  pal := NIL;
  TRY
    GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
    pal.palVersion := $300;
    pal.palNumEntries := 256;
    FOR Temp := 0 TO 255 DO
    BEGIN
      pal.palPalEntry[Temp].peRed := 255 - Temp; { (temp * 4)-1; }
      pal.palPalEntry[Temp].peGreen := 0;
      pal.palPalEntry[Temp].peBlue := 128 - Temp;
    END;

    hpal := CreatePalette(pal^);
    IF hpal <> 0 THEN

      Image1.Picture.Bitmap.Palette := hpal;
  FINALLY
    FreeMem(pal);
  END;
  application.ProcessMessages;
  Timer1.Enabled := true;
END;

PROCEDURE TForm1.Timer1Timer(Sender: TObject);
VAR
  X_Loop, Y_Loop, I: integer;
  Value, t: integer;
  Scan: ^scanline;
BEGIN
  Frame := Frame + 1;
  IF drawing = false THEN
  BEGIN
    blobs[0].x := 160 + round(150 * SIN((2 * Frame) * 0.01745329252222));
    blobs[0].y := 100 + round(90 * SIN((4 * Frame) * 0.01745329252222));
    blobs[1].x := 160 + round(150 * SIN((6 * Frame) * 0.01745329252222));
    blobs[1].y := 100 + round(90 * SIN((3 * Frame) * 0.01745329252222));
    blobs[2].x := 160 + round(150 * SIN((7 * Frame) * 0.01745329252222));
    blobs[2].y := 100 + round(90 * SIN((5 * Frame) * 0.01745329252222));
    blobs[3].x := 160 + round(150 * SIN((3 * Frame) * 0.01745329252222));
    blobs[3].y := 100 + round(90 * SIN((2 * Frame) * 0.01745329252222));
    blobs[4].x := 160 + round(150 * SIN((4 * Frame) * 0.01745329252222));
    blobs[4].y := 100 + round(90 * SIN((2 * Frame) * 0.01745329252222));
    blobs[5].x := 160 + round(150 * SIN((2 * Frame) * 0.01745329252222));
    blobs[5].y := 100 + round(90 * SIN((3 * Frame) * 0.01745329252222));

    drawing := true;
    FOR Y_Loop := 0 TO 239 DO
    BEGIN
      Scan := Image1.Picture.Bitmap.scanline[Y_Loop];
      FOR X_Loop := 0 TO 319 DO
      BEGIN
        t := 0;
        FOR I := 0 TO 5 DO
        BEGIN
          Value := (blobs[I].x - X_Loop) * (blobs[I].x - X_Loop);
          Value := Value + (blobs[I].y - Y_Loop) * (blobs[I].y - Y_Loop);
          IF Value < 1 THEN
            Value := 1;
          t := t + (100000 DIV Value);
        END;
        t := 255 - t;
        IF t < 0 THEN
          t := 0;
        Scan[X_Loop] := t;
        { if t >= 200 then scan[x_loop] := 0 else scan[x_loop] := 10; }

      END;
    END;

    Image1.Refresh;
    application.ProcessMessages;
    drawing := false;
  END;
END;

PROCEDURE TForm1.QuitClick(Sender: TObject);
BEGIN
  Timer1.Enabled := false;
  application.Terminate;
END;

PROCEDURE TForm1.Image1Click(Sender: TObject);
BEGIN
  Timer1.Enabled := false;
  application.Terminate;
END;

END.

Descargar aplicación


También te puede interesar

Componente para generar efectos graficos
Librería Exif
Componente para manipulacion de imagenes
Morphing con delphi