ScreenSaver - RFoxDesigns

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
 
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
 
#Include "win32api.inc"
#Resource "rfoxdesigns.pbr"
''========================================================================
''Change these as needed - specific to the screensaver
''========================================================================
$Main_Title = "SCRNSAVE: RFoxDesigns:"
$Setting_Title = "RFoxDesigns Settings"
$INIFileName = "rfoxdesigns.ini"
''========================================================================
''End of change section
''========================================================================
 
Global hDlg, hGraphic, hPreview, hSettings As DWord, bmp$, bmp2$
Global x,y,imgX,imgY,w,h,TimerInterval,OldProc,dX,dY,dX2,dY2,x2,y2,imgX2,imgY2 As Long
%ID_Graphic = 600 : %ID_Timer = 700
 
Function PBMain() As Long
   Settings_INI "get"
   Select Case Left$(LCase$(Command$(1)),2)
      Case "/p"
         '         hPreview = Val(Mid$(Command$,3))
         '         DisplayScreenSaver
      Case "/a"       ' not supported (password)
      Case "/c"       : DisplaySettingsDialog    'settings, then quit
      Case "/s"       : DisplayScreenSaver       'start normally (includes "/s" Option)
      Case Else       : DisplayScreenSaver
   End Select
End Function
 
Sub DisplayScreenSaver
   Desktop Get Size To w,h
   Dialog New Pixels, 0, $Main_Title,0,0,w,h, %WS_Popup Or %WS_ClipChildren 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 %Green, %Black
   Graphic Font "MS Serif", 28, 1
   Graphic Clear
   Dialog Show Modal hDlg Call DlgProc
End Sub
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         Randomize
         SetWindowPos(hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NoMove Or %SWP_NoSize)  'on Top
         InitializeGraphics
         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
         DisplayGraphics
      Case %WM_Destroy
         SetWindowLong hGraphic, %GWL_WNDPROC, OldProc   'un-subclass
         ShowCursor(%True)
         KillTimer CB.Hndl, %ID_Timer
         Settings_INI "save"
   End Select
End Function
 
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 at this time
End Sub
 
Sub Settings_INI(Task$)
   Local temp As Asciiz*%Max_Path, INIFileName As Asciiz*%Max_Path
   INIFileName = Exe.Path$ + $INIFileName
   If Task$ = "getThen
      Getprivateprofilestring "Settings", "TimerInterval", "30", temp, %Max_Path, INIFileName
      TimerInterval = Val(temp)
   End If
   If Task$ = "saveThen
      temp = Str$(TimerInterval)
      WritePrivateProfileString "Settings", "TimerInterval", temp, INIFileName
   End If
 
End Sub
 
Sub InitializeGraphics
   Local hBMP, hbmp2 As DWord
 
   'set initial positions and movements speeds
   x = Rnd(50,600) : y = Rnd(50,400)
   dX = Rnd(3,4) : dY = Rnd(3,4)
   x2 = Rnd(50,600) : y2 = Rnd(50,400)
   dX2 = Rnd(-3,-4) : dY2 = Rnd(-3,-4)
 
   'get image size for bmp$
   bmp$ = "red"
   Graphic Bitmap Load bmp$, 0, 0 To hBMP
   Graphic Attach hBMP, 0
   Graphic Get Client To imgX,imgY
   Graphic Bitmap End
 
   'get image size for bmp2$
   bmp2$ = "white"
   Graphic Bitmap Load bmp2$, 0, 0 To hBMP2
   Graphic Attach hBMP2, 0
   Graphic Get Client To imgX2,imgY2
   Graphic Bitmap End
   Graphic Attach hDlg, %ID_Graphic, Redraw
End Sub
 
Sub DisplayGraphics
   Static i As Long
   Incr i
   If i = 1500 Then Graphic Clear %Black, %Black : i = 0
 
   '   x = x + dX + 5 * Sin(y) : y = y + dY + 5 * Sin(x)    'gives 'jitters'
   x = x + dX : y = y + dY
   If x < 0 Then dX = -1 * dX : x = 0
   If y < 0 Then dY = -1 * dY : y = 0
   If x > w - imgX Then dX = -1 * dX : x = w - imgX
   If y > h - imgY Then dY = -1 * dY : y = h - imgY
   Graphic Render bmp$, (x,y)-(x+imgX,y+imgY)
 
   x2 = x2 + dX2 : y2 = y2 + dY2
   If x2 < 0 Then dX2 = -1 * dX2 : x2 = 0
   If y2 < 0 Then dY2 = -1 * dY2 : y2 = 0
   If x2 > w - imgX2 Then dX2 = -1 * dX2 : x2 = w - imgX2
   If y2 > h - imgY2 Then dY2 = -1 * dY2 : y2 = h - imgY2
   Graphic Render bmp2$, (x2,y2)-(x2+imgX2,y2+imgY2)
 
   Graphic Redraw
End Sub
 
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, "logo"
   Control Add Label, hSettings, 800, "Timer Interval (ms):", 50, 60, 100, 20
   Control Add TextBox, hSettings, 900, Str$(TimerInterval), 50, 80, 100, 20
   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
 
'gbs_00502
'Date: 03-10-2012


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