Recent

Author Topic: Simple ball bounce  (Read 9843 times)

Handoko

  • Hero Member
  • *****
  • Posts: 4723
  • My goal: build my own game engine using Lazarus
Re: Simple ball bounce
« Reply #15 on: February 02, 2022, 03:16:44 am »
I had a short explanation and demo for this flickering effect topic, in the link below click the Moving circles:
https://wiki.freepascal.org/Portal:HowTo_Demos#Graphics

furious programming

  • Hero Member
  • *****
  • Posts: 617
Re: Simple ball bounce
« Reply #16 on: February 02, 2022, 04:22:24 am »
You're absolutely right but, I am really surprised to see how much difference increasing the timer resolution has on flicker.

You can check whether the window rendering frequency actually affects the screen flicker frequency. Add a component to dynamicaly set the framerate and check from long intervals between rendering frames (e.g. seconds) to repainting without any gaps (without using Sleep function).

The main problem is that to avoid screen flickering, you need to block the canvas from updating (something like BeginUpdate and EndUpdate) so that successive rendering of individual elements (here: background and circles) does not cause the window content to refresh. I don't see anything like that in the code of this program, but I never use WinAPI directly, so it's hard for me to say exactly how this code works. If such a blockage does not exist, the use of back buffering becomes the only solution to completely exclude flicker.

Quote
In BobDogs implementation, even though he clears the window before every repaint, which would normally cause a lot of flicker, the increase in timer resolution _almost_ completely eliminates flicker.

In this particular example, the timeBeginPeriod and timeEndPeriod functions are used incorrectly, contrary to Microsoft's documentation. Not to mention that the imports of these functions should have exactly the same names as the original functions and the same parameters. Not only that — the framerate is also incorrectly implemented. And if that was not enough, this code is an anti-pattern when it comes to code formatting (i.e. the Object Pascal Style Guide). It is so sloppy that it will do more harm to its readers than good.

I know that the test program is mainly to present a solution to a specific problem and may have simplifications to save time while creating it, but for god's sake, learn to write code that is readable, according to accepted standards for its formatting and naming convention. Especially if such a code is to be published later and made available to everyone.
« Last Edit: February 02, 2022, 04:25:00 am by furious programming »
Lazarus 2.2.4 with FPC 3.2.2 (2022-05-15), Windows 10 — all 64-bit

Working on my own action/adventure game (similar to "The Legend of Zelda: ALttP") in retro style (pixelart), programming the engine and shell from scratch, using Free Pascal and SDL2. Release expected in 2025 at the earliest.

440bx

  • Hero Member
  • *****
  • Posts: 3159
Re: Simple ball bounce
« Reply #17 on: February 02, 2022, 05:32:07 am »
@Handoko,

As you point out in that thread, the use of a back buffer is the "traditional" and usually simplest way of avoiding flicker.


In this particular example, the timeBeginPeriod and timeEndPeriod functions are used incorrectly, contrary to Microsoft's documentation.
I essentially agree with everything you stated but, I am still very surprised that without any buffering that program manages to clear the area and repaint it with an extraordinarily small amount of flicker compared to what those actions normally produce. 

if you comment out the timer instructions then flicker becomes _very_ noticeable, uncomment and the amount of flicker is truly minimal.  I admit to not understanding why because there is no synchronization in the code to clear and draw at specific times (a common action quite a while back which was to synch with the vertical retrace to avoid flicker and tearing.)

FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 SP1 64bit.

GetMem

  • Hero Member
  • *****
  • Posts: 3817
Re: Simple ball bounce
« Reply #18 on: February 02, 2022, 06:39:31 am »
Not bouncing but still balls, metaballs to be more precise. The program was written by Jan Horn, more then twenty years ago. I just translated to Lazarus. Very interesting in my opinion.


PS: Windows only.

Roland57

  • Sr. Member
  • ****
  • Posts: 310
Re: Simple ball bounce
« Reply #19 on: February 02, 2022, 07:06:21 am »
Here is another example:
https://corpsman.de/index.php?doc=beispiele/pingpong

And a retouched version using BGRABitmap:
https://gitlab.com/rchastain/collisions
« Last Edit: February 02, 2022, 07:08:45 am by Roland57 »

Thaddy

  • Hero Member
  • *****
  • Posts: 12207
Re: Simple ball bounce
« Reply #20 on: February 02, 2022, 07:24:54 am »
Although balls are not square, for gaming we would start with
https://www.freepascal.org/docs-html/rtl/types/ptinrect.html

One could argue that square is a rough approximation....

For more advanced, look at box2d
« Last Edit: February 02, 2022, 07:28:10 am by Thaddy »
Manuals, manuals, manuals first.
You have incompetence and sheer incompetence.

440bx

  • Hero Member
  • *****
  • Posts: 3159
Re: Simple ball bounce
« Reply #21 on: February 02, 2022, 08:04:29 am »
Very interesting in my opinion.
It certainly  is.  Thank you for sharing that.



@Roland,

Interesting website in that link you posted.  I'll be checking out your version using BGRABitmap sometime (hopefully soon).
FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 SP1 64bit.

furious programming

  • Hero Member
  • *****
  • Posts: 617
Re: Simple ball bounce
« Reply #22 on: February 02, 2022, 07:48:52 pm »
I essentially agree with everything you stated but, I am still very surprised that without any buffering that program manages to clear the area and repaint it with an extraordinarily small amount of flicker compared to what those actions normally produce.

I am also curious at what frequencies the flicker exists and at which it disappears. But here everything additionally depends on the screen refresh rate and CPU power.

Quote
if you comment out the timer instructions then flicker becomes _very_ noticeable, uncomment and the amount of flicker is truly minimal.  I admit to not understanding why because there is no synchronization in the code to clear and draw at specific times (a common action quite a while back which was to synch with the vertical retrace to avoid flicker and tearing.)

The reason most likely is that the default interval is greater than 7, so fewer frames are rendered in one second. So calling Delay(7) does not suspend the thread for 7ms, but about 10ms (needs to be checked). A larger interval is used by default by the system to reduce the frequency of switching tasks by the sheduler, thus increasing the system performance.

Play around with this and try to figure out what the framerate is with and without calling these time functions.
Lazarus 2.2.4 with FPC 3.2.2 (2022-05-15), Windows 10 — all 64-bit

Working on my own action/adventure game (similar to "The Legend of Zelda: ALttP") in retro style (pixelart), programming the engine and shell from scratch, using Free Pascal and SDL2. Release expected in 2025 at the earliest.

BobDog

  • Sr. Member
  • ****
  • Posts: 364
Re: Simple ball bounce
« Reply #23 on: February 02, 2022, 08:05:17 pm »
@furious programming
You say
 "timeBeginPeriod and timeEndPeriod functions are used incorrectly".
Agreed, larger projects (web browsers e.t.c. will timeBeginPeriod at the application start, also Java runtime applications) so any intervening code running will also run at the one millisecond (smallest resolution) e.g. any compiled source code snippets which are running.
However my small application only needs the minimum resolution during a sleep, so anything else running is not affected.
This is pretty standard i would say.
I do not use winmain or winproc, so my gdi is a barebones affair.
I have eliminated flickering altogether, I have added an up/down arrow option to alter the framerate.
Code: Pascal  [Select][+][-]
  1.  
  2.  
  3.  
  4. program balls;
  5. {$mode delphi}
  6. uses windows,sysutils;
  7.     const
  8.     DC_BRUSH=18;
  9.     DC_PEN=19;
  10.    
  11.     Type V2=object
  12.      x,y,dx,dy:single;
  13.      radius:integer;
  14.      c:longword;
  15.      procedure SetF(xx,yy,ddx,ddy:single;rradius:integer;cc:longword);
  16.      End;
  17.      
  18.     procedure V2.SetF(xx,yy,ddx,ddy:single;rradius:integer;cc:longword);
  19.     begin
  20.     x:=xx;y:=yy;dx:=ddx;dy:=ddy;radius:=rradius;c:=cc;
  21.     end;  
  22.  
  23. type aov=array[1..5] of v2;
  24.  
  25.     function SetDCBrushColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCBrushColor';
  26.     function SetDCPenColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCPenColor';
  27.     Function settimer(n:longword=1):MMRESULT;stdcall external 'winmm.dll' name 'timeBeginPeriod';
  28.     Function freetimer(n:longword=1):MMRESULT;stdcall external 'winmm.dll' name 'timeEndPeriod';
  29.    
  30.    
  31.    procedure ClearScreen(h:hdc);
  32.    var
  33.    colour:longword;
  34.    begin
  35.     colour:=rgb(255,255,255);
  36.     SetDCBrushColor(h,colour);
  37.     SetDCPenColor(h,colour);
  38.     rectangle(h,0,0,810,630);
  39.    end;
  40.    
  41.  
  42.  
  43.      procedure MoveAndDraw(wh:hdc;var b:aov);
  44.      var i,r:integer;
  45.      begin
  46.      for i:=low(b) to high(b) do
  47.      begin
  48.      r:=b[i].radius;
  49.      b[i].x:=b[i].x+b[i].dx;
  50.      b[i].y:=b[i].y+b[i].dy;
  51.      SetDCBrushColor(wh,b[i].c);
  52.      SetDCPenColor(wh,b[i].c);
  53.      ellipse(wh,trunc(b[i].x-r),trunc(b[i].y-r),trunc(b[i].x+r),trunc(b[i].y+r));
  54.      end;
  55.      end;
  56.      
  57.      procedure HandleEdges(var b:aov);
  58.      var i,r:integer;
  59.      begin
  60.      for i:=low(b) to high(b) do
  61.      begin
  62.      r:=b[i].radius;
  63.      if (b[i].x<r) then begin b[i].x:=r;b[i].dx:=-b[i].dx; end;
  64.      if (b[i].x>(800-r)) then begin b[i].x:=800-r;b[i].dx:=-b[i].dx; end;
  65.      
  66.      if (b[i].y<r) then begin b[i].y:=r;b[i].dy:=-b[i].dy; end;
  67.      if (b[i].y>(600-r)) then begin b[i].y:=600-r;b[i].dy:=-b[i].dy; end
  68.      end;
  69.      
  70.      end;
  71.      
  72.      
  73.  function HandleBallCollisions(Var b:aov):boolean ;
  74. Var
  75.   L,impulsex,impulsey,dot,impactx,impacty: single;
  76.   ma,mb,f1,f2: single;
  77.   n1,n2: Integer;
  78.   flag:boolean=false;
  79. Begin
  80.   For n1 :=low(b) To high(b) -1 Do
  81.     Begin
  82.       For n2 :=n1+1 To high(b) Do
  83.         Begin
  84.           L := Sqrt( (b[n1].x-b[n2].x)*(b[n1].x-b[n2].x) + (b[n1].y-b[n2].y)*(b[n1].y-b[n2].y));
  85.           If L< (b[n1].radius+b[n2].radius) Then
  86.             Begin
  87.             flag:=true;
  88.               impulsex := (b[n1].x-b[n2].x)/L ;
  89.               impulsey := (b[n1].y-b[n2].y)/L ;
  90.               // in case of large overlap (non analogue motion)
  91.               b[n1].x := b[n2].x+(b[n1].radius+b[n2].radius)*impulsex ;
  92.               b[n1].y := b[n2].y+(b[n1].radius+b[n2].radius)*impulsey ;
  93.  
  94.               impactx := b[n1].dx-b[n2].dx ;
  95.               impacty := b[n1].dy-b[n2].dy ;
  96.               dot := impactx*impulsex+impacty*impulsey ;
  97.               ma := b[n1].radius;
  98.               mb := b[n2].radius;
  99.               ma := ma*ma;   // weigh by area (radius squared)
  100.               mb := mb*mb;
  101.               f1 := 2*mb/(ma+mb);   // ball weight factors
  102.               f2 := 2*ma/(ma+mb);
  103.               b[n1].dx:= b[n1].dx-dot*impulsex *f1;
  104.               b[n1].dy:= b[n1].dy-dot*impulsey *f1;
  105.               b[n2].dx:=b[n2].dx+ dot*impulsex *f2 ;
  106.               b[n2].dy:= b[n2].dy+dot*impulsey *f2 ;
  107.             End;
  108.         End; // n2
  109.     End;  // n1
  110.     exit(flag);
  111. End;
  112.      
  113.  Function Regulate(const MyFps:int32;var fps:int32):int32;
  114.  const
  115.  timervalue:double =0;_lastsleeptime:double=0;t3:double=0;frames:double=0;
  116.     Var t,sleeptime:double;
  117.     begin
  118.     t:=gettickcount64/1000;
  119.     frames:=frames+1;
  120.     If (t-t3)>=1.0 Then begin t3:=t;fps:=trunc(frames);frames:=0; end;
  121.      sleeptime:=(_lastsleeptime+((1/myfps)-(t)+timervalue)*1000);
  122.     If (sleeptime<1) Then sleeptime:=1;
  123.     _lastsleeptime:=sleeptime;
  124.     timervalue:=t;
  125.     exit( trunc(sleeptime));
  126. End;
  127.  
  128. Var
  129.   p:hwnd;
  130.   wh:hdc;
  131.   b:aov;
  132.   emsg:msg;
  133.   fps:int32=0;
  134.  Memhdc,Membitmap:hdc;
  135.  myfps:integer=60;
  136.  
  137. begin
  138. b[1].setf(100,100,1.75,1.75,35,rgb(255,100,0));
  139. b[2].setf(300,300,0,0,35,rgb(0,255,0));
  140. b[3].setf(400,400,0,0,40,rgb(0,0,255));
  141. b[4].setf(500,500,0,0,30,rgb(0,100,255));
  142. b[5].setf(200,200,0,0,20,rgb(200,100,255));
  143.  
  144.      p:=CreateWindowEx( WS_EX_TOPMOST Or WS_EX_TOOLWINDOW,'#32770','Press ESCAPE key to finish . . .',(WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE,200,200,810,630,0,0,0,nil);
  145.      wh:=GetDC(p);
  146.      
  147.     Memhdc := CreateCompatibleDC(wh);
  148.         Membitmap := CreateCompatibleBitmap(wh, 810, 630);
  149.         SelectObject(Memhdc,GetStockObject(DC_BRUSH));
  150.     SelectObject(Memhdc,GetStockObject(DC_PEN));
  151.         SelectObject(Memhdc, Membitmap);
  152.    
  153.     freeconsole();
  154.  
  155.     while true do
  156.     begin
  157. while(int64(PeekMessage(@eMsg,0, 0, 0, PM_REMOVE)) > 0) do
  158.     begin
  159.      TranslateMessage (@eMsg);
  160.      DispatchMessage (@eMsg);
  161.     if boolean(GetAsyncKeyState($28)) then myfps:=myfps-1;
  162.     if boolean(GetAsyncKeyState($26)) then myfps:=myfps+1;
  163.     if boolean(GetAsyncKeyState($1B)) then
  164.     begin
  165.     DeleteObject(Membitmap);
  166.         DeleteDC    (Memhdc);
  167.     exit;
  168.     end;
  169.     if myfps<5 then myfps:=5;
  170.      end;
  171.  
  172. HandleEdges(b);
  173. HandleBallCollisions(b);
  174. ClearScreen(Memhdc);
  175. exttextouta(Memhdc,10,10,ETO_CLIPPED,nil,pchar('Use up/down arrowkeys to adjust framerate'),45,nil);
  176. exttextouta(Memhdc,10,30,ETO_CLIPPED,nil,pchar('fps required = '+(IntToStr(myfps))),18,nil);
  177. exttextouta(Memhdc,10,50,ETO_CLIPPED,nil,pchar('fps = '+(IntToStr(fps))),10,nil);
  178. MoveAndDraw(Memhdc,b);
  179.  
  180. BitBlt(wh, 0, 0, 810, 630,Memhdc, 0, 0,SRCCOPY);
  181.  
  182. settimer();
  183. sleep(regulate(myfps,fps));
  184. freetimer();
  185.     end;
  186.    
  187.  
  188. end.
  189.  
  190.  
  191.  




« Last Edit: February 03, 2022, 12:25:10 pm by BobDog »

Roland57

  • Sr. Member
  • ****
  • Posts: 310
Re: Simple ball bounce
« Reply #24 on: February 04, 2022, 03:10:39 am »
@Roland,

Interesting website in that link you posted.  I'll be checking out your version using BGRABitmap sometime (hopefully soon).

Indeed, it is a very interesting website.

Here is another version of the bouncing balls, using TCairoPaintBox from LuiPack.

User's guide: Press ESC to quit.
« Last Edit: February 04, 2022, 11:04:27 am by Roland57 »

BobDog

  • Sr. Member
  • ****
  • Posts: 364
Re: Simple ball bounce
« Reply #25 on: February 05, 2022, 12:45:03 pm »

Slightly improved version.
Detectballcollisions function added.
This removes the necessity of calculating a distance (sqrt(sqr,sqr)) for every combination of two balls, and only uses abs(subtract).
The sqrt(sqr,sqr) is only used if the absolute (subtract) is getting close to a collision.
Should be faster for many balls, but not noticeable for a few balls.
Gdi non flicker method for the graphics.
Added custom text methods.
Code: Pascal  [Select][+][-]
  1.  
  2.  
  3.  
  4. program balls;
  5. {$mode delphi}
  6.  
  7. uses windows,sysutils;
  8.  
  9.     const
  10.     DC_BRUSH=18;
  11.     DC_PEN=19;
  12.      xres=1024;
  13.      yres=768;
  14.      
  15.     Type V2=object
  16.      x,y,dx,dy:single;
  17.      radius:integer;
  18.      c:longword;
  19.      procedure SetF(xx,yy,ddx,ddy:single;rradius:integer;cc:longword);
  20.      End;
  21.      
  22.     procedure V2.SetF(xx,yy,ddx,ddy:single;rradius:integer;cc:longword);
  23.     begin
  24.     x:=xx;y:=yy;dx:=ddx;dy:=ddy;radius:=rradius;c:=cc;
  25.     end;  
  26.  
  27. type aov=array[1..9] of v2;
  28.  
  29.     function SetDCBrushColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCBrushColor';
  30.     function SetDCPenColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCPenColor';
  31.     Function settimer(n:longword=1):MMRESULT;stdcall external 'winmm.dll' name 'timeBeginPeriod';
  32.     Function freetimer(n:longword=1):MMRESULT;stdcall external 'winmm.dll' name 'timeEndPeriod';
  33.    
  34.    procedure ClearScreen(h:hdc);
  35.    var
  36.    colour:longword;
  37.    begin
  38.     colour:=rgb(55,255,255);
  39.     SetDCBrushColor(h,colour);
  40.     SetDCPenColor(h,colour);
  41.     rectangle(h,0,0,xres,yres);
  42.    end;
  43.    
  44.      procedure MoveAndDraw(Memory:hdc;GDIScreen:hdc;var b:aov;var energy:single);
  45.      var i,r:integer;
  46.      begin
  47.      energy:=0;
  48.      for i:=low(b) to high(b) do
  49.      begin
  50.      r:=b[i].radius;
  51.      b[i].x:=b[i].x+b[i].dx;
  52.      b[i].y:=b[i].y+b[i].dy;
  53.      SetDCBrushColor(Memory,b[i].c);
  54.      SetDCPenColor(Memory,b[i].c);
  55.      ellipse(Memory,trunc(b[i].x-r),trunc(b[i].y-r),trunc(b[i].x+r),trunc(b[i].y+r));
  56.      energy:=energy+ 0.5*(b[i].radius*b[i].radius)*(b[i].dx*b[i].dx + b[i].dy*b[i].dy);
  57.      end;
  58.      BitBlt(GDIScreen, 0, 0, xres, yres,Memory, 0, 0,SRCCOPY);
  59.      end;
  60.      
  61.      procedure HandleEdges(var b:aov);
  62.      var i,r:integer;
  63.      begin
  64.      for i:=low(b) to high(b) do
  65.      begin
  66.      r:=b[i].radius;
  67.      if (b[i].x<r) then begin b[i].x:=r;b[i].dx:=-b[i].dx; end;
  68.      if (b[i].x>(xres-r)) then begin b[i].x:=xres-r;b[i].dx:=-b[i].dx; end;
  69.      
  70.      if (b[i].y<r) then begin b[i].y:=r;b[i].dy:=-b[i].dy; end;
  71.      if (b[i].y>(yres-r-25)) then begin b[i].y:=yres-r-25;b[i].dy:=-b[i].dy; end
  72.      end;
  73.      
  74.      end;
  75.  
  76.  function DetectBallCollisions(b1:V2;b2:V2):single;
  77.  var
  78.     xdiff,ydiff,L:single;
  79.     begin
  80.     xdiff:=b2.x-b1.x;
  81.     ydiff:=b2.y-b1.y;
  82.     If Abs(xdiff) > (b2.radius+b1.radius) Then exit(0);
  83.     If Abs(ydiff) > (b2.radius+b1.radius) Then exit(0);
  84.     L:=Sqrt(xdiff*xdiff+ydiff*ydiff);
  85.     If (L<=(b2.radius+b1.radius)) Then exit(L) else exit(0);
  86. End;
  87.  
  88.      
  89.      
  90.  function HandleBallCollisions(Var b:aov):boolean ;
  91. Var
  92.   L,impulsex,impulsey,dot,impactx,impacty: single;
  93.   ma,mb,f1,f2,ln: single;
  94.   n1,n2: Integer;
  95.   flag:boolean=false;
  96. Begin
  97.   For n1 :=low(b) To high(b) -1 Do
  98.     Begin
  99.       For n2 :=n1+1 To high(b) Do
  100.         Begin
  101.         L:=DetectBallCollisions(b[n1],b[n2]);
  102.          
  103.           if (L<>0) then
  104.             Begin
  105.             flag:=true;
  106.            
  107.               impulsex := (b[n1].x-b[n2].x) ;
  108.               impulsey := (b[n1].y-b[n2].y) ;
  109.               ln:=Sqrt(impulsex*impulsex+impulsey*impulsey);
  110.               impulsex:=impulsex/ln; // normalize impulse
  111.               impulsey:=impulsey/ln;
  112.              
  113.               // in case of large overlap (non analogue motion)
  114.               b[n1].x := b[n2].x+(b[n1].radius+b[n2].radius)*impulsex ;
  115.               b[n1].y := b[n2].y+(b[n1].radius+b[n2].radius)*impulsey ;
  116.  
  117.               impactx := b[n1].dx-b[n2].dx ;
  118.               impacty := b[n1].dy-b[n2].dy ;
  119.               dot := impactx*impulsex+impacty*impulsey ;
  120.               ma := b[n1].radius;
  121.               mb := b[n2].radius;
  122.               ma := ma*ma;   // weigh by area (radius squared)
  123.               mb := mb*mb;
  124.               f1 := 2*mb/(ma+mb);   // ball weight factors
  125.               f2 := 2*ma/(ma+mb);
  126.               b[n1].dx:= b[n1].dx-dot*impulsex *f1;
  127.               b[n1].dy:= b[n1].dy-dot*impulsey *f1;
  128.               b[n2].dx:=b[n2].dx+ dot*impulsex *f2 ;
  129.               b[n2].dy:= b[n2].dy+dot*impulsey *f2 ;
  130.             End;
  131.         End; // n2
  132.     End;  // n1
  133.     exit(flag);
  134. End;
  135.    
  136.  Function Regulate(const MyFps:int32;var fps:int32):int32;
  137.  const
  138.  timervalue:double =0;_lastsleeptime:double=0;t3:double=0;frames:double=0;
  139.     Var t,sleeptime:double;
  140.     begin
  141.     t:=gettickcount64/1000;
  142.     frames:=frames+1;
  143.     If (t-t3)>=1.0 Then begin t3:=t;fps:=trunc(frames);frames:=0; end;
  144.      sleeptime:=(_lastsleeptime+((1/myfps)-(t)+timervalue)*1000);
  145.     If (sleeptime<1) Then sleeptime:=1;
  146.     _lastsleeptime:=sleeptime;
  147.     timervalue:=t;
  148.     exit( trunc(sleeptime));
  149. End;
  150.  
  151. procedure setfontsize(h:hdc;size:int32;style:ansistring);
  152. begin
  153.  SelectObject(h,CreateFont(size,0,0,0,400,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,VARIABLE_PITCH,pchar(style)));
  154. end;
  155.  
  156. procedure setfontcolours(h:hdc;text:longword;background:longword);
  157. begin
  158. SetTextColor(h,text);
  159. SetBkColor(h,background);
  160. end;
  161.  
  162. procedure text(h:hdc;x:int32;y:int32;s:ansistring);
  163. var
  164. L:int32;
  165. begin
  166. l:=length(s);
  167. textouta(h,x,y,pchar(s),L);
  168. end;
  169.  
  170. Var
  171.   p:hwnd;
  172.   b:aov;
  173.   emsg:msg;
  174.   fps:int32=0;
  175.  Memhdc,Membitmap,wh:hdc;
  176.  myfps:integer=60;
  177.  energy:single=0;
  178.  j:integer;
  179.  
  180.  
  181. begin
  182. b[1].setf(100,100,2.75,2.75,35,rgb(255,100,0));
  183. b[2].setf(300,300,0,0,35,rgb(0,255,0));
  184. b[3].setf(400,400,0,0,40,rgb(0,0,255));
  185. b[4].setf(500,500,0,0,30,rgb(0,100,255));
  186. b[5].setf(200,200,0,0,20,rgb(200,100,255));
  187. b[6].setf(200,300,0,0,35,rgb(255,255,255));
  188. b[7].setf(600,300,0,0,27,rgb(255,100,0));
  189. b[8].setf(600,600,0,0,25,rgb(255,255,0));
  190. b[9].setf(650,650,0,0,23,rgb(255,55,255));
  191.    
  192.     p:=CreateWindowEx( WS_EX_TOPMOST Or WS_EX_TOOLWINDOW ,'#32770','Press ESCAPE key to finish . . .',(WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE,200,200,xres,yres,0,0,0,nil);
  193.     wh:=GetDC(p);
  194.     Memhdc := CreateCompatibleDC(wh);
  195.         Membitmap := CreateCompatibleBitmap(wh, xres, yres);// 810, 630
  196.         SelectObject(Memhdc,GetStockObject(DC_BRUSH));
  197.     SelectObject(Memhdc,GetStockObject(DC_PEN));
  198.         SelectObject(Memhdc, Membitmap);
  199.         setfontsize(Memhdc,20,'courier new');
  200.     setfontcolours(Memhdc,rgb(0,0,200),rgb(55,255,255));
  201.    
  202.     freeconsole();
  203.  
  204.     while true do
  205.     begin
  206.  
  207. while(int64(PeekMessage(@eMsg,0, 0, 0, PM_REMOVE)) > 0) do
  208.     begin
  209.      TranslateMessage (@eMsg);
  210.      DispatchMessage (@eMsg);
  211.    
  212.     if boolean(GetAsyncKeyState(VK_DOWN)) then myfps:=myfps-1;
  213.     if boolean(GetAsyncKeyState(VK_UP)) then myfps:=myfps+1;
  214.    
  215.     if boolean(GetAsyncKeyState(VK_LEFT))  then
  216.     begin
  217.     for j:=low(b) to high(b) do
  218.     if b[j].dx>=0 then b[j].dx:=b[j].dx-0.01 else b[j].dx:=b[j].dx+0.01
  219.     end;
  220.    
  221.     if boolean(GetAsyncKeyState(VK_RIGHT)) then
  222.     begin
  223.     for j:=low(b) to high(b) do
  224.      if b[j].dx>=0 then b[j].dx:=b[j].dx+0.01 else b[j].dx:=b[j].dx-0.01
  225.     end;
  226.    
  227.     if boolean(GetAsyncKeyState($1B)) then
  228.     begin
  229.     DeleteObject(Membitmap);
  230.         DeleteDC    (Memhdc);
  231.     exit;
  232.     end;
  233.     if myfps<5 then myfps:=5;
  234.      end;
  235.  
  236. HandleEdges(b);
  237. HandleBallCollisions(b);
  238. ClearScreen(Memhdc);
  239.  
  240. text(Memhdc,10,10,'Use up/down arrowkeys to adjust framerate');
  241. text(Memhdc,10,30,'Use left/right arrowkeys to adjust energy per frame');
  242. text(Memhdc,10,50,'fps required = '+(IntToStr(myfps)));
  243. text(Memhdc,10,70,'         fps = '+(IntToStr(fps)));
  244. text(Memhdc,10,90,'energy per frame = '+(FloatToStr((energy))));
  245.  
  246. MoveAndDraw(Memhdc,wh,b,energy);
  247.  
  248. settimer();
  249. sleep(regulate(myfps,fps));
  250. freetimer();
  251.     end;
  252. end.
  253.  
  254.  




 

TinyPortal © 2005-2018