
' tweaked by tinram 6/6/07 to run with FB 0.17b (RETURNs in CASE statements were killing it)
' 0.16 original by jofers

'Option Explicit


#include "windows.bi"
#Include "fbgfx.bi"
Using FB
Type SaverInfo
    Bounds As Rect
    Bv4Header As BITMAPV4HEADER
    ClassName As String
    EndDialogPtr As INT_PTR
    hInstance As HINSTANCE
    hDC As HDC
    hMemBM As HBITMAP
    hMemDC As HDC
    hWnd As HWND
    hWndParent As HWND
    IsClosing As BOOL
    IsPreview As BOOL
    Message As MSG
    MouseLocation As Point
    PaintStruct As PAINTSTRUCT
    ScrWidth As Uinteger
    ScrHeight As Uinteger
    Style As Uinteger
    StyleEx As Uinteger
    Timer As Double
    TimerDelay As Double
    WindowClass As WNDCLASS
End Type

Dim Shared SaverInfo As SaverInfo

Declare Sub SetupScreenMode
Declare Sub StartConfigDialog
Declare Sub StartScreenSaver
Declare Sub WindowThread
Declare Function AboutDialogProc(Byval hWndDlg As HWND, Byval Message As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As BOOL
Declare Function ScreenSaverProc(Byval hWnd As HWND, Byval Message As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT

'''''''''''
'StartScreenSaver
'
'Do Until SaverInfo.IsClosing = TRUE
    'Pset(Rnd * SaverInfo.ScrWidth, Rnd * SaverInfo.Scrheight), Rgb(Rnd * 255, Rnd * 255, Rnd * 255)
'Loop
'''''''''''

Sub StartScreenSaver
    If Lcase(Left(Command, 2)) = "/c" Then
        StartConfigDialog
        End
    End If
   
    If Lcase(Left(Command, 2)) = "/p" Then SaverInfo.IsPreview = TRUE
    SetupScreenMode

    ThreadCreate @WindowThread
End Sub

' Sets up GFXLib to be compatible with the screen
Sub SetupScreenMode
    Dim hScreenDC As HDC
   
    SaverInfo.ScrWidth = GetSystemMetrics(SM_CXSCREEN)
    SaverInfo.ScrHeight = GetSystemMetrics(SM_CYSCREEN)
           
    ScreenRes SaverInfo.ScrWidth, SaverInfo.ScrHeight, 32, 1, -1
   
    ' This helps Windows convert its BMP format to GFXLib's
    With SaverInfo.Bv4Header
        .bV4Size = Len(BITMAPV4HEADER)
        .bV4Width = SaverInfo.ScrWidth
        .bV4Height = -SaverInfo.ScrHeight
        .bV4Planes = 1
        .bV4BitCount = 32
        .bV4V4Compression = BI_BITFIELDS
        .bV4SizeImage = SaverInfo.ScrWidth * SaverInfo.ScrHeight * 4
        .bV4XPelsPerMeter = 1
        .bV4YPelsPerMeter = 1
        .bV4ClrUsed = 0
        .bV4ClrImportant = 0
        .bV4RedMask = &h0F00
        .bV4GreenMask = &h00F0
        .bV4BlueMask = &h000F
        .bV4AlphaMask = &hF000
    End With
   
    'Set up memory DC and copy screen to it
    hScreenDC = GetWindowDC(GetDesktopWindow)
    SaverInfo.hMemDC = CreateCompatibleDC(hScreenDC)
    SaverInfo.hMemBM = CreateCompatibleBitmap(hScreenDC, SaverInfo.ScrWidth, SaverInfo.ScrHeight)
    SelectObject SaverInfo.hMemDC, SaverInfo.hMemBM
    BitBlt SaverInfo.hMemDC, 0, 0, SaverInfo.ScrWidth, SaverInfo.ScrHeight, hScreenDC, 0, 0, SRCCOPY
   
    'Copy memory DC (and consequentially, the screen) to ScreenPtr
    ScreenLock
    GetDIBits SaverInfo.hMemDC, SaverInfo.hMemBM, 0, SaverInfo.ScrHeight, ScreenPtr, CPtr(BitmapInfo Ptr, @SaverInfo.Bv4Header), DIB_RGB_COLORS
    ScreenUnlock
End Sub

Sub WindowThread
    With SaverInfo
        .hWndParent = Cast(hwnd,CInt(Val(Right(Command, Len(Command) - 3))))
        .hInstance = GetModuleHandle(NULL)
        .ClassName = "SCREENSAVERCLASS"
       
        'Set up window's class
        With .WindowClass
            .hCursor = NULL
            .hIcon = NULL
            .lpszMenuName = NULL
            .lpszClassName = Strptr(SaverInfo.ClassName)
            .hbrBackground = NULL'GetStockObject(WHITE_BRUSH)
            .hInstance = SaverInfo.hInstance
            .style = CS_VREDRAW Or CS_HREDRAW Or CS_SAVEBITS Or CS_PARENTDC
            .lpfnWndProc = @ScreenSaverProc
            .cbWndExtra = 0
            .cbClsExtra = 0
        End With
    End With

    'Register the window class
    If RegisterClass(@SaverInfo.WindowClass) = 0 Then
        MessageBox 0, "ScreenSaver Failed To Initialize", "Error!", MB_ICONERROR
        End
    End If   
   
    'Change some settings based on whether or not it's in the preview box
    If SaverInfo.IsPreview = True Then
        SaverInfo.Style = WS_CHILD
        SaverInfo.StyleEx = 0
        GetWindowRect SaverInfo.hWndParent, @SaverInfo.Bounds
    Else
        SaverInfo.Style = CuInt(WS_POPUP Or WS_VISIBLE Or WS_MAXIMIZE)
        SaverInfo.StyleEx = WS_EX_TOPMOST
        GetWindowRect GetDesktopWindow, @SaverInfo.Bounds
        SetCursor NULL
    End If
   
    'Create and show the window
    SaverInfo.hWnd = CreateWindowEx( _
        SaverInfo.StyleEx, _
        Strptr(SaverInfo.ClassName),  _
        Strptr("SCREENSAVER"), _
        SaverInfo.Style, _
        0, _
        0, _
        SaverInfo.Bounds.Right, _
        SaverInfo.Bounds.Bottom, _
        SaverInfo.hWndParent, _
        NULL, _
        SaverInfo.hInstance, _
        NULL _
    )
   
    ShowWindow SaverInfo.hWnd, SW_SHOW
    UpdateWindow SaverInfo.hWnd
   
    'The infamous message loop
    While GetMessage(@SaverInfo.Message, NULL, 0, 0) = TRUE
        TranslateMessage @SaverInfo.Message
        DispatchMessage @SaverInfo.Message
    Wend
End Sub

Function ScreenSaverProc(Byval hWnd As HWND, Byval Message As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
    Dim TempMouseLocation As Point
    Dim Bounds As RECT
   
    'If the screensaver is not a preview, then close it in the event of a mouse click
    If SaverInfo.IsPreview = FALSE Then
        Select Case Message
            Case WM_LBUTTONDOWN
                                PostMessage hWnd, WM_CLOSE, 0, 0
                               
            Case WM_RBUTTONDOWN
                                PostMessage hWnd, WM_CLOSE, 0, 0
                               
            Case WM_MBUTTONDOWN
                                PostMessage hWnd, WM_CLOSE, 0, 0
                               
            Case WM_KEYDOWN
                                PostMessage hWnd, WM_CLOSE, 0, 0
                               
            Case WM_SYSKEYDOWN
                                PostMessage hWnd, WM_CLOSE, 0, 0
                               
            Case WM_MOUSEMOVE
                'WM_MOUSEMOVE actually happens all the time, so we have to compare
                GetCursorPos @TempMouseLocation
                If (TempMouseLocation.x <> SaverInfo.MouseLocation.x) Or _
                   (TempMouseLocation.y <> SaverInfo.MouseLocation.y) Then
                   PostMessage hWnd, WM_CLOSE, 0, 0
                   
                End If       
        End Select
    End If
   
    Select Case Message
    Case WM_CREATE
            'Store the cursor
            GetCursorPos @SaverInfo.MouseLocation
           
            'Create a ~60hz timer
            SetTimer hWnd, 1, 17, 0
           
            'Get the proper bounds, according to the screensaver size
            If SaverInfo.IsPreview Then
                GetWindowRect SaverInfo.hWndParent, @SaverInfo.Bounds
            Else
                GetWindowRect GetDesktopWindow, @SaverInfo.Bounds
            End If
           
           
        Case WM_DESTROY
            PostQuitMessage 0
            SaverInfo.IsClosing = TRUE
           
           
        Case WM_PAINT
            'Copy the GFXLib screen to the actual screen
            SaverInfo.hDC = BeginPaint(hWnd, @SaverInfo.PaintStruct)
            ScreenLock
            StretchDIBits SaverInfo.hDC, 0, 0, SaverInfo.Bounds.Right - SaverInfo.Bounds.Left, SaverInfo.Bounds.Bottom - SaverInfo.Bounds.Top, 0, 0, SaverInfo.ScrWidth, SaverInfo.ScrHeight, ScreenPtr, CPtr(BitmapInfo Ptr, @SaverInfo.Bv4Header), DIB_RGB_COLORS, SRCCOPY
            ScreenUnlock
            EndPaint hWnd, @SaverInfo.PaintStruct
           
           
        Case WM_TIMER
            'Force the window to update every timer tick
            InvalidateRect hWnd, NULL, 0
            UpdateWindow hWnd
           

        Case Else
            'Let windows handle the messages we don't care about
            Return DefWindowProc(hWnd, Message, wParam, lParam)
    End Select
End Function

Sub StartConfigDialog
    'Checks to see if the user included an about dialog
    If FindResource(SaverInfo.hInstance, "FB_SCRNSAVER_ABOUT", RT_DIALOG) Then
        DialogBox(SaverInfo.hInstance, "FB_SCRNSAVER_ABOUT", SaverInfo.hWndParent, @AboutDialogProc)
    Else
        MessageBox 0, "No Settings To Display", "Settings", MB_ICONINFORMATION
    End If   
End Sub

Function AboutDialogProc(Byval hWndDlg As HWND, Byval Message As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As BOOL
    'Display some info until the user clicks "OK" or closes the box
    Select Case Message
        Case WM_COMMAND
            Select Case LOWORD(wParam)
                Case IDOK:
                    EndDialog hWndDlg, wParam
                    Return TRUE
            End Select
    End Select
End Function
 