More GdiPlus Demos

[Peter]

Deleted

[Charles Pegge]

Thanks again, Peter. The graphics look great, especially with the use of transparency. Do you have demos 18 and 19 as part of the set?

Charles

[Charles Pegge]

Hi Peter, Demo 19: I got 140 fps but there was a star in the background which looked like a decimal point

I put the speed down to 60. Phew! that's more comfortable viewing.

[Aurel]

 
slow & crush
this work fine & smoth..

Code: [Select]

include "win.inc"
Screen 640, 480, 1
SetCaption "GDIPLUS PARTICLES"

int color, anz=5000, speed=2, xScreen=640,yScreen=480
dim stern_x(5000) as int
dim stern_y(5000) as int
dim stern_z(5000) as int

Sub StarInit
for i=0 to anz
   stern_x(i) = Rand( -(xscreen/2), (xscreen/2)) << 8
   stern_y(i) = Rand( -(yscreen/2), (yscreen/2)) << 8
   stern_z(i) = Rand(speed,255)
next
End Sub

Sub StarUpdate
for i=0 to anz
   stern_z(i) = stern_z(i) - speed
   if stern_z(i) <= speed then stern_z(i) = 255
   s_x = (stern_x(i) / stern_z(i)) + (xscreen / 2)
   s_y = (stern_y(i) / stern_z(i)) + (yscreen / 2)
   color =300 - stern_z(i)
   'color += color | (color << 8) | (color << 16) | color << 24
   'FillOval s_x, s_y, 2,2, color
Oval(s_x,s_y,3,3, color +16,color +16,color +8)
next i
End Sub

StarInit()
While Key(27)=0
ClsColor 55,0,0
StarUpdate()
Flip
SetFps 40
Wend
Ends

[Charles Pegge]

Thanks Peter.

I've been working on low-level Midi. It would interesting to add Midi sounds to some of these demos.

Charles

[Charles Pegge]

Code: OxygenBasic

1.  
2. /* GDIPLUS DEMO BY PETER WIRBELAUER  28.o6.2o12  */
3.  
4. /* Added Midi Charles Pegge */
5.  
6. include "gdip.inc"
7. include "minmidiT.inc"
8.  
9. sys hMidi,er
10. er=midiOutOpen(hMidi, 0, 0, 0, CALLBACK_NULL) ' 0=synth a 2=soft synth
11. midiOutShortMsg(hMidi, 0xff)         'reset
12. midiOutShortMsg(hMidi, 0x79B0)       'reset all controllers
13. midiOutShortMsg(hMidi, 0xC0+014*256) 'Tubular Bells
14. midiOutShortMsg(hMidi, 0xC1+127*256) 'GunShot
15. midiOutShortMsg(hMidi, 0xC2+052*256) 'Aaahs
16.  
17. 'velocity pitch  command channel
18. 'byte3   byte2 nybble2 nybble1
19. '
20.  
21. Screen 640, 480, 1
22. Font= LoadFont "courier",24
23. SetSmoothMode 4
24.  
25. sys anzahl  =1000, color, single aSpeed  
26. sys xscreen =640, yscreen =480, i  
27. sys xmitte = xscreen/2, ymitte = yscreen/2
28.  
29. Dim x(1000) as single
30. Dim y(1000) as single
31.  
32. Dim winkel(1000) as single
33. Dim speed(1000)  as single
34. Dim sinus(360)   as single
35. Dim cosinus(360) as single
36.  
37. for i=1 to anzahl
38.    x(i) = xmitte
39.    y(i) = ymitte
40.    winkel(i)= Rand(1,360)
41.    speed(i) = Rand(1,3)
42. next
43.  
44. for i=0 to 360
45.    sinus(i)  = sin(rad(i))
46.    cosinus(i)= cos(rad(i))
47. next
48.  
49. Function xMove(single x,winkel,speed) as single
50. return x + Cosinus(winkel)*speed
51. End Function
52.  
53. Function yMove(single y,winkel,speed) as single
54. return y + Sinus(winkel)*speed
55. End Function
56.  
57. Function Distance(single x1,y1,x2,y2) as single
58. sys dx, dy
59. dx = x1-x2: dy = y1-y2
60. return abs(sqr(dx*dx+dy*dy))
61. End Function
62.  
63. SetCaption "AVATAR"
64. '
65. midiOutShortMsg(hMidi, 0x7f0090)
66. midiOutShortMsg(hMidi, 0x702890)
67. midiOutShortMsg(hMidi, 0x700091)
68. midiOutShortMsg(hMidi, 0x600892)
69. midiOutShortMsg(hMidi, 0x203292)
70.  
71. 'PlayWav "cosmobumm.wav"
72.  
73. While Key(27)=0
74. ClsColor 255,2,2,2
75. for i=0 to anzahl
76.    aSpeed = Distance (xmitte, ymitte, x(i), y(i)) /200 * speed(i)+1
77.    x(i) = xMove(x(i), winkel(i), aSpeed)
78.    y(i) = yMove(y(i), winkel(i), aSpeed)
79.    if x(i) < 0 Or x(i) > xscreen Or y(i) < 0 Or y(i) > yscreen
80.       x(i) = xmitte
81.       y(i) = ymitte
82.       winkel(i)= Rand(1,360)
83.       speed(i) = Rand(1,3)
84.    end if
85.    color = speed(i)*100 - 55
86.    FillOval x(i), y(i), 24,24, ARGB(55,color, color, color)
87. next
88. xmitte = xMouse
89. ymitte = yMouse
90. Flip
91. SetFps 90
92. Wend
93. midiOutClose(hMidi)
94. Ends
95.  

Charles

[Charles Pegge]

You should be able to adjust your PC midi volume. The notes are set to near peak velocity (70/7F)

The Midi header structure is not needed in these examples, since all messages are direct to the driver, but
newer Oxygen supports self-referencing structures:

[Charles Pegge]

One thing to fix in your API, Peter.

If the demos are terminated by using the system menu or the X button (top right) they crash.

[Charles Pegge]

I'm using Vista.

One problem is that Ends is called more than once. This causes the crash on the second call.

The other is that the API should never ExitProcess (Key) since this bypasses the Oxygen Epilog and prevents an orderly shutdown. Just let the program perform WM_QUIT then run thru, and Oxygen will perform the correct termination procedure.

Code: [Select]

'TEST
Sub Ends()
sys ix
iF Reso(0) >0 and Reso(1) >0 Then RestoreDisplay
For ix=1 To 512
iF ImageHnd[ix] >0  
   call GdipDisposeImage ImageHnd[ix]
End iF    
Next
For ix=1 To 512
iF TileHnd[ix] >0  
   call GdipDisposeImage TileHnd[ix]
End iF    
Next
For ix=0 to 32
iF FontHnd[ix] >0
   Call GdipDeleteFont FontHnd[ix]
End iF
Next
call GdipDisposeImage hBitmap
'call GdipDeleteGraphics pGraphics
call ReleaseDC hwnd,hdc
'call GdipShutdown GdipToken
'FreeLibrary Gdiplus
print "ok1" 'shows twic
End Sub

I think the best solution is to set a static do-once flag in Ends

Charles

[Aurel]

From what i see & try this Gdiplus -> sucks

[Charles Pegge]

Hi Peter,

This works correctly on all your GDIP demos:

If WinExit is set then key(..) always returns -1 (true)

Code: [Select]


Function Key(sys cKey) as short
    iF wExit=1
       'Ends
       'call ExitProcess 0
       Return -1
    End iF  
    Return call GetAsyncKeyState cKey
End Function

Sub WaitKey(sys iKey)
    sys xKey
    While xKey=0  
    xKey = call GetAsyncKeyState iKey
    iF wExit=1
       'Ends
       'call ExitProcess 0
       Exit Sub
    End iF
    Events
    Flip
    Wend
End Sub    

Also in WndProc:

Code: [Select]

ElseiF wMsg = WM_DESTROY
'Ends
call PostQuitMessage 0
Else ...

Charls

[Charles Pegge]

If these changes are acceptable, Peter I'll clean up.

[Aurel]

Hi Aurel,

Do you have knowledge?

No...

Charles figured that ExitProcess is wrong way and that's why program crush after
clicking X because message queue don't recive wm_quit trough PostQuitMessage.

[Charles Pegge]

Peter,

I don't wish to be contentious.

Your solution and my solution are almost identical. The problem with yours is that when 'X' is clicked, the window will terminate but the program will not. It can be seen in File Manager.

Peter

Code: [Select]

Function Key(sys cKey) as short
    Return call GetAsyncKeyState cKey
End Function

Charles

Code: [Select]

Function Key(sys cKey) as short
    iF wExit=1
       Return -1
    End iF   
    Return call GetAsyncKeyState cKey
End Function

One other issue:

The CPU core is kept running full whack in a closed loop in WaitKey. By introducing sleeps, the CPU load is dramatically reduced.

Code: [Select]


Sub WaitKey(sys iKey)
    sys xKey
    While xKey=0 
    xKey = call GetAsyncKeyState iKey
    iF wExit=1
       Exit Sub
    End iF
    Events
    call sleep 10
    Flip
    Wend
End Sub   

With regard to ExitProcess: If your library is to be used with other libraries, it must not ExitProcess. Other components of the program and the compiler itself must have the opportunity for a normal shut-down.

Charles