Sprite 04 - RealTime Images

Category: Sprite Tutor Series

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Tools On          'use ON only when needed for Trace/Profile/CallStk
 
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"
 
Type SpriteInfo
   w As Long            'width (of enclosing rectangle)
   h As Long            'height (of enclosing rectangle)
   x As Long            'x-position (upper-left corner)
   y As Long            'y-position (upper-left corner)
   sx As Long           'distance to move in x direction (speed)
   sy As Long           'distance to move in y direction (speed)
   frameMax As Long     'total number of available frames For the sprite
   frameCurrent As Long 'current Frame #, the one to be displayed
   waitMax As Long      'max wait count before changing frames
   waitCount As Long    'current wait count (counts Timer Events)
   hBMP as DWord        'image handle or arra index of sprite
 
   '  these next members are unique to realtime image drawing
   Color1 as Long        'fill color
   Color2 as Long        'pie fill color
End Type
 
   Global hDlg As DWord, Sprites() As SpriteInfo, canvasW as Long, canvasH as Long
   Global TimerInterval as Long, MaxSprites as Long, MaxFrames as LonghLst as DWord
   Global SpriteH as Long, SpriteW as Long, SourceIsImages As Long, hWait as DWord
   Global MoveTime$, DrawTime$, DisplayTime$, IntervalTime$, RandomImages As Long
   Global UseBitStrings as Long, BitStrings() As String, bmpCanvas$, ShowTrails As Long
 
   %ID_Graphic = 300 : %ID_Timer = 400 : %ID_Label = 400
 
Function PBMain() As Long
   MaxSprites = 100 : TimerInterval = 20 : MaxFrames = 25
   SpriteW = 32     : SpriteH = 32         : SourceIsImages = 1
   RandomImages = 1 : UseBitStrings = 0
 
   Dim Sprites(5000), BitStrings(5000)     'more than needed
   canvasW = 900 : canvasH = 600
   Dialog New Pixels, 0, "Sprite Test - Realtime Drawing",400,150,canvasW, canvasH+120, %WS_SysMenu, 0 To hDlg
   Dialog Set Icon hDlg, "aainfo"
   Control Add Graphic, hDlg, %ID_Graphic,"", 0,120,canvasW,canvasH, %WS_Visible Or %SS_Sunken Or %SS_Notify
 
   Control Add Label, hDlg, 800, "", 40,10,150,80
 
   Control Add Label, hDlg, 815, "Sprite Size", 235,5,50,20
   Control Add Label, hDlg, 816, "Timer Interval", 310,5,50,20
   Control Add Label, hDlg, 817, "#Sprites", 410,5,50,20
   Control Add Label, hDlg, 818, "Max Frames", 480,5,75,20
   Control Add Label, hDlg, 818, "Options", 560,5,75,20
 
   Control Add Option, hDlg, 801, "128x", 235,20,45,15, %WS_Group Or %WS_TabStop
   Control Add Option, hDlg, 802, "64x", 235,40,40,15
   Control Add Option, hDlg, 803, "32x", 235,60,40,15
   Control Add Option, hDlg, 804, "4x", 235,80,40,15
   Control Set Option  hDlg, 803, 801,804
 
   Control Add Option, hDlg, 830, "100ms (10fps)", 310,20,80,15, %WS_Group Or %WS_TabStop
   Control Add Option, hDlg, 831, "67ms (15fps)", 310,40,80,15
   Control Add Option, hDlg, 832, "50ms (20fps)", 310,60,80,15
   Control Add Option, hDlg, 833, "33ms (30fps)", 310,80,80,15
   Control Add Option, hDlg, 834, "20ms (50fps)", 310,100,80,15
   Control Set Option  hDlg, 833, 830,834
 
   Control Add Option, hDlg, 807, "1500",410,20,45,15, %WS_Group Or %WS_TabStop
   Control Add Option, hDlg, 808, "1000",410,40,45,15
   Control Add Option, hDlg, 809, "500",410,60,45,15
   Control Add Option, hDlg, 810, "100",410,80,45,15
   Control Add Option, hDlg, 811, "10",410,100,45,15
   Control Set Option  hDlg, 810, 807,811
 
   Control Add Option, hDlg, 812, "75",480,20,35,15, %WS_Group Or %WS_TabStop
   Control Add Option, hDlg, 813, "50",480,40,35,15
   Control Add Option, hDlg, 814, "25",480,60,35,15
   Control Set Option  hDlg, 814, 812,814
 
   Control Add Checkbox, hDlg, 840, "Images", 560,20,120,15
   Control Set Check hDlg, 840, SourceIsImages
   Control Add Checkbox, hDlg, 841, "(Random)", 580,40,100,15
   Control Set Check hDlg, 841, RandomImages
   Control Add Checkbox, hDlg, 842, "Bit Strings", 580,60,100,15
 
   Control Add Checkbox, hDlg, 843, "Drawing Thread", 690,20,100,15
   Control Add Checkbox, hDlg, 844, "Transparency", 690,40,100,15
   Control Add Checkbox, hDlg, 845, "AlphaBlending", 690,60,100,15
   Control Add Checkbox, hDlg, 846, "Show Trails", 690,80,100,15
 
   Control Add Button, hDlg, 847, "Clear", 800,80,50,20
 
   Control Add Graphic, hDlg, 850, "", 840,20,32,32, %WS_Border
 
   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
   Local i As Long, P as Point
   Select Case CB.Msg
      Case %WM_InitDialog
         CreateImageList
         DefineSprites
         SetTimer(CB.Hndl, %ID_Timer, TimerInterval, ByVal %NULL)   'uses callback messages
      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 : MoveSprites    : Tix End qElapsed : MoveTime$ = Format$((qElapsed-qOverHead)*1000/qFreq, "##00.00")
         Tix qElapsed : DrawSprites    : Tix End qElapsed : DrawTime$ = Format$((qElapsed-qOverHead)*1000/qFreq, "##00.00")
         Tix qElapsed : Graphic Redraw : Tix End qElapsed : DisplayTime$ = Format$((qElapsed-qOverHead)*1000/qFreq, "##00.00")
         Control Set Text hDlg, 800, Build$("Timer Interval: ", IntervalTime$, " ms", $crlf, $CrLf, "Elapsed Times: ", $CrLf, "     Move:   ", MoveTime$," ms", $crlf, "     Draw:    ",DrawTime$," ms", $crlf, "     Display: ",DisplayTime$," ms")
      Case %WM_Destroy
         KillTimer CB.Hndl, %ID_Timer
      Case %WM_Command
         If CB.Ctl = 801 Then SpriteH=128 : SpriteW=128 : DefineSprites
         If CB.Ctl = 802 Then SpriteH=64  : SpriteW=64  : DefineSprites
         If CB.Ctl = 803 Then SpriteH=32  : SpriteW=32  : DefineSprites
         If CB.Ctl = 804 Then SpriteH=4   : SpriteW=4   : DefineSprites
 
         If CB.Ctl >= 830 AND CB.Ctl <=834 Then
            KillTimer CB.Hndl, %ID_Timer
            Select Case CB.Ctl
               Case 830: TimerInterval = 100
               Case 831: TimerInterval = 67
               Case 832: TimerInterval = 50
               Case 833: TimerInterval = 33
               Case 834: TimerInterval = 20
            End Select
            SetTimer(CB.Hndl, %ID_Timer, TimerInterval, ByVal %NULL)   'uses callback messages
            DefineSprites
         End If
         If CB.Ctl = 806 Then
            KillTimer CB.Hndl, %ID_Timer
            TimerInterval = 20
            SetTimer(CB.Hndl, %ID_Timer, TimerInterval, ByVal %NULL)   'uses callback messages
            DefineSprites
         End If
 
         If CB.Ctl = 807 Then MaxSprites = 1500 : DefineSprites
         If CB.Ctl = 808 Then MaxSprites = 1000 : DefineSprites
         If CB.Ctl = 809 Then MaxSprites = 500  : DefineSprites
         If CB.Ctl = 810 Then MaxSprites = 100  : DefineSprites
         If CB.Ctl = 811 Then MaxSprites = 10   : DefineSprites
 
         If CB.Ctl = 812 Then MaxFrames = 75    : DefineSprites
         If CB.Ctl = 813 Then MaxFrames = 50    : DefineSprites
         If CB.Ctl = 814 Then MaxFrames = 25    : DefineSprites
 
         If CB.Ctl = 840 Then
            SourceIsImages = SourceIsImages XOR 1
            Control Set Check hDlg, 840, SourceIsImages
            DefineSprites
         End If
         If CB.Ctl = 841 Then
            RandomImages = RandomImages XOR 1
            Control Set Check hDlg, 841, RandomImages
            DefineSprites
         End If
         If CB.Ctl = 842 Then
            UseBitStrings = UseBitStrings XOR 1
            Control Set Check hDlg, 842, UseBitStrings
            DefineSprites
         End If
         If CB.Ctl = 846 Then
            ShowTrails = ShowTrails XOR 1
            Control Set Check hDlg, 846, ShowTrails
            If ShowTrails = 0 Then Graphic Clear
         End If
         If CB.Ctl = 847 Then Graphic Clear
         If CB.Ctl = %ID_Graphic AND CB.Ctlmsg = %STN_Clicked Then
            GetCursorPos P           'x and y are in screen coordinates
            ScreenToClient hDlg, P   'x and y are now dialog client coordinates
            i = SpriteHitTest(P)     'returns first sprite under mouse
            If i Then
               Graphic Attach hDlg, 850
               If Sprites(i).hBMP = 0 Then
                  Graphic Set Bits BitStrings(i)
               Else
                  Graphic Stretch Sprites(i).hBMP, 0, (0,0)-(Sprites(i).w,Sprites(i).h) To (0,0)-(32,32)
               End If
            End If
         End If
   End Select
End Function
 
Function SpriteHitTest(P as Point) As Long
   Local i As Long
   For i = 0 to MaxSprites
      If (P.x >= Sprites(i).x) AND (P.x <= (Sprites(i).x +Sprites(i).w)) AND (P.y >= (Sprites(i).y+120)) AND (P.y <= (Sprites(i).y + Sprites(i).h) + 120) Then
         Dialog Set Text hDlg, "HitTest " + Str$(i)
         Function = i : Exit Function
      End If
   Next
End Function
 
Sub DrawSprites
   Local i as Long, arcStart as Single, arcEnd as Single
   Local p as Long Pointer, pStart as Long, s as Long Pointer
   Local x as Long, y as Long, sStart as Long
 
   Graphic Attach hDlg, %ID_Graphic, Redraw
   If ShowTrails = 0 Then Graphic Clear
 
   If UseBitStrings Then
      Graphic Get Bits To bmpCanvas$
      p = StrPTR(bmpCanvas$)+8
      pStart = p
   End If
 
   If SourceIsImages Then
      For i = 0 to MaxSprites
         If UseBitStrings Then
            s = StrPTR(BitStrings(i))+8
            sStart = s
            '             For y = 0 to Sprites(i).h-1
            '                p = pStart + y*CanvasW*4 + Sprites(i).y*CanvasW*4 + Sprites(i).x*4
            '                For x = 0 to Sprites(i).w-1
            '                   @p = @s : Incr s : Incr p
            '                Next x
            '             Next y
            '             Graphic Set Bits bmpCanvas$
         Else
            Graphic Copy Sprites(i).hBMP, 0 To (Sprites(i).x, Sprites(i).y)
         End If
      Next i
   Else
      For i = 0 to MaxSprites
         Graphic Ellipse (Sprites(i).x, Sprites(i).y)-(Sprites(i).x + Sprites(i).w, Sprites(i).y + Sprites(i).h), %Black, Sprites(i).Color1
         arcStart = (Sprites(i).frameCurrent) * 6.28 / Sprites(i).frameMax
         arcEnd = (Sprites(i).frameCurrent + 10) * 6.28 / Sprites(i).frameMax
         Graphic Pie (Sprites(i).x, Sprites(i).y)-(Sprites(i).x + Sprites(i).w, Sprites(i).y + Sprites(i).h), _
            ArcStart, ArcEnd, %Black, Sprites(i).Color2
      Next i
   End If
End Sub
 
Sub MoveSprites
   Local i As Long
   For i = 0 To MaxSprites
      Sprites(i).x = Sprites(i).x + Sprites(i).sx
      Sprites(i).y = Sprites(i).y + Sprites(i).sy
 
      If Sprites(i).x < 0 Then
         Sprites(i).x = 0
         Sprites(i).sx = -1 * Sprites(i).sx
      ElseIf Sprites(i).x + Sprites(i).w > canvasW Then
         Sprites(i).x = canvasW - Sprites(i).w
         Sprites(i).sx = -1 * Sprites(i).sx
      End If
 
      If Sprites(i).y < 0 Then
         Sprites(i).y = 0
         Sprites(i).sy = -1 * Sprites(i).sy
      ElseIf Sprites(i).y + Sprites(i).h > canvasH Then
         Sprites(i).y = canvasH - Sprites(i).h
         Sprites(i).sy = -1 * Sprites(i).sy
      End If
 
      Incr Sprites(i).waitCount
      If Sprites(i).waitCount = Sprites(i).waitMax Then
         Sprites(i).waitCount = 0
         Sprites(i).frameCurrent = (Sprites(i).frameCurrent + 1) Mod Sprites(i).frameMax
      End If
   Next i
End Sub
 
Sub DefineSprites
   If MaxSprites > 100 Then DisplayWaitDialog(hDlg)
   IntervalTime$ = Format$(1000/TimerInterval,"###0")
   Local i As Long, j as Long, hBMP as DWord
   Graphic Bitmap New 32,32 To hBMP   'for use whenver random 32x32 icons images are used from *.PBR
 
   Randomize
   For i = 0 To MaxSprites
      Sprites(i).w = SpriteW
      Sprites(i).h = SpriteH
      Sprites(i).x = Rnd(0,canvasW-Sprites(i).w)
      Sprites(i).y = Rnd(0,canvasH-Sprites(i).h)
      Sprites(i).sx = Rnd(2,4)*((-1)^Rnd(1,2))
      Sprites(i).sy = Rnd(2,4)*((-1)^Rnd(1,2))
      Sprites(i).frameMax = MaxFrames
      Sprites(i).frameCurrent = Rnd(0,Sprites(i).frameMax)
      Sprites(i).waitMax = 1  'Rnd(1,3)
      Sprites(i).waitCount = 0
      Sprites(i).Color1 = Rgb(Rnd(0,256), Rnd(0,256), Rnd(0,256))  'Rnd(0,4000000000)
      Sprites(i).Color2 = Rgb(Rnd(0,256), Rnd(0,256), Rnd(0,256))  'Rnd(0,4000000000)
 
      If Sprites(i).hBMP Then
         Graphic Attach Sprites(i).hBMP, 0 : Graphic Bitmap End
      End If
 
      If SourceIsImages Then
         If RandomImages Then
            Graphic Attach hBMP,0
            Graphic ImageList (0,0), hLstRnd(1,100) ,0,%ILD_Normal
            Graphic Bitmap New Sprites(i).w, Sprites(i).h To Sprites(i).hBMP
            Graphic Attach Sprites(i).hBMP, 0
            Graphic Stretch hBMP, 0, (0,0)-(32,32) To (0,0)-(Sprites(i).w,Sprites(i).h)
         Else
            Graphic Bitmap Load "cowgirl", Sprites(i).w, Sprites(i).h, %HalfTone To Sprites(i).hBMP
         End If
         If UseBitStrings Then
            Graphic Attach Sprites(i).hBMP, 0
            Graphic Get Bits To BitStrings(i)
            Graphic Bitmap End
            Sprites(i).hBMP = 0
         End If
      Else
         Sprites(i).hBMP = 0
      End If
   Next i
   If hWait Then Dialog End hWait
End Sub
 
Sub DisplayWaitDialog(hParent as DWord)
   Local x As Long, y As Long, w As Long, h As Long, wX As Long, wY As Long
   Dialog Get Client hParent To w,h
   wX = 150 : wY = 60
   x = (w-wX)/2    'gets left position of WaitDialog to center over app
   y = (h-wY)/2    'gets top position of WaitDialog to center over app
   Dialog New Pixels, hParent, "", x, y, wX, wY, %WS_Popup To hWait
   Control Add Label, hWait, %ID_Label, "Please wait ... ", 0, 0, wX, wY, %SS_Center Or %SS_CenterImage Or %WS_Border
   Control Set Color hWait, %ID_Label, %Black, %White
   Dialog Show Modeless hWait
End Sub
 
Sub CreateImageList
   Local i as Long
   ImageList New Icon 32, 32, 24, 100 To hLst    'create imagelist  w,h,depth,size
   For i = 1 To 100
      ImageList Add Icon hLst, "mos" + Format$(i,"000")
   Next i
End Sub
 
'gbs_00453
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm