2 replies to this topic

[escafandra]

Os presento una clase pelota que simula el comportamiento real de una pelota confinada en una ventana rebotando por sus paredes. Simula el movimiento uniformemente acelerado y el giro de la pelota, que se ve afectado por los choques. Se puede incluir un coeficiente de rozamiento, en cuyo caso, la pelota termina cayendo y rodando por el suelo hasta detenerse.

 

En principio usa como imagen un balón de fútbol, pero puede usarse otra como muestra el ejemplo adjunto.

 

El código lo escribí el año pasado como diversión y para mostrar a mi hijo el movimiento uniformemente acelerado, y como simularlo jugando con las leyes físicas. Aunque se puede mejorar, para mis propósitos salió bastante redondo.

 

Finalmente se me ocurrió escribir una broma en la que el escritorio se va llenando de pelotas que se multiplican cuando una cae y se para.

 

Os muestro el código de la clase:

delphi

unit Pelota;
 
interface
 
uses
  Windows, Messages;
 
type
TBox = (
  ParedIzquierda,
  Techo,
  ParedDerecha,
  Suelo
);
 
UINT_PTR = DWORD; // Para 64bits
 
function  sWinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
procedure sTimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
 
type
TPelota = class;
 
TWallEvent    = procedure(Pelota: TPelota; Pared: TBox; var Rebote: BOOL) of object;
TMissingEvent = procedure(Pelota: TPelota; Pared: TBox) of object;
TStopEvent    = procedure(Pelota: TPelota) of object;
 
TPelota = class
private
  gdiplusToken: DWORD;
  Left, Top, Width, Height: integer;
  Rebote: BOOL;
  AutoTimer: BOOL;
  CR: double;     // Cte de rotación : 360/(PI*Diámetro);
  FR: double;     // Factor de rotación en bote
  Ao: double;     // Angulo de rotación inicial;
  Bitmap, BitmapBak:   HBITMAP;     // Bitmap de la pelota
  BitmapDC, BitmapDCBak: HDC;       // HDC de los Bitmaps
  function  CreateBitmap(FileName: PWCHAR): HBITMAP;
  function  WinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
  procedure TimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
public
  CanDestroy: BOOL;
  Handle: THANDLE;
  OnStop: TStopEvent;       // Evento: Cuando la pelota se para
  OnWall: TWallEvent;       // Evento: Cuando la pelota alcanza la pared
  OnMissing: TMissingEvent; // Evento: Cuando la pelota sale fuera de su parent
  X,Y: double;    // Posición precisa de la pelota
  Vox: double;    // Velocidad inicial X
  Voy: double;    // Velocidad inicial Y
  CF: double;     // Coefeciente de frenada en bote
 
  constructor Create(hParent: HWND; Visible: BOOL = true; AutoTimer: BOOL = false; FileName: PWCHAR = nil);
  destructor  Destroy; override;
 
  procedure Move(t: double);       // Movimiento en un tiempo t
  procedure SetVisible(V: BOOL);   // Visibilidad
  procedure SetAutoTimer(V: BOOL); // Timer interno
end;
 
 
// GDI+ Flat API...
function  GdiplusStartup(var GdiToken: DWORD; Startup, Output: PBYTE): Cardinal; stdcall external 'gdiplus';
procedure GdiplusShutdown(GdiToken: DWORD); stdcall external 'gdiplus';
function  GdipCreateBitmapFromHBITMAP(hbm: HBITMAP; hpal: HPALETTE; var GBitmap: THANDLE): Cardinal; stdcall external 'gdiplus';
function  GdipCreateHBITMAPFromBitmap(GBitmap: THANDLE; var hBitmap: HBITMAP; BKColor: DWORD): DWORD; stdcall external 'gdiplus';
function  GdipDisposeImage(image: THANDLE): Cardinal; stdcall external 'gdiplus';
function  GdipImageRotateFlip(image: THANDLE; rfType: Cardinal): Cardinal; stdcall external 'gdiplus';
function  GdipCreateFromHDC(DC: HDC; var Graphics: Pointer): Cardinal; stdcall external 'gdiplus';
function  GdipRotateWorldTransform(graphics: Pointer; angle: Single; order: Cardinal): Cardinal; stdcall external 'gdiplus';
function  GdipTranslateWorldTransform(graphics: Pointer; sx, sy: Single; order: Cardinal): Cardinal; stdcall external 'gdiplus';
function  GdipDrawImage(graphics: Pointer; image: THANDLE; sx, sy: Single): Cardinal; stdcall external 'gdiplus';
function  GdipDeleteGraphics(graphics: Pointer): Cardinal; stdcall external 'gdiplus';
function  GdipDrawImageRect(graphics: Pointer; Image: THANDLE; x, y, w, h: Single): Cardinal; stdcall external 'gdiplus';
 
function  GdipCreateBitmapFromFile(lpFileName: PWCHAR; var GBitmap: THANDLE): DWORD; stdcall external 'gdiplus';
 
 
implementation
{$R *.res}
 
function CreateHBITMAPFromFile(FileName: PWCHAR): HBITMAP;
var
  GBitmap: THANDLE;
begin
  Result:= 0;
  GdipCreateBitmapFromFile(FileName, GBitmap);
  GdipCreateHBITMAPFromBitmap(GBitmap, Result, 0);
  GdipDisposeImage(GBitmap);
end;
 
procedure RotateDC(DC: HDC; x, y, Angle: Single);
var
  Bitmap: HBITMAP;
  GBitmap: THANDLE;
  Graphics: Pointer;
  BitmapData: TagBITMAP;
  Rect: TRect;
begin
  Bitmap:= GetCurrentObject(DC, OBJ_BITMAP);
  GetObject(Bitmap, sizeof(TagBITMAP), @BitmapData);
  Rect.Left:= 0; Rect.Right:= BitmapData.bmWidth; Rect.Top:= 0; Rect.Bottom:= BitmapData.bmHeight;
  GdipCreateBitmapFromHBITMAP(Bitmap, 0, GBitmap);
  FillRect(DC, Rect, 0);
  GdipCreateFromHDC(DC, Graphics);
  GdipTranslateWorldTransform(Graphics, -x, -y, 0);
  GdipRotateWorldTransform(Graphics, Angle, 1);
  GdipTranslateWorldTransform(Graphics, x, y, 1);
  GdipDrawImage(Graphics, GBitmap, 0, 0);
  GdipDisposeImage(GBitmap);
  GdipDeleteGraphics(Graphics);
end;
 
//---------------------------------------------------------------------------
 
function sWinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
var
  Pelota: TPelota;
begin
  Pelota:= TPelota(GetWindowLong(Wnd, GWL_USERDATA));
  if Pelota <> nil then
    Result:= Pelota.WinProc(Wnd, uMsg, wParam, lParam)
  else
    Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
end;
 
procedure sTimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
var
  Pelota: TPelota;
begin
  Pelota:= TPelota(idEvent);
  if Pelota <> nil then
    Pelota.TimerProc(Wnd, uMsg, idEvent, dwTime);
end;
//---------------------------------------------------------------------------
 
const Interval = 20;
 
constructor TPelota.Create(hParent: HWND; Visible: BOOL = true; AutoTimer: BOOL = false; FileName: PWCHAR = nil);
var
  GdiPlusStartupInput: array[0..1] of int64;
  bm: TBITMAP;
  WinClass: TWNDCLASS;
  Rgn: HRGN;
begin
  // Inicializamos GDI+.
  GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0;
  GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil);
 
  CanDestroy:= true; // Si false, no se destruye con WM_DESTROY
  OnWall:= nil;      // Evento: Cuando la pelota alcanza la pared
  OnMissing:= nil;   // Evento: Cuando la pelota sale fuera de su parent
  OnStop:= nil;      // Evento: Cuando la pelota se para
  Left:= 0;          // Posición de la Pelota en pantalla
  Top:= 0;
  FR:= 0;            // Factor de rotación
  Ao:= 0;            // Angulo inicial de rotación de la pelota
  X:= Left;          // Posición de la Pelota alta precisión
  Y:= Top;
  CF:= 0.98;         // Coeficiente de frenada en rebote
  Vox:= 1000;        // Velocidad inicial X
  Voy:= 0;           // Velocidad inicial Y
 
  // Cargar Bitmaps
  Bitmap:= CreateBitmap(FileName);
  BitmapBak:= CreateBitmap(FileName);
 
  // Obtengo DCs de Bitmaps y su tamaño
  BitmapDC:= CreateCompatibleDC(0);
  DeleteObject(SelectObject(BitmapDC, Bitmap));
  GetObject(Bitmap, sizeof(bm), @bm);
  BitmapDCBak:= CreateCompatibleDC(0);
  DeleteObject(SelectObject(BitmapDCBak, BitmapBak));
  Width:=  bm.bmWidth;
  Height:= bm.bmHeight;
 
  //Creamos la ventana
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @sWinProc;
  WinClass.lpszClassName:= 'PelotaClass';
  RegisterClass(WinClass);
  Handle:= CreateWindowEx(WS_EX_TOOLWINDOW, WinClass.lpszClassName, 'Ball', WS_CHILD,
                        0, 0, Width, Height, hParent, 0, 0, nil);
  // Guardo el puntero this para acceder a esta clase desde funcion miembro static sWinProc
  SetWindowLong(Handle, GWL_USERDATA, LongInt(self));
 
  // Hago una región redonda
  Rgn:= CreateRoundRectRgn(1, 1, Width+1, Height+1, Width, Height);
  SetWindowRgn(Handle, Rgn, true);
  DeleteObject(Rgn);
 
  SetWindowPos(Handle, HWND_TOPMOST, 0,0,0,0, SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE);
  CR:= 90.0/Width; // Cte de rotación : 360/(PI*Image->Width);
 
  SetAutoTimer(AutoTimer);
  SetVisible(Visible);
end;
 
destructor TPelota.Destroy;
begin
  DeleteObject(Bitmap);
  DeleteDC(BitmapDC);
  DeleteObject(BitmapBak);
  DeleteDC(BitmapDCBak);
 
  // Shutdown GDI+
  GdiplusShutdown(gdiplusToken);
end;
 
function Sign(d: double): integer;
var
  R: PDWORD;
begin
  Result:= 1;         // asumo que es positivo
  R:= PDWORD(@d);
  inc(R);
  if ((R^ shr 31) and 1) = 1 then Result:= -1;  // Es negativo
  if d = 0 then Result:= 0;
end;
 
// Moviendo la pelota en un tiempo t
procedure TPelota.Move(t: double);
var
  Rgn: HRGN;
  DC: HDC;
  ParentRect: TRect;
  Vy, Xi, A: double;
begin
  if GetParent(Handle) = 0 then exit;
 
  GetClientRect(GetParent(Handle), ParentRect);
 
  Rebote:= true;
  Vy:= 9.8*t;      // Incremento de velocidad vertical;
  Xi:= Vox*t;      // Incremento de X horizontal
 
  // Posición de la pelota en un incremento de tiempo
  Y:= Y + 600*(Vy+Voy)*t;  // El valor 600 es una escala
  X:= X + Xi;              // Guardo la nueva posición
  Voy:= Voy + Vy;          // Guardo la nueva velocidad de la pelota
 
  // Angulo de rotación
  A:= Ao + Xi*CR*FR;
  Ao:= A;
 
  // Rebote con el techo
  if Y < 0 then
  begin
    if @OnWall <> nil then OnWall(self, Techo, Rebote);
    if Rebote then
    begin
      Y:= 0;
      FR:= 0; // Factor de rotación en rebote
      Voy:= -Voy*CF;  // reducción Y
      Vox:= Vox*CF;   // reducción X
    end;
  end;
  // Salida por el techo
  if ((Y + Height) < 0) and (@OnWall <> nil) then
    OnMissing(self, Techo);
 
  // Rebote en el suelo
  if (Y + Height) >= ParentRect.bottom then
  begin
    if @OnWall <> nil then OnWall(self, Suelo, Rebote);
    if Rebote then
    begin
      Y:= ParentRect.bottom - Height;
      FR:= 1/(1+Voy); // Factor de rotación en rebote
      Voy:= -Voy*CF;  // reducción Y
      Vox:= Vox*CF;   // reducción X
    end;
  end;
  // Salida por el suelo
  if (Y >= ParentRect.bottom) and (@OnMissing <> nil) then
    OnMissing(self, Suelo);
 
  // Rebote con el pared izquierda
  if (X <= 0) then
  begin
    if @OnWall <> nil then OnWall(self, ParedIzquierda, Rebote);
    if Rebote then
    begin
      X:= 0;
      FR:= -FR*Sign(Voy)*Vox/1600;
      if CF<1 then Voy:= Voy-FR*Vox/1000;
      Voy:= Voy*CF;    // reducción Y
      Vox:= -Vox*CF;   // reducción X
    end;
  end;
  // Salida por la pared izquierda
  if ((X + Width) <= 0) and (@OnMissing <> nil) then
     OnMissing(self, ParedIzquierda);
 
  // Rebote con el pared derecha
  if (X + Width) >= ParentRect.right then
  begin
    if @OnWall <> nil then OnWall(self, ParedDerecha, Rebote);
    if Rebote then
    begin
      X:= ParentRect.right - Width;
      FR:= FR*Sign(Voy)*Vox/1600;
      if CF<1 then Voy:= Voy+FR*Vox/1000;
      Voy:= Voy*CF;    // reducción Y
      Vox:= -Vox*CF;   // reducción X
    end;
  end;
  // Salida por la pared derecha
  if (X >= ParentRect.right) and (@OnMissing <> nil) then
     OnMissing(self, ParedDerecha);
 
  // Cuando se para en el suelo
  if (Left = trunc(X)) and (Top = ParentRect.bottom - Height) and (@OnStop <> nil) then
    OnStop(self);
 
  // Posiciono la pelota
  Left:= trunc(X);
  Top:=  trunc(Y);
  MoveWindow(Handle, Left, Top, Width, Height, true);
 
  // Rotación de la pelota
  BitBlt(BitmapDC, 0, 0, Width, Height, BitmapDCBak, 0, 0, SRCCOPY);
  RotateDC(BitmapDC, Width/2, Height/2, A);
  // ... y la pinto...
  DC:= GetDC(Handle);
  BitBlt(DC, 0, 0, Width, Height, BitmapDC, 0, 0, SRCCOPY);
  ReleaseDC(Handle, DC);
end;
 
procedure TPelota.SetVisible(V: BOOL);
begin
  if V then
  begin
    SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or WS_VISIBLE);
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE);
  end
  else
    SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and not WS_VISIBLE);
end;
 
// Timer interno
procedure TPelota.SetAutoTimer(V: BOOL);
begin
  AutoTimer:= V;
  if AutoTimer then
    SetTimer(Handle, UINT_PTR(self), Interval, @sTimerProc)
  else KillTimer(Handle, UINT_PTR(self));
end;
 
procedure TPelota.TimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
begin
  Move(Interval/1000.0);
end;
 
function TPelota.WinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
var
  ps: PAINTSTRUCT;
  DC: HDC;
begin
  Result:= 0;
  case uMsg of
    WM_PAINT:
    begin
      DC:= BeginPaint(Wnd, ps);
      BitBlt(DC, 0, 0, Width, Height, BitmapDC, 0, 0, SRCCOPY);
      EndPaint(Wnd, ps);
    end;
    WM_DESTROY:
      if CanDestroy then
        PostQuitMessage(0);                //Destruimos la ventana
    else
      // Función por defecto de tratamiento de mensajes.
        Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  end;
end;
//---------------------------------------------------------------------------
 
function TPelota.CreateBitmap(FileName: PWCHAR): HBITMAP;
var
  DC: HDC;
begin
  if FileName = nil then
    Result:= LoadBitmap(GetModuleHandle(nil), 'ID_PELOTA')
  else
    Result:= CreateHBITMAPFromFile(FileName);
  if Result = 0 then
  begin
    // Si no hay Bitmap creo uno vacio
    DC:= GetDC(0);
    Result:= CreateCompatibleBitmap(DC, 51, 51);
    ReleaseDC(0, DC);
  end;
end;
 
end.

Ahora os muestro una broma de pelotas

delphi

program Pelotas;
 
uses
  Windows,
  Messages,
  Pelota in 'Pelota.pas';
 
type
TBroma = class
  private
    Count: integer;
  public
    constructor Create;
    procedure PelotaStop(Pelota: TPelota);
end;
 
constructor TBroma.Create;
begin
  Count:= 0;
  with TPelota.Create(GetDesktopWindow(), true, true) do 
  begin
    CanDestroy:= false;
    OnStop:= PelotaStop;
    CF:= 0.95;
  end;
  with TPelota.Create(GetDesktopWindow(), true, true, 'Pelota7.png') do
  begin
    CanDestroy:= false;
    CF:= 1;
    Vox:= 700;     // Velocidad inicial X
  end;
end;
 
procedure TBroma.PelotaStop(Pelota: TPelota);
begin
  with Pelota do
  begin
    X:= 0;
    Y:= 0;
    Vox:= 900 + random(300);     // Velocidad inicial X
    Voy:= 0;
    if Count > 3 then
    Voy:= 10;
    CF:= 0.95;
  end;
 
  if Count > 5 then exit;
  inc(Count);
 
  with TPelota.Create(GetDesktopWindow(), true, true) do
  begin
    CanDestroy:= false;
    CF:= 1;
    Vox:= Pelota.Vox;     // Velocidad inicial X
  end;
end;
 
 
var
  Msg: TMsg;
  Broma: TBroma;
begin
  TBroma.Create();
 
  // El bucle de mensajes
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.

Subo el código y ejecutable.

 

 

 

Saludos.

Attached Files

•  Pelotas.rar   35.77KB   28 downloads

[ELKurgan]

Muy buen código, maestro

 

Gracias y un saludo

[enecumene]

¡Genial!, ¿podrías donar un poco de tu ingenio vía transferencia o cualquier otro medio no dolorosa?