Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
'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
%Unicode=1
#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 Long) As Long
Select Case Msg
Case %WM_Char
Dialog End hDlg
End Select
Function = CallWindowProc(OldProc, hWnd, Msg, wParam, lParam)
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$ = "get" Then
Getprivateprofilestring "Settings", "TimerInterval", "30", temp, %Max_Path, INIFileName
TimerInterval = Val(temp)
End If
If Task$ = "save" Then
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
http://www.garybeene.com/sw/gbsnippets.htm