Ir al contenido


Foto

TPelota


  • Por favor identifícate para responder
2 respuestas en este tema

#1 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 06 noviembre 2016 - 02:55

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
  1. unit Pelota;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages;
  7.  
  8. type
  9. TBox = (
  10. ParedIzquierda,
  11. Techo,
  12. ParedDerecha,
  13. Suelo
  14. );
  15.  
  16. UINT_PTR = DWORD; // Para 64bits
  17.  
  18. function sWinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
  19. procedure sTimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
  20.  
  21. type
  22. TPelota = class;
  23.  
  24. TWallEvent = procedure(Pelota: TPelota; Pared: TBox; var Rebote: BOOL) of object;
  25. TMissingEvent = procedure(Pelota: TPelota; Pared: TBox) of object;
  26. TStopEvent = procedure(Pelota: TPelota) of object;
  27.  
  28. TPelota = class
  29. private
  30. gdiplusToken: DWORD;
  31. Left, Top, Width, Height: integer;
  32. Rebote: BOOL;
  33. AutoTimer: BOOL;
  34. CR: double; // Cte de rotación : 360/(PI*Diámetro);
  35. FR: double; // Factor de rotación en bote
  36. Ao: double; // Angulo de rotación inicial;
  37. Bitmap, BitmapBak: HBITMAP; // Bitmap de la pelota
  38. BitmapDC, BitmapDCBak: HDC; // HDC de los Bitmaps
  39. function CreateBitmap(FileName: PWCHAR): HBITMAP;
  40. function WinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
  41. procedure TimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
  42. public
  43. CanDestroy: BOOL;
  44. Handle: THANDLE;
  45. OnStop: TStopEvent; // Evento: Cuando la pelota se para
  46. OnWall: TWallEvent; // Evento: Cuando la pelota alcanza la pared
  47. OnMissing: TMissingEvent; // Evento: Cuando la pelota sale fuera de su parent
  48. X,Y: double; // Posición precisa de la pelota
  49. Vox: double; // Velocidad inicial X
  50. Voy: double; // Velocidad inicial Y
  51. CF: double; // Coefeciente de frenada en bote
  52.  
  53. constructor Create(hParent: HWND; Visible: BOOL = true; AutoTimer: BOOL = false; FileName: PWCHAR = nil);
  54. destructor Destroy; override;
  55.  
  56. procedure Move(t: double); // Movimiento en un tiempo t
  57. procedure SetVisible(V: BOOL); // Visibilidad
  58. procedure SetAutoTimer(V: BOOL); // Timer interno
  59. end;
  60.  
  61.  
  62. // GDI+ Flat API...
  63. function GdiplusStartup(var GdiToken: DWORD; Startup, Output: PBYTE): Cardinal; stdcall external 'gdiplus';
  64. procedure GdiplusShutdown(GdiToken: DWORD); stdcall external 'gdiplus';
  65. function GdipCreateBitmapFromHBITMAP(hbm: HBITMAP; hpal: HPALETTE; var GBitmap: THANDLE): Cardinal; stdcall external 'gdiplus';
  66. function GdipCreateHBITMAPFromBitmap(GBitmap: THANDLE; var hBitmap: HBITMAP; BKColor: DWORD): DWORD; stdcall external 'gdiplus';
  67. function GdipDisposeImage(image: THANDLE): Cardinal; stdcall external 'gdiplus';
  68. function GdipImageRotateFlip(image: THANDLE; rfType: Cardinal): Cardinal; stdcall external 'gdiplus';
  69. function GdipCreateFromHDC(DC: HDC; var Graphics: Pointer): Cardinal; stdcall external 'gdiplus';
  70. function GdipRotateWorldTransform(graphics: Pointer; angle: Single; order: Cardinal): Cardinal; stdcall external 'gdiplus';
  71. function GdipTranslateWorldTransform(graphics: Pointer; sx, sy: Single; order: Cardinal): Cardinal; stdcall external 'gdiplus';
  72. function GdipDrawImage(graphics: Pointer; image: THANDLE; sx, sy: Single): Cardinal; stdcall external 'gdiplus';
  73. function GdipDeleteGraphics(graphics: Pointer): Cardinal; stdcall external 'gdiplus';
  74. function GdipDrawImageRect(graphics: Pointer; Image: THANDLE; x, y, w, h: Single): Cardinal; stdcall external 'gdiplus';
  75.  
  76. function GdipCreateBitmapFromFile(lpFileName: PWCHAR; var GBitmap: THANDLE): DWORD; stdcall external 'gdiplus';
  77.  
  78.  
  79. implementation
  80. {$R *.res}
  81.  
  82. function CreateHBITMAPFromFile(FileName: PWCHAR): HBITMAP;
  83. var
  84. GBitmap: THANDLE;
  85. begin
  86. Result:= 0;
  87. GdipCreateBitmapFromFile(FileName, GBitmap);
  88. GdipCreateHBITMAPFromBitmap(GBitmap, Result, 0);
  89. GdipDisposeImage(GBitmap);
  90. end;
  91.  
  92. procedure RotateDC(DC: HDC; x, y, Angle: Single);
  93. var
  94. Bitmap: HBITMAP;
  95. GBitmap: THANDLE;
  96. Graphics: Pointer;
  97. BitmapData: TagBITMAP;
  98. Rect: TRect;
  99. begin
  100. Bitmap:= GetCurrentObject(DC, OBJ_BITMAP);
  101. GetObject(Bitmap, sizeof(TagBITMAP), @BitmapData);
  102. Rect.Left:= 0; Rect.Right:= BitmapData.bmWidth; Rect.Top:= 0; Rect.Bottom:= BitmapData.bmHeight;
  103. GdipCreateBitmapFromHBITMAP(Bitmap, 0, GBitmap);
  104. FillRect(DC, Rect, 0);
  105. GdipCreateFromHDC(DC, Graphics);
  106. GdipTranslateWorldTransform(Graphics, -x, -y, 0);
  107. GdipRotateWorldTransform(Graphics, Angle, 1);
  108. GdipTranslateWorldTransform(Graphics, x, y, 1);
  109. GdipDrawImage(Graphics, GBitmap, 0, 0);
  110. GdipDisposeImage(GBitmap);
  111. GdipDeleteGraphics(Graphics);
  112. end;
  113.  
  114. //---------------------------------------------------------------------------
  115.  
  116. function sWinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
  117. var
  118. Pelota: TPelota;
  119. begin
  120. Pelota:= TPelota(GetWindowLong(Wnd, GWL_USERDATA));
  121. if Pelota <> nil then
  122. Result:= Pelota.WinProc(Wnd, uMsg, wParam, lParam)
  123. else
  124. Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  125. end;
  126.  
  127. procedure sTimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
  128. var
  129. Pelota: TPelota;
  130. begin
  131. Pelota:= TPelota(idEvent);
  132. if Pelota <> nil then
  133. Pelota.TimerProc(Wnd, uMsg, idEvent, dwTime);
  134. end;
  135. //---------------------------------------------------------------------------
  136.  
  137. const Interval = 20;
  138.  
  139. constructor TPelota.Create(hParent: HWND; Visible: BOOL = true; AutoTimer: BOOL = false; FileName: PWCHAR = nil);
  140. var
  141. GdiPlusStartupInput: array[0..1] of int64;
  142. bm: TBITMAP;
  143. WinClass: TWNDCLASS;
  144. Rgn: HRGN;
  145. begin
  146. // Inicializamos GDI+.
  147. GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0;
  148. GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil);
  149.  
  150. CanDestroy:= true; // Si false, no se destruye con WM_DESTROY
  151. OnWall:= nil; // Evento: Cuando la pelota alcanza la pared
  152. OnMissing:= nil; // Evento: Cuando la pelota sale fuera de su parent
  153. OnStop:= nil; // Evento: Cuando la pelota se para
  154. Left:= 0; // Posición de la Pelota en pantalla
  155. Top:= 0;
  156. FR:= 0; // Factor de rotación
  157. Ao:= 0; // Angulo inicial de rotación de la pelota
  158. X:= Left; // Posición de la Pelota alta precisión
  159. Y:= Top;
  160. CF:= 0.98; // Coeficiente de frenada en rebote
  161. Vox:= 1000; // Velocidad inicial X
  162. Voy:= 0; // Velocidad inicial Y
  163.  
  164. // Cargar Bitmaps
  165. Bitmap:= CreateBitmap(FileName);
  166. BitmapBak:= CreateBitmap(FileName);
  167.  
  168. // Obtengo DCs de Bitmaps y su tamaño
  169. BitmapDC:= CreateCompatibleDC(0);
  170. DeleteObject(SelectObject(BitmapDC, Bitmap));
  171. GetObject(Bitmap, sizeof(bm), @bm);
  172. BitmapDCBak:= CreateCompatibleDC(0);
  173. DeleteObject(SelectObject(BitmapDCBak, BitmapBak));
  174. Width:= bm.bmWidth;
  175. Height:= bm.bmHeight;
  176.  
  177. //Creamos la ventana
  178. ZeroMemory(@WinClass, sizeof(WinClass));
  179. WinClass.lpfnWndProc:= @sWinProc;
  180. WinClass.lpszClassName:= 'PelotaClass';
  181. RegisterClass(WinClass);
  182. Handle:= CreateWindowEx(WS_EX_TOOLWINDOW, WinClass.lpszClassName, 'Ball', WS_CHILD,
  183. 0, 0, Width, Height, hParent, 0, 0, nil);
  184. // Guardo el puntero this para acceder a esta clase desde funcion miembro static sWinProc
  185. SetWindowLong(Handle, GWL_USERDATA, LongInt(self));
  186.  
  187. // Hago una región redonda
  188. Rgn:= CreateRoundRectRgn(1, 1, Width+1, Height+1, Width, Height);
  189. SetWindowRgn(Handle, Rgn, true);
  190. DeleteObject(Rgn);
  191.  
  192. SetWindowPos(Handle, HWND_TOPMOST, 0,0,0,0, SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE);
  193. CR:= 90.0/Width; // Cte de rotación : 360/(PI*Image->Width);
  194.  
  195. SetAutoTimer(AutoTimer);
  196. SetVisible(Visible);
  197. end;
  198.  
  199. destructor TPelota.Destroy;
  200. begin
  201. DeleteObject(Bitmap);
  202. DeleteDC(BitmapDC);
  203. DeleteObject(BitmapBak);
  204. DeleteDC(BitmapDCBak);
  205.  
  206. // Shutdown GDI+
  207. GdiplusShutdown(gdiplusToken);
  208. end;
  209.  
  210. function Sign(d: double): integer;
  211. var
  212. R: PDWORD;
  213. begin
  214. Result:= 1; // asumo que es positivo
  215. R:= PDWORD(@d);
  216. inc(R);
  217. if ((R^ shr 31) and 1) = 1 then Result:= -1; // Es negativo
  218. if d = 0 then Result:= 0;
  219. end;
  220.  
  221. // Moviendo la pelota en un tiempo t
  222. procedure TPelota.Move(t: double);
  223. var
  224. Rgn: HRGN;
  225. DC: HDC;
  226. ParentRect: TRect;
  227. Vy, Xi, A: double;
  228. begin
  229. if GetParent(Handle) = 0 then exit;
  230.  
  231. GetClientRect(GetParent(Handle), ParentRect);
  232.  
  233. Rebote:= true;
  234. Vy:= 9.8*t; // Incremento de velocidad vertical;
  235. Xi:= Vox*t; // Incremento de X horizontal
  236.  
  237. // Posición de la pelota en un incremento de tiempo
  238. Y:= Y + 600*(Vy+Voy)*t; // El valor 600 es una escala
  239. X:= X + Xi; // Guardo la nueva posición
  240. Voy:= Voy + Vy; // Guardo la nueva velocidad de la pelota
  241.  
  242. // Angulo de rotación
  243. A:= Ao + Xi*CR*FR;
  244. Ao:= A;
  245.  
  246. // Rebote con el techo
  247. if Y < 0 then
  248. begin
  249. if @OnWall <> nil then OnWall(self, Techo, Rebote);
  250. if Rebote then
  251. begin
  252. Y:= 0;
  253. FR:= 0; // Factor de rotación en rebote
  254. Voy:= -Voy*CF; // reducción Y
  255. Vox:= Vox*CF; // reducción X
  256. end;
  257. end;
  258. // Salida por el techo
  259. if ((Y + Height) < 0) and (@OnWall <> nil) then
  260. OnMissing(self, Techo);
  261.  
  262. // Rebote en el suelo
  263. if (Y + Height) >= ParentRect.bottom then
  264. begin
  265. if @OnWall <> nil then OnWall(self, Suelo, Rebote);
  266. if Rebote then
  267. begin
  268. Y:= ParentRect.bottom - Height;
  269. FR:= 1/(1+Voy); // Factor de rotación en rebote
  270. Voy:= -Voy*CF; // reducción Y
  271. Vox:= Vox*CF; // reducción X
  272. end;
  273. end;
  274. // Salida por el suelo
  275. if (Y >= ParentRect.bottom) and (@OnMissing <> nil) then
  276. OnMissing(self, Suelo);
  277.  
  278. // Rebote con el pared izquierda
  279. if (X <= 0) then
  280. begin
  281. if @OnWall <> nil then OnWall(self, ParedIzquierda, Rebote);
  282. if Rebote then
  283. begin
  284. X:= 0;
  285. FR:= -FR*Sign(Voy)*Vox/1600;
  286. if CF<1 then Voy:= Voy-FR*Vox/1000;
  287. Voy:= Voy*CF; // reducción Y
  288. Vox:= -Vox*CF; // reducción X
  289. end;
  290. end;
  291. // Salida por la pared izquierda
  292. if ((X + Width) <= 0) and (@OnMissing <> nil) then
  293. OnMissing(self, ParedIzquierda);
  294.  
  295. // Rebote con el pared derecha
  296. if (X + Width) >= ParentRect.right then
  297. begin
  298. if @OnWall <> nil then OnWall(self, ParedDerecha, Rebote);
  299. if Rebote then
  300. begin
  301. X:= ParentRect.right - Width;
  302. FR:= FR*Sign(Voy)*Vox/1600;
  303. if CF<1 then Voy:= Voy+FR*Vox/1000;
  304. Voy:= Voy*CF; // reducción Y
  305. Vox:= -Vox*CF; // reducción X
  306. end;
  307. end;
  308. // Salida por la pared derecha
  309. if (X >= ParentRect.right) and (@OnMissing <> nil) then
  310. OnMissing(self, ParedDerecha);
  311.  
  312. // Cuando se para en el suelo
  313. if (Left = trunc(X)) and (Top = ParentRect.bottom - Height) and (@OnStop <> nil) then
  314. OnStop(self);
  315.  
  316. // Posiciono la pelota
  317. Left:= trunc(X);
  318. Top:= trunc(Y);
  319. MoveWindow(Handle, Left, Top, Width, Height, true);
  320.  
  321. // Rotación de la pelota
  322. BitBlt(BitmapDC, 0, 0, Width, Height, BitmapDCBak, 0, 0, SRCCOPY);
  323. RotateDC(BitmapDC, Width/2, Height/2, A);
  324. // ... y la pinto...
  325. DC:= GetDC(Handle);
  326. BitBlt(DC, 0, 0, Width, Height, BitmapDC, 0, 0, SRCCOPY);
  327. ReleaseDC(Handle, DC);
  328. end;
  329.  
  330. procedure TPelota.SetVisible(V: BOOL);
  331. begin
  332. if V then
  333. begin
  334. SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or WS_VISIBLE);
  335. SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE);
  336. end
  337. else
  338. SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and not WS_VISIBLE);
  339. end;
  340.  
  341. // Timer interno
  342. procedure TPelota.SetAutoTimer(V: BOOL);
  343. begin
  344. AutoTimer:= V;
  345. if AutoTimer then
  346. SetTimer(Handle, UINT_PTR(self), Interval, @sTimerProc)
  347. else KillTimer(Handle, UINT_PTR(self));
  348. end;
  349.  
  350. procedure TPelota.TimerProc(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
  351. begin
  352. Move(Interval/1000.0);
  353. end;
  354.  
  355. function TPelota.WinProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; stdcall;
  356. var
  357. ps: PAINTSTRUCT;
  358. DC: HDC;
  359. begin
  360. Result:= 0;
  361. case uMsg of
  362. WM_PAINT:
  363. begin
  364. DC:= BeginPaint(Wnd, ps);
  365. BitBlt(DC, 0, 0, Width, Height, BitmapDC, 0, 0, SRCCOPY);
  366. EndPaint(Wnd, ps);
  367. end;
  368. WM_DESTROY:
  369. if CanDestroy then
  370. PostQuitMessage(0); //Destruimos la ventana
  371. else
  372. // Función por defecto de tratamiento de mensajes.
  373. Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  374. end;
  375. end;
  376. //---------------------------------------------------------------------------
  377.  
  378. function TPelota.CreateBitmap(FileName: PWCHAR): HBITMAP;
  379. var
  380. DC: HDC;
  381. begin
  382. if FileName = nil then
  383. Result:= LoadBitmap(GetModuleHandle(nil), 'ID_PELOTA')
  384. else
  385. Result:= CreateHBITMAPFromFile(FileName);
  386. if Result = 0 then
  387. begin
  388. // Si no hay Bitmap creo uno vacio
  389. DC:= GetDC(0);
  390. Result:= CreateCompatibleBitmap(DC, 51, 51);
  391. ReleaseDC(0, DC);
  392. end;
  393. end;
  394.  
  395. end.

Ahora os muestro una broma de pelotas :D :D :D


delphi
  1. program Pelotas;
  2.  
  3. uses
  4. Windows,
  5. Messages,
  6. Pelota in 'Pelota.pas';
  7.  
  8. type
  9. TBroma = class
  10. private
  11. Count: integer;
  12. public
  13. constructor Create;
  14. procedure PelotaStop(Pelota: TPelota);
  15. end;
  16.  
  17. constructor TBroma.Create;
  18. begin
  19. Count:= 0;
  20. with TPelota.Create(GetDesktopWindow(), true, true) do
  21. begin
  22. CanDestroy:= false;
  23. OnStop:= PelotaStop;
  24. CF:= 0.95;
  25. end;
  26. with TPelota.Create(GetDesktopWindow(), true, true, 'Pelota7.png') do
  27. begin
  28. CanDestroy:= false;
  29. CF:= 1;
  30. Vox:= 700; // Velocidad inicial X
  31. end;
  32. end;
  33.  
  34. procedure TBroma.PelotaStop(Pelota: TPelota);
  35. begin
  36. with Pelota do
  37. begin
  38. X:= 0;
  39. Y:= 0;
  40. Vox:= 900 + random(300); // Velocidad inicial X
  41. Voy:= 0;
  42. if Count > 3 then
  43. Voy:= 10;
  44. CF:= 0.95;
  45. end;
  46.  
  47. if Count > 5 then exit;
  48. inc(Count);
  49.  
  50. with TPelota.Create(GetDesktopWindow(), true, true) do
  51. begin
  52. CanDestroy:= false;
  53. CF:= 1;
  54. Vox:= Pelota.Vox; // Velocidad inicial X
  55. end;
  56. end;
  57.  
  58.  
  59. var
  60. Msg: TMsg;
  61. Broma: TBroma;
  62. begin
  63. TBroma.Create();
  64.  
  65. // El bucle de mensajes
  66. while(GetMessage(Msg, 0, 0, 0)) do
  67. begin
  68. TranslateMessage(Msg);
  69. DispatchMessage(Msg);
  70. end;
  71. end.

Subo el código y ejecutable.

 

 

 

Saludos.

Archivos adjuntos


  • 4

#2 ELKurgan

ELKurgan

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 566 mensajes
  • LocationEspaña

Escrito 06 noviembre 2016 - 11:53

Muy buen código, maestro

 

Gracias y un saludo


  • 0

#3 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 07 noviembre 2016 - 07:45

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


  • 1




IP.Board spam blocked by CleanTalk.