Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"
Type SpriteInfo
w As Long 'width
h As Long 'height
x As Long 'current x position
y As Long 'current y position
dx As Long 'amount x to move next time
dy As Long 'amount y to move next time
sx As Long 'move speed x
sy As Long 'move speed y
End Type
Global hDlg As DWord, sprite() As SpriteInfo, iCount as Long
Global currentF as Long
Global hBMP as DWord, hLst as DWord, canvasW as Long, canvasH as Long
%ID_Graphic = 300 : %ID_Timer = 400
%Delta = 2 : %sMax = 50 : %iW = 128 : %iH = 128 : %MaxF = 25
Function PBMain() As Long
Dim sprite(%sMax)
canvasW = 1200 : canvasH = 900
Dialog New Pixels, 0, "Graphic Control Test",150,150,canvasW, canvasH, %WS_SysMenu, 0 To hDlg
Control Add Graphic, hDlg, %ID_Graphic,"", 0,0,canvasW,canvasH, %WS_Visible Or %SS_Sunken
Graphic Attach hDlg, %ID_Graphic, Redraw
Graphic Color %Black,%White
Graphic Clear
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case CB.Msg
Case %WM_InitDialog
DefineSprites
CreateCompositeSpriteBitmap
Graphic Attach hDlg, %ID_Graphic, Redraw
' Graphic Copy hBMP, 0 'enable to see static sprite bitmap
SetTimer(CB.Hndl, %ID_Timer, 1000/%maxF, ByVal %NULL) 'disable to see static sprite bitmap
Case %WM_Timer
Local qFreq, qOverhead, qElapsed As Quad
QueryPerformanceFrequency qFreq 'clock frequency
Tix qOverHead : Tix qOverHead : Tix End qOverHead 'Tix overhead (done twice per Intel)
Tix qElapsed 'start ticks
MoveSprites : DrawSprites : Graphic Redraw
Tix End qElapsed 'end ticks
Dialog Set Text hDlg, Format$((qElapsed-qOverHead)*1000/qFreq, "####.#") 'display ms for the loop
Incr currentF : If currentF = %maxF Then currentF = 0 '
Case %WM_Destroy
KillTimer CB.Hndl, %ID_Timer
End Select
End Function
Sub DrawSprites
Local i as Long
Graphic Clear
For i = 0 to %sMax
Graphic Copy hBMP, 0, (currentF*%iW, i*%iH)-(currentF*%iW+%iW-1, i*%iH+%iH-1) To (sprite(i).x, sprite(i).y)
Next i
End Sub
Sub MoveSprites
Local i As Long
For i = 0 To %sMax
sprite(i).x = sprite(i).x + sprite(i).dx
sprite(i).y = sprite(i).y + sprite(i).dy
If sprite(i).x < 0 Then
sprite(i).x = 0
sprite(i).dx = sprite(i).sx
ElseIf sprite(i).x + sprite(i).w > canvasW Then
sprite(i).x = canvasW - sprite(i).w
sprite(i).dx = - sprite(i).sx
End If
If sprite(i).y < 0 Then
sprite(i).y = 0
sprite(i).dy = sprite(i).sy
ElseIf sprite(i).y + sprite(i).h > canvasH Then
sprite(i).y = canvasH - sprite(i).h
sprite(i).dy = - sprite(i).sy
End If
Next i
End Sub
Sub CreateCompositeSpriteBitmap
Local i As Long, j As Long, pStart As Single, rot as Single
Graphic Bitmap New %iW*%maxF, %iH*%sMax To hBMP '%sMax images x %maxF frames
Graphic Attach hBMP, 0, Redraw
Graphic Color %Black, %Red
Graphic Clear
For i = 0 To %sMax '# sprites
pStart = Rnd*6
rot = 8*Atn(1)/ %maxF
For j = 0 To %maxF '# frames
Graphic Ellipse (j*%iW, i*%iH)-(j*%iW+%iW-1, i*%iH+%iH-1), %Black, %Blue
Graphic Pie (j*%iW, i*%iH)-(j*%iW+%iW-1, i*%iH+%iH-1), pStart+j*rot, pStart+j*rot+0.5, %Yellow, %Yellow, %Yellow
Next j
Next
Graphic Redraw
End Sub
Sub DefineSprites
Local i As Long
Randomize
For i = 0 To %sMax
sprite(i).w = %iW
sprite(i).h = %iH
sprite(i).x = Rnd(0,canvasW-sprite(i).w)
sprite(i).y = Rnd(0,canvasH-sprite(i).h)
sprite(i).sx = Rnd(1,2)
sprite(i).sy = Rnd(1,2)
sprite(i).dx = sprite(i).sx * Sgn(Rnd(-10,10))
sprite(i).dy = sprite(i).sy * Sgn(Rnd(-10,10))
Next i
End Sub
'gbs_00458
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm