circles anima canvas

[TomLebowski]

good morning, happy new year and hope everybody has started with good mood and power for this year 2010 !

I wanted to build simple solution of circles they are falling down from top, make some relays with "sleep", "canvas clear", and changing shapes and colours. my example shows what I am intended to do. left side is nearly ok bleongs to my idea, so I have had this idea to show this effect, but right example stops and started again. didn't know really why ? ;) so I need little help. wanted connect console modus of circles building with canvas circles. must grin cause I have tried to play with "incr canvas_circles" statements, but that cannot run. example I found at canvas folder. thanks!


' Empty GUI script created on 12-29-2009 22:47:13 by (ThinAIR)
'- testcode for canvas with circles and animas by tom
'-------------------------------------------------------------

Uses "UI", "console"

Begin Const
%cCanvasSB = %WM_USER + 500
%cCanvasDB
%btnClose
%tAnimationTimer
End Const


Function TBMAIN()
Local hDlg As DWord
Dim cx, cy As Long

Dialog New 0, "Toms Circles_Test",-1,-1, 282, 170, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Pixels hDlg, 200, 200 To Units cx, cy
Control Add Canvas, hDlg, %cCanvasSB, "", 5, 25, cx, cy
Control Add Canvas, hDlg, %cCanvasDB, "", 5+cx+5, 25, cx,cy
Control Add Label, hDlg, -1, "Single buffer"+$CRLF+"(immediate, but with flicker)", 5, 5, cx, 30
Control Add Label, hDlg, -1, "Double buffer"+$CRLF+"(draws all at once, no flicker)", 5+cx+5, 5, cx, 30
Control Add Button, hDlg, %btnClose, "Click to close", 10+cx, 30+cy, cx, 14, Call btnCloseProc
Dialog Show Modal hDlg, Call dlgProc

End Function

' -- Callback for dialog --------------------------------------------
CallBack Function dlgProc()

Select Case CBMSG
Case %WM_INITDIALOG
Dialog Set Timer CBHNDL, %tAnimationTimer, 10, %NULL
Case %WM_TIMER
Dim tx, ty As Long
Canvas_Attach(CBHNDL, %cCanvasSB, %FALSE)
DrawGraphics()
Canvas_Attach(CBHNDL, %cCanvasDB, %TRUE)
DrawGraphics()
Canvas_Redraw
Case %WM_CLOSE
End Select
End Function

CallBack Function btnCloseProc()

If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
Dialog End CBHNDL
End If
End If

End Function

'------ circles -----------------------------------
Sub DrawGraphics()
Dim tx, ty, p As Long
Dim CountCircles As Byte
CountCircles = 0
p = 0
Do
Incr CountCircles
tx = 80+Cos(GetTickCount/100)*4
ty = 80+Sin(GetTickCount/100)*4

Canvas_Color Rgb(128, 255, 0), Rgb(0, 0, 0)
Canvas_Clear(Rgb(0,0,0))
Canvas_Box(tx-50,ty-50,tx,ty, 0, Rgb(255, 0, 0), Rgb(255,128,0),%CANVAS_FILLSTYLE_DIAGONALCROSSEDLINES )
Canvas_Ellipse (tx-80, ty-90, tx-40, ty-25, Rgb(150,0,50),Rgb(50,0,250),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)

Canvas_Print " Welcome "+Str$(Rnd(1,256))
Canvas_Print " sun :) "+Str$(Rnd(1,256))
Canvas_Ellipse (140, 120, 40, 35, Rgb(250,0,250),Rgb(150,0,50),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
'Sleep 10
'Canvas_Clear(Rgb(0,0,0))
Canvas_Ellipse (140, 125, 50, 15, Rgb(50,0,250),Rgb(150,100,250),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (140, 130, 50, 15, Rgb(150,0,150),Rgb(50,160,150),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (140, 135, 50, 15, Rgb(150,100,50),Rgb(50,100,50),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (140, 140, 50, 15, Rgb(150,100,50),Rgb(50,100,50),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (140, 125, 40, 35, Rgb(250,100,50),Rgb(50,0,150),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Sleep 10
Canvas_Ellipse (140, 110, 30, 35, Rgb(250,0,0),Rgb(150,0,50),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
'Canvas_Line ((0,0), (200, 200), Rgb(255,0,0))
'Canvas_Line ((200,0), (0, 200), rgb(255,0,0))

Console_WriteLine("-- CountCircles test :"+Str$(CountCircles))

If CountCircles = 150 Then Exit Do
Loop

End Sub

''Canvas_Ellipse (tx-140, ty-160, tx-40, ty-25, Rgb(150,0,50),Rgb(250,0,150),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)

tom

[Michael Hartlef]

Hi Tom,

you think that the right box restarts but that isn't the case. Drawing 150 elements takes its time. And the box gets only updated after all 150 elements are drawn. You can't see the animation there because of that.

Michael

[ErosOlmi]

Do not know if this can help but following code does the following:


2 timers one for each canvas
one single drawing function for both canvas
each timer, when fired, activate the other
a global variable called "InDrawing" ensure function is executed only if previous timer has finished


Eros



'-------------------------------------------------------------
'- testcode for canvas with circles and animas by tom
'-------------------------------------------------------------

Uses "UI", "console"

Randomize

Begin Const
%cCanvasSB = %WM_USER + 500
%cCanvasDB
%btnClose
%tAnimationTimer_SB
%tAnimationTimer_DB
End Const


Function TBMAIN()
Local hDlg As DWord
Dim cx, cy As Long

Dialog New 0, "Toms Circles_Test",-1,-1, 282, 170, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Pixels hDlg, 200, 200 To Units cx, cy
Control Add Canvas, hDlg, %cCanvasSB, "", 5, 25, cx, cy
Control Add Canvas, hDlg, %cCanvasDB, "", 5+cx+5, 25, cx,cy
Control Add Label, hDlg, -1, "Single buffer"+$CRLF+"(immediate, but with flicker)", 5, 5, cx, 20
Control Add Label, hDlg, -1, "Double buffer"+$CRLF+"(draws all at once, no flicker)", 5+cx+5, 5, cx, 20
Control Add Button, hDlg, %btnClose, "Click to close", 10+cx, 30+cy, cx, 14, Call btnCloseProc
Dialog Show Modal hDlg, Call dlgProc

End Function

' -- Callback for dialog --------------------------------------------
CallBack Function dlgProc()

Select Case CBMSG
Case %WM_INITDIALOG
'---Just fire the first timer. The others will be killed/restarted by timer calling
Dialog Set Timer CBHNDL, %tAnimationTimer_SB, 100

Case %WM_TIMER
'---Check which timer has been fired
Select Case CBWPARAM
Case %tAnimationTimer_SB
DrawGraphics(CBHNDL, %cCanvasSB)
Dialog Kill Timer CBHNDL, %tAnimationTimer_SB
Dialog Set Timer CBHNDL, %tAnimationTimer_DB, 210

Case %tAnimationTimer_DB
DrawGraphics(CBHNDL, %cCanvasDB)
Dialog Kill Timer CBHNDL, %tAnimationTimer_DB
Dialog Set Timer CBHNDL, %tAnimationTimer_SB, 210
End Select

Case %WM_DESTROY
Dialog Kill Timer CBHNDL, %tAnimationTimer_SB
Dialog Kill Timer CBHNDL, %tAnimationTimer_DB
Beep

End Select
End Function

CallBack Function btnCloseProc()

If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
Dialog End CBHNDL
End If
End If

End Function

'------ circles -----------------------------------
Sub DrawGraphics(ByVal hWnd As Long, ByVal lCanvas As Long)
Dim tx, ty, p As Long
Dim CountCircles As Byte
Global InDrawing As Long

If InDrawing Then Exit Sub
InDrawing = %TRUE

Canvas_Attach(hWnd, lCanvas, %TRUE)

Canvas_Color Rgb(128, 255, 0), Rgb(0, 0, 0)
Canvas_Clear(Rgb(0,0,0))

Do
Incr CountCircles
tx = 80+Cos(GetTickCount/100)*4
ty = 80+Sin(GetTickCount/100)*4

Canvas_Box(tx-50,ty-50,tx,ty, 0, Rgb(255, 0, 0), Rgb(255,128,0),%CANVAS_FILLSTYLE_DIAGONALCROSSEDLINES )
Canvas_Ellipse (tx-80, ty-90, tx-40, ty-25, Rgb(150,0,50),Rgb(50,0,250),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)

Canvas_Print " Welcome "+Str$(Rnd(1,256))
Canvas_Print " sun :) "+Str$(Rnd(1,256))

Canvas_Ellipse (Rnd(30, 190), Rnd(30, 190), 50, 45, Rgb(50,0,250),Rgb(150,100,250),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (Rnd(30, 190), Rnd(30, 190), 50, 45, Rgb(150,0,150),Rgb(50,160,150),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (Rnd(30, 190), Rnd(30, 190), 50, 45, Rgb(150,100,50),Rgb(50,100,50),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (Rnd(30, 190), Rnd(30, 190), 50, 45, Rgb(150,100,50),Rgb(50,100,50),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
Canvas_Ellipse (Rnd(30, 190), Rnd(30, 190), 40, 45, Rgb(250,100,50),Rgb(50,0,150),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)

PrintL "Canvas " & lCanvas & " circle " & CountCircles
Canvas_Redraw
Loop While CountCircles < 150

InDrawing = %FALSE

End Sub