ScreenSaver - Moving Sprites

Category: Screensaver Tutor Series

Date: 03-28-2012

Return to Index


 
'Compilable Example:
'After compilation of this snippet to an EXE, you must manually change the
'extension to SCR and place the file in the \windows\system32 folder. It will
'then be visible from the Windows Display Properties application.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc"
#Resource "gbsnippets.pbr"
 
''========================================================================
''Change these as needed - specific to the screensaver
''========================================================================
 
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 Sprites() As SpriteInfo, canvasW as Long, canvasH as Long
   Global 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
 
   $Main_Title = "SCRNSAVE: Sprites:"
   $Setting_Title = "Sprites Screensaver Settings"
   $INIFileName = "sprite_screensaver.ini"
   ''========================================================================
   ''End of change section
   ''========================================================================
 
   Global hDlg As DWord, hGraphic as DWord, hSettings as DWord
   Global w,h,TimerInterval, OldProc As Long
   %ID_Graphic = 600 : %ID_Timer = 700
 
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
 
   Desktop Get Size To w,h
   canvasW = w : canvasH = h
   Dialog New Pixels, 0, $Main_Title,0,0,w,h, %WS_Popup To hDlg
   Control Add Graphic, hDlg, %ID_Graphic, "", 0,0,w,h,%WS_Visible
   Control Handle hDlg, %ID_Graphic to hGraphic
   Graphic Attach hDlg, %ID_Graphic, Redraw
   Graphic Color %Black, %RGB_PowderBlue
   Graphic Font "MS Serif", 28, 1
   Graphic Clear
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         Settings_INI "get"
         SetWindowPos(hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NoMove Or %SWP_NoSize)  'on Top
         InitializeGraphics
         Select Case Left$(LCase$(Command$(1)),2)
            Case "/p" : DisplayInPreviewWindow
            Case "/s" : 'normal
            Case "/a" : Dialog End hDlg    'set password - not used in this app, so just quit
            Case "/c" : DisplaySettingsDialog : Dialog End hDlg  'settings, then quit
            Case Else : 'nothing - start normally
         End Select
         OldProc = SetWindowLong(hGraphic, %GWL_WndProc, CodePTR(NewGraphicProc))  'subclass
         ShowCursor(%False)
         SetTimer(CB.Hndl, %ID_Timer, TimerInterval, ByVal %NULL)   'uses callback messages
         Dialog Post CB.Hndl, %WM_Timer, %ID_TIMER, 0  ' optional - forces an initial %WM_TIMER "event"
      Case %WM_SetCursor
         Static iCount as Long
         Incr iCount
         If iCount > 5 Then Dialog End hDlg
      Case %WM_Timer
         DrawSprites
         MoveSprites
         Graphic Redraw
      Case %WM_Destroy
         SetWindowLong hGraphic, %GWL_WNDPROC, OldProc   'un-subclass
         ShowCursor(%True)
         KillTimer CB.Hndl, %ID_Timer
         Settings_INI "save"
   End Select
End Function
 
Sub DisplaySettingsDialog()
   Desktop Get Size To w,h
   Dialog New Pixels, hDlg, $Setting_Title, (w-200)/2,(h-200)/2,200,200, %WS_SysMenu Or %WS_Caption Or %WS_ClipChildren To hSettings
   Dialog Set Icon hSettings, "aainfo"
   Control Add Label, hSettings, 800, "Timer Interval (ms):", 50, 60, 100, 20
   Control Add TextBox, hSettings, 900, "20", 50, 80, 100, 20
   Control Set Text hSettings, 900, Str$(TimerInterval)
   Dialog Show Modal hSettings Call SettingsProc
End Sub
 
CallBack Function SettingsProc() As Long
   Local temp$
   Select Case CB.Msg
      Case %WM_Command
         If CB.Ctl = %IDOK Then Dialog End hSettings
         If CB.Ctl = %IDCANCEL Then Dialog End hSettings
      Case %WM_Destroy
         Control Get Text hSettings, 900 To temp$
         TimerInterval = Val(temp$)
         If TimerInterval <=0 Then TimerInterval = 1
         Settings_INI "save"
   End Select
End Function
 
Sub Settings_INI(Task$)
   Local temp As Asciiz*%Max_Path, INIFileName As Asciiz*%Max_Path
 
   'defines file name (any file name will work)
   INIFileName = Exe.Path$ + $INIFileName
 
   If Task$ = "getThen
      'get value for numeric variable
      Getprivateprofilestring "Settings", "TimerInterval", "20", temp, %Max_Path, INIFileName
      TimerInterval = Val(temp)
   End If
 
   If Task$ = "saveThen
      'save numeric variable
      temp = Str$(TimerInterval)
      WritePrivateProfileString "Settings", "TimerInterval", temp, INIFileName
   End If
 
End Sub
 
Function NewGraphicProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case Msg
      Case %WM_Char
         Dialog End hDlg
   End Select
   Function = CallWindowProc(OldProc, hWnd, MsgwParamlParam)
End Function
 
Sub DisplayInPreviewWindow
   'not supported as this time. this Sub is a placeholder for when the
   'Display Properties calls the screensaver with the /p preview mode command.
   Dialog End hDlg  'not supported at this time
   Exit Sub
 
   '   The following code does not work. I found this in some VB6 examples,
   '   but haven't gotten it to work in PowerBASIC so far. Basically, the
   '   code is supposed to set the screensaver dialog as a child of the
   '   Preview Window so that the screensaver will play in that smaller window.
   '   I included it here in case anyone feels the urge to play with it.
 
   Local lngStyle As Long, dispHWND As Long, DispRec As RECT, temp$
   temp$ = Command$(1)
   Replace "/p" With "" in temp$
   dispHWND = Val(Trim$(temp$))
   GetClientRect dispHWND, DispRec
   lngStyle = GetWindowLong(hDlg, %GWL_STYLE)
   lngStyle = lngStyle Or %WS_CHILD 'Append "WS_CHILD"
   SetWindowLong hDlg, %GWL_STYLE, lngStyle
   SetParent hDlg, dispHWND
   SetWindowLong hDlg, %GWL_HWNDPARENT, dispHWND
   SetWindowPos hDlg, %HWND_TOP, 0&, 0&, _
      DispRec.nRight, DispRec.nBottom, _
      %SWP_NOZORDER Or %SWP_NOACTIVATE Or %SWP_SHOWWINDOW
End Sub
 
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 InitializeGraphics
   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
 
   IntervalTime$ = Format$(1000/TimerInterval,"###0")
   Local 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,3)*((-1)^Rnd(1,2))
      Sprites(i).sy = Rnd(2,3)*((-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
 
'gbs_00478
'Date: 03-10-2012


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