Hello everyone,
after some time of using FreeBasic, I finally decided to subscribe to this forum. I may not be a frequent guest here since I do not have a lot of time for programming related issues, but I might contribute from time to time.
Before finding this thread, I had already programmed a Windows screensaver in order to teach myself some Windows GUI programming. (Although it is not a pure "Windows" screensaver, since its fullscreen display uses an FB graphics window; but I think this would not be too difficult to change.) I hope the comments are understandable. - Graphics functions can be replaced by any other pattern, so the code can be used as a template for any screensaver. (The configuration dialog, however, is specific to this example which simulates several interferring water waves.)
So here goes the source code...
Code: Select all
'#######################################################################
'# #
'# WAVES SCREENSAVER FOR WINDOWS #
'# ============================= #
'# #
'# Shows interference patterns of up to 6 different waves. #
'# Complete with Preview and Configuration Dialog for customizing #
'# waves and color palette. #
'# #
'# Code is organized in such a way that it can be used as a template #
'# for other 8-bit paletted screensavers at a fixed screen resolution #
'# of 640x480. #
'# #
'# "Mandatory Fixed Functions" are functions which should be copied #
'# literally, without change. #
'# #
'# "Mandatory Customizable Functions" are functions which must be #
'# present and must accomplish the task specified in each function, #
'# but can be customized. Theses are the functions responsible for #
'# generating images, and for managing the Configuration Dialog #
'# Box. #
'# #
'# "Auxiliary functions" are additional functions needed by the #
'# customizable functions; their presence depends on them. #
'# #
'# This screensaver does not conform 100% to Windows standards #
'# because it does not use the internal Windows Screensaver Library, #
'# and because it uses an FB Graphics Window for the fullscreen #
'# animation. But it performs the tasks expected from a screensaver, #
'# namely Preview, Configuration Dialog, and Fullscreen display. #
'# #
'# For use as an actual screensaver, compile as a Windows GUI program,#
'# rename the extension from ".exe" to ".scr" and copy to the Windows #
'# System Folder. #
'# #
'# Tested so far under Windows 98 and Windows XP. #
'# #
'#######################################################################
'$lang: "fblite"
#Include Once "windows.bi"
#Include Once "commctrl.bi"
'Note: The first time, the compiler was unable to find "commctrl.bi".
' I had to copy it from the "win" subdirectory to the main "inc" directory.
'SCREEN SAVER COMMANDLINE PARAMETERS: (copied from a rather old internet article)
'/s = execute saver full screen.
'/p #### = Preview (#### = handle of parent window in decimal)
' Your saver should create a child window of it, of the same size, and display itself in this child window.
' Under Windows '95, if the Display Properties control panel regains focus at any time,
' then the preview window is first destroyed before the current saver is started in preview mode all over again.
' If it was your saver that was running as the preview, it should respond to the destruction of its window by terminating.
' Under NT, this does not happen.
' Also, obviously, when a different saver is selected in the control panel, then the previous one that was running in the little preview monitor will be destroyed.
'/c = Configuration dialog (execute as child window of current foreground window).
'(Note: under XP, the argument was "/c:XXXXXXXX" !)
'No arguments: Same, but use NULL as parent window.
'DefWindowProc(WM_SYSCOMMAND,SC_SCREENSAVE) executes the saver full screen.
'For fullscreen display: Change Screen Resolution with: ChangeDisplaySettings().
'########### Defines from RC File (Dialog Template) #################
#define IDD_DIALOG 1000
#define IDC_STATI 1001
#define IDC_TRACKBAR 1002
#define IDC_COLOR1 1003
#define IDC_RAINBOW 1004
#Define IDC_TRACKBAR2 1005
#define IDC_STATIC2 1006
#define IDC_COLOR2 1007
#define IDC_STC1 1008
#define IDC_CONTRAST 1009
#define IDC_EDIT 1010
#define IDC_STC2 1011
#define IDC_PALETTE 1012
#define IDC_CHK1 1020
#define IDC_CHK6 1025
#define IDC_EDT1 1026
#define IDC_OK 1056
#define IDC_CANCEL 1057
'############ Mandatory type declaration ###############
'Problem here: I did not manage to accomodate 256 palette entries within the
' BITMAPINFO type declared in the FB *.bi files.
' Therefore I created my own type and called it BITMAPINFO8.
Type BITMAPINFO8
bmiHeader As BITMAPINFOHEADER
bmiColors(255) As UInteger
End Type
'########### Custom types and initialization, only for this example ##############
Type waveparams Field=1
x As Integer
y As Integer
flag As Integer
amplitude As Double
wavelength As Double
speed As Double
End Type
Type PaletteData Field=1 'use CLOCK INDEX for color1,2 !
color1 As Integer
color2 As Integer
contrast As Short '"Short" because of Updown Control... !
End Type
Dim Shared As waveparams Wave(5) => { (50, 50, 1, 20, 20, 3),_
(300, 170, 1, 20, 17, 3.5),_
(1300, 240, 0, 20, 100, 1),_
(320, -200, 0, 20, 33, 6),_
(-500, 240, 0, 20, 7.3, 2.1),_
(320, 5000, 0, 20, 461, 9.7) }
Dim Shared As PaletteData Paldata = (&H23000, &H43000, 64)
Dim Shared As Double sinetable (1023)
Const pi2 As Double = 6.28318530717958647 'pi+pi
'############ Mandatory Fixed Functions ################
Declare Function Fullscreen()
Declare Function Preview (hParent)
Declare Function Config(hParent)
Declare Function WinMain (ByVal hInst As HINSTANCE, ByVal hPrevInst As HINSTANCE, lpCmdLine As String, ByVal nCmdShow) AS Integer
Declare Function WndProc (ByVal hWnd, ByVal uMsg, ByVal wParam, byval lParam) As Integer
'############# Mandatory Customizable Functions ####################
Declare Function InitFullImage ()
Declare Function UpdateFullImage ()
Declare Function InitPreviewImage ()
Declare Function UpdatePreviewImage ()
Declare Function DlgProc (byval hWnd, byval uMsg, byval wParam, ByVal lParam) As Integer
Declare Function ReadConfig()
Declare Function WriteConfig()
'############## Auxiliary Functions ####################
Declare Function MakeRainbowImage (hdc, clock1, clock2, contrast)
Declare Function MakeSolidImage (hdc, clr)
Declare Function ShowLastError (title$)
Declare Function ColorToClockIndex (clr)
Declare Function ClockIndexToColor (ByVal clock)
Declare Function MakeColor (hue, brightness)
Declare Function MakeGeneralRainbowPalette (clock1, clock2, contrast, pal())
'############################################################################
'################ FIXED CODE STARTS HERE (can be copied as is) ############
'############################################################################
Dim Shared hInstance, hwndDlg, counter
Dim Shared hdc, hdcWin, hDIB, pixdata
Dim Shared As RECT winRect
Dim Shared As BITMAPINFO8 BMPinfo
Dim Shared As Any Ptr FBImage
hInstance = GetModuleHandle(0)
Select Case Left$(Command$(1), 2)
Case "/s" 'Normal (Fullscreen)
Fullscreen()
Case "/p" 'Preview (Little window)
Preview(Val(Command$(2)))
Case "/c" 'Config Dialog
Config(GetForegroundWindow())
Case Else
Config(0)
End Select
End
Function Fullscreen()
'Here we use an FB Graphics Window, so no Win API functions for graphics.
ScreenRes 640,480,8,,1
SetMouse 320,240,0
res = SystemParametersInfo (SPI_SETSCREENSAVEACTIVE, TRUE, 0, 0)
FBImage = ImageCreate (640, 480)
InitFullImage () 'Must define palette in BMPInfo.
For i = 0 To 255
clr = BMPinfo.bmiColors(i)
Palette i, (clr Shr 16), ((clr Shr 8) And 255), clr And 255
Next
Do 'yes: this exits instead of allowing scrsaver to be "restored".
UpdateFullImage()
Put (0,0), FBImage, PSet
For i = 1 To 127
If MultiKey(i) Then Exit Do
'We cannot use SLEEP nor INKEY:
' Alt+Enter would restore our fullscreen window instead of exiting, etc.!
Next
GetMouse (x,y)
If (x < 318) Or (x > 322) Or (y < 238) Or (y > 242) Then Exit Do
Sleep 15
Loop
While InKey$<>"": Wend 'Empty keyboard buffer
SystemParametersInfo (SPI_SETSCREENSAVEACTIVE, FALSE, 0, 0)
End Function
Function Preview (hParent)
DIM wc AS WNDCLASSEX, message AS MSG, hwnd AS HWND
res = GetClientRect (hParent, @winRect)
w = winRect.right-winRect.left+1
h = winRect.bottom-winRect.top+1
className$ = "previewWindow"
wc.cbSize = LEN(WNDCLASSEX)
wc.style = CS_HREDRAW or CS_VREDRAW Or CS_OWNDC
wc.lpfnWndProc = @WndProc
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance
wc.hbrBackground = COLOR_WINDOW+1
wc.lpszMenuName = 0
wc.lpszClassName = STRPTR(className$)
wc.hIcon = LoadIcon (0, IDI_APPLICATION)
wc.hIconSm = wc.hIcon
wc.hCursor = LoadCursor (0, IDC_ARROW)
e = RegisterClassEx (VARPTR(wc))
hwnd = CreateWindowEx (NULL,_
className$,_
"Preview",_
WS_CHILD Or WS_VISIBLE,_
winRect.left,_
winrect.top,_
w,_
h,_
hParent,_
NULL,_
hInstance,_
NULL)
ShowWindow (hwnd, SW_SHOWDEFAULT)
UpdateWindow (hwnd)
BMPw = (w+3) And -4
BMPinfo.bmiHeader.biSize = 40 'struct size
BMPinfo.bmiHeader.biWidth = w
BMPinfo.bmiHeader.biHeight = h
BMPinfo.bmiHeader.biPlanes = 1
BMPinfo.bmiHeader.biBitCount = 8
BMPinfo.bmiHeader.biSizeImage = BMPw * h
InitPreviewImage ()
'''' hdc = CreateCompatibleDC(0)
' Creates a memory DC compatible with the application's current screen.
'All the following handles, and ptr "pixdata", are SHARED.)
hdcWin = GetDC (hwnd)
hdc = CreateCompatibleDC(hdcWin)
hDIB = CreateDIBSection (hdc, @BMPinfo, DIB_RGB_COLORS, @pixdata, 0, 0)
GDIFlush ()
msgPtr = VARPTR(message)
Do
' InvalidateRect (hWnd, 0, TRUE) 'param.2 = @winRect resp. 0 for entire client area.
UpdateWindow (hwnd) 'this was OK now (the line above not; all was white...)
Sleep 63
If PeekMessage (msgPtr, hWnd, 0, &H7FFFFFFF, PM_NOREMOVE) Then 'PM_REMOVE did not work...
If GetMessage (msgPtr, NULL, 0, 0) = 0 THEN EXIT DO
TranslateMessage (msgPtr)
DispatchMessage (msgPtr)
End If
Loop
DeleteDC (hdc)
DeleteObject (hDIB)
ReleaseDC (hWnd, hdcWin)
Function = message.wParam 'Return exit code.
End Function
Function Config(hParent)
Dim message AS MSG
InitCommonControls() '!!!
hwndDlg = CreateDialogParam (hInstance, IDD_DIALOG, hParent, @DlgProc, 0)
msgPtr = VARPTR(message)
DO
again:
IF GetMessage (msgPtr, NULL, 0, 0) = 0 THEN EXIT DO
IF IsDialogMessage (hwndDlg, msgPtr) THEN GOTO again
TranslateMessage (msgPtr)
DispatchMessage (msgPtr)
Loop Until hwndDlg = 0 '!!! (DlgProc must notify us by means of a SHARED var. that it has been closed!)
RETURN message.wParam
'following is for Dlg as Main Window...
' END DialogBoxParam (hInstance, IDD_DIALOG, 0, @DlgProc, 0)
End Function
FUNCTION WndProc (byval hWnd, byval uMsg, byval wParam, byval lParam) As Integer
SELECT CASE uMsg
Case WM_PAINT
' hdcWin = GetDC (hwnd)
' hdc = CreateCompatibleDC(hdcWin)
' hDIB = CreateDIBSection (hdc, @BMPinfo, DIB_RGB_COLORS, @pixdata, 0, 0)
' GDIFlush ()
'Not necessary. We can work all the time with the same SHARED DCs and handles.
UpdatePreviewImage()
dummy = SelectObject (hdc, hDIB)
GDIFlush ()
'Following line uses the SHARED winRect coords, instead of retrieving them every time anew.
BitBlt (hdcWin, winRect.left,winRect.top, winRect.right, winRect.bottom, hdc, 0,0, SRCCOPY)
' ReleaseDC (hwnd, hdcWin)
' DeleteDC (hdc)
' DeleteObject (hDIB)
Case WM_DESTROY
PostQuitMessage (0)
CASE ELSE
Function = DefWindowProc(hWnd,uMsg,wParam,lParam): Exit Function
END SELECT
END FUNCTION
'############################################################################
'################ FIXED CODE ENDS HERE ############
'############################################################################
'######### Following functions must be present, but can be customized. ######
Function InitFullImage ()
'This function MUST define palette in BMPInfo.bmiColors().
ReadConfig()
MakeGeneralRainbowPalette (Paldata.color1, Paldata.color2, Cast(Integer, Paldata.contrast), BMPinfo.bmiColors())
'For sine values: use a lookup table to increase speed.
For i = 0 To 1023
sinetable(i) = Sin(i*pi2/1024)
Next
End Function
Function UpdateFullImage ()
'This function must update the image in FBImage,
' and the SHARED var. "counter".
Dim As UByte Ptr ptr1
Dim factor#(5)
For i = 0 To 5
factor#(i) = 1024/Wave(i).wavelength
Next
ImageInfo (FBImage, w,h, bypp, pitch, pixdata)
ptr1 = pixdata
'Set blocks of 4 pixels to the same color; else it is too slow.
For y = 0 To 239
For x = 0 To 319
waveH# = 128
For i = 0 To 5
If Wave(i).flag Then
dx = wave(i).x-x: dy = wave(i).y-y
dist# = Sqr(dx*dx+dy*dy)
index = Cast(Integer, (dist#-counter*wave(i).speed)*factor#(i)) And 1023
'Here we use the sine table initialized in InitFullImage.
waveH# += wave(i).amplitude * sinetable(index)
End If
Next
clr = Int(waveH#)
If clr < 0 Then clr=0
If clr > 255 Then clr=255
*ptr1 = clr
ptr1 +=640
*ptr1 = clr
ptr1 += 1
*ptr1 = clr
ptr1 -= 640
*ptr1 = clr
ptr1 += 1
Next
ptr1 += 640
Next
counter += 1
End Function
Function InitPreviewImage ()
'This function MUST define palette in BMPInfo.bmiColors().
ReadConfig()
MakeGeneralRainbowPalette (Paldata.color1, Paldata.color2, Cast(Integer, Paldata.contrast), BMPinfo.bmiColors())
For i = 0 To 1023
sinetable(i) = Sin(i*pi2/1024)
Next
End Function
Function UpdatePreviewImage ()
'This function must update the image at (SHARED) pixPtr
' with the dimensions specified in BMPinfo.bmiHeader.
' It must also update the SHARED var. "counter".
Dim ptr1 As UByte Ptr
Dim factor#(5)
For i = 0 To 5
' factor#(i) = pi2/Wave(i).wavelength 'no, we use a circle divided in 1024 "degrees".
factor#(i) = 1024/Wave(i).wavelength
Next
ptr1 = pixdata
w = BMPinfo.bmiHeader.biWidth
pad = (-w) And 3
scale = 320/w
yy = 240
For y = 0 To BMPinfo.bmiHeader.biHeight-1
xx = 0
For x = 0 To w-1
waveH# = 128
For i = 0 To 5
If Wave(i).flag Then
dx = wave(i).x-xx: dy = wave(i).y-yy
dist# = Sqr(dx*dx+dy*dy)
' waveH# += wave(i).amplitude * Sin((dist#-counter*wave(i).speed)*factor#(i))
'line above is old code; now we use a lookup table for sine values.
index = Cast(Integer, (dist#-counter*wave(i).speed)*factor#(i)) And 1023
waveH# += wave(i).amplitude * sinetable(index)
End If
Next
clr = Int(waveH#)
If clr < 0 Then clr=0
If clr > 255 Then clr=255
*ptr1 = clr
ptr1 += 1
xx += scale
Next
ptr1 += pad
yy -= scale
Next
counter += 1
End Function
Function DlgProc (byval hWnd, byval uMsg, byval wParam, byval lParam) AS Integer
'This function must respond to the messages from the Configuration Dialog.
STATIC hwndEdit, hwndButton, hTrackbar1, hTrackbar2, hColor1, hColor2, hPalette
Dim myRect As RECT
Dim drPtr As DRAWITEMSTRUCT Ptr
Dim contrast As Short '!! from an Updown control: -1 = (0000)FFFF !
SELECT CASE uMsg
Case WM_INITDIALOG
'=================
' SetFocus (GetDlgItem(hWnd, IDC_CONTRAST))
mini = 0: maxi = &H5FF
SendDlgItemMessage (hWnd, IDC_TRACKBAR, TBM_SETRANGE, TRUE, mini + (maxi Shl 16))
SendDlgItemMessage (hWnd, IDC_TRACKBAR2, TBM_SETRANGE, TRUE, mini + (maxi Shl 16))
hTrackbar1 = GetDlgItem(hWnd, IDC_TRACKBAR)
hTrackbar2 = GetDlgItem(hWnd, IDC_TRACKBAR2)
hColor1 = GetDlgItem(hWnd, IDC_COLOR1)
hColor2 = GetDlgItem(hWnd, IDC_COLOR2)
hPalette = GetDlgItem(hWnd, IDC_PALETTE)
hEdit = GetDlgItem(hWnd, IDC_EDIT)
SendDlgItemMessage (hWnd, IDC_CONTRAST, UDM_SETBUDDY, hEdit, 0)
SendDlgItemMessage (hWnd, IDC_CONTRAST, UDM_SETRANGE, 0, &HFF81007F) 'here is MINIMUM the MSW!
'! Can NOT set images here...!
' (anyway OWNERDRAW style is better.)
ReadConfig()
pos1 = Paldata.color1 Shr 8
pos2 = Paldata.color2 Shr 8
SendDlgItemMessage (hWnd, IDC_TRACKBAR, TBM_SETPOS, TRUE, pos1)
SendDlgItemMessage (hWnd, IDC_TRACKBAR2, TBM_SETPOS, TRUE, pos2)
SendDlgItemMessage (hWnd, IDC_CONTRAST, UDM_SETPOS, 0, Paldata.contrast And &HFFFF)
id = IDC_EDT1
For i = 0 To 5
SetDlgItemText (hWnd, id, Str$(Wave(i).x))
SetDlgItemText (hWnd, id+1, Str$(Wave(i).y))
SetDlgItemText (hWnd, id+2, Str$(Wave(i).wavelength))
SetDlgItemText (hWnd, id+3, Str$(Wave(i).amplitude))
SetDlgItemText (hWnd, id+4, Str$(Wave(i).speed * 10)) '?? factor??
If Wave(i).flag Then
SendDlgItemMessage (hWnd, IDC_CHK1+i, BM_SETCHECK, BST_CHECKED, 0)
Else
For k = 0 To 4
SendDlgItemMessage (hWnd, id+k, EM_SETREADONLY, TRUE, 0)
Next
EndIf
id += 5
Next
Case WM_CLOSE
'===============
EndDialog (hWnd, 0)
hwndDlg = 0 '! signal to Main that we are finished!
Case WM_DRAWITEM 'for owner-drawn controls
'===============
clock1 = SendDlgItemMessage (hWnd, IDC_TRACKBAR, TBM_GETPOS, 0,0)
clock2 = SendDlgItemMessage (hWnd, IDC_TRACKBAR2, TBM_GETPOS, 0,0)
drPtr = lParam
hdcWin = drPtr -> hDC
myRect = drPtr -> rcItem
w = myRect.right-myRect.left+1
h = myRect.bottom-myRect.top+1
hdc = CreateCompatibleDC(hdcWin)
Select Case wParam 'ctrl id
Case IDC_RAINBOW
hImg = MakeRainbowImage (hdc, 0, &H5FFFF, 0)
imgW = 256: imgH = 20
Case IDC_COLOR1
hImg = MakeSolidImage (hdc, ClockIndexToColor(clock1 Shl 8))
imgW = 8: imgH = 8
Case IDC_COLOR2
hImg = MakeSolidImage (hdc, ClockIndexToColor(clock2 Shl 8))
imgW = 8: imgH = 8
Case IDC_PALETTE
contrast = SendDlgItemMessage (hWnd, IDC_CONTRAST, UDM_GETPOS, 0,0)
hImg = MakeRainbowImage (hdc, clock1 Shl 8, clock2 Shl 8, Cast(Integer, contrast))
imgW = 256: imgH = 20
End Select
dummy = SelectObject (hdc, hImg)
GDIFlush ()
StretchBlt (hdcWin, myRect.left,myRect.top, w,h, hdc, 0,0, imgW, imgH, SRCCOPY)
'before-last 4 params are x,y,w,h of SOURCE rectangle.
DeleteDC (hdc)
DeleteObject (hImg)
''NOT!! ReleaseDC (hwnd, hdcWin)
CASE WM_COMMAND
'===============
IF lParam=0 Then 'Menu Item selected; does not apply in this program
' SELECT CASE wParam AND &HFFFF
' CASE IDM_TEXT
' buffer$ = SPACE$(512)
' GetDlgItemText (hWnd, IDC_EDITAR, buffer$, LEN(buffer$))
' MessageBox (0, buffer$, "Config", MB_OK)
' CASE IDM_CLEAR
' SetDlgItemText (hWnd, IDC_EDITAR, NULL)
' CASE IDM_EXIT
' EndDialog (hWnd, 0)
' hwndDlg = 0 '! signal to Main that we are finished!
' END SELECT
ELSE 'Msg from a Dialog Control
SELECT CASE (wParam SHR 16)
CASE BN_CLICKED
SELECT CASE (wParam AND &HFFFF)
Case IDC_CHK1 To IDC_CHK6
btn = (wParam AND &HFFFF)
check = SendDlgItemMessage (hWnd, btn, BM_GETCHECK, 0,0)
If check = BST_CHECKED Then flag = FALSE Else flag = TRUE
btn -= IDC_CHK1
idEdit = IDC_EDT1 + 5*btn
For i = 0 To 4
SendDlgItemMessage (hWnd, idEdit+i, EM_SETREADONLY, flag, 0)
Next i
CASE IDC_OK
Paldata.color1 = SendDlgItemMessage (hWnd, IDC_TRACKBAR, TBM_GETPOS, 0,0) Shl 8
Paldata.color2 = SendDlgItemMessage (hWnd, IDC_TRACKBAR2, TBM_GETPOS, 0,0) Shl 8
Paldata.contrast = SendDlgItemMessage (hWnd, IDC_CONTRAST, UDM_GETPOS, 0,0)
id = IDC_EDT1
For i = 0 To 5
buffer$ = SPACE$(32)
GetDlgItemText (hWnd, id, buffer$, LEN(buffer$))
Wave(i).x = Val(buffer$)
GetDlgItemText (hWnd, id+1, buffer$, LEN(buffer$))
Wave(i).y = Val(buffer$)
GetDlgItemText (hWnd, id+2, buffer$, LEN(buffer$))
Wave(i).wavelength = Val(buffer$)
GetDlgItemText (hWnd, id+3, buffer$, LEN(buffer$))
Wave(i).amplitude = Val(buffer$)
GetDlgItemText (hWnd, id+4, buffer$, LEN(buffer$))
Wave(i).speed = Val(buffer$)/10 '? factor ??
id += 5
check = SendDlgItemMessage (hWnd, IDC_CHK1+i, BM_GETCHECK, 0,0)
Select Case check
Case BST_CHECKED
Wave(i).flag = 1
Case Else
Wave(i).flag = 0
End Select
Next
WriteConfig()
EndDialog (hWnd, 0)
hwndDlg = 0 '! signal to Main that we are finished!
Case IDC_CANCEL
EndDialog (hWnd, 0)
hwndDlg = 0 '! signal to Main that we are finished!
END SELECT
END SELECT
END IF
CASE WM_HSCROLL 'from Trackbar!! lParam = handle of scrollbar/trackbar.
'===============
Select Case lParam
Case hTrackbar1
InvalidateRect (hColor1, 0, FALSE)
Case hTrackbar2
InvalidateRect (hColor2, 0, FALSE)
End Select
InvalidateRect (hPalette, 0, FALSE)
Case WM_VSCROLL 'from Updown-Control
'===============
InvalidateRect (hPalette, 0, FALSE)
CASE ELSE
RETURN FALSE
END SELECT
RETURN TRUE
END Function
'######### Functions to store and retrieve configuration data to/from Registry.
'Are used in the Configuration Dialog, and in InitFullImage(), InitPreviewImage().
'If your screensaver does not store configuration data,
' these functions are not needed.
Function ReadConfig()
res = RegCreateKeyEx (HKEY_CURRENT_USER, @"Software", 0, @"dummyClass", 0, KEY_ALL_ACCESS, 0, @hSoftware, @action)
'this OPENS the key if already exists; check "action" retval for the difference.
If res Then
ShowLastError ("ReadConfig 1")
EndIf
res2 = RegCreateKeyEx (hSoftware, @"WavesScrsaver", 0, @"dummyClass", 0, KEY_ALL_ACCESS, 0, @hMyKey, @action)
If (res Or res2) Then '0, 6 !! ERROR_INVALID_HANDLE
ShowLastError ("ReadConfig 2")
Exit Function
EndIf
If action = REG_CREATED_NEW_KEY Then
'Config Data should be the same as initialized...
RegSetValueEx (hMyKey, @"Waves", 0, REG_BINARY, @Wave(0), 6*Len(waveparams))
RegSetValueEx (hMyKey, @"Palette", 0, REG_BINARY, @Paldata, Len(Paldata))
Else 'Key exists already
wSize = 6*Len(waveparams)
pSize = Len(Paldata)
RegQueryValueEx (hMyKey, @"Waves", 0, 0, @Wave(0), @wSize)
RegQueryValueEx (hMyKey, @"Palette", 0, 0, @Paldata, @pSize)
EndIf
RegCloseKey (hMyKey)
RegCloseKey (hSoftware)
End Function
Function WriteConfig()
res = RegCreateKeyEx (HKEY_CURRENT_USER, @"Software", 0, @"dummyClass", 0, KEY_ALL_ACCESS, 0, @hSoftware, @action)
'this OPENS the key if already exists; check "action" retval for the difference.
If res Then ShowLastError ("WriteConfig 1")
res2 = RegCreateKeyEx (hSoftware, @"WavesScrsaver", 0, @"dummyClass", 0, KEY_ALL_ACCESS, 0, @hMyKey, @action)
If (res Or res2) Then
ShowLastError ("WriteConfig 2")
Exit Function
EndIf
RegSetValueEx (hMyKey, @"Waves", 0, REG_BINARY, @Wave(0), 6*Len(waveparams))
RegSetValueEx (hMyKey, @"Palette", 0, REG_BINARY, @Paldata, Len(Paldata))
RegCloseKey (hMyKey)
RegCloseKey (hSoftware)
End Function
'###########################################################################
'########### END OF MANDATORY CUSTOMIZABLE FUNCTIONS ###############
'###########################################################################
'######## Following functions are auxiliary functions for the present example.
Function MakeRainbowImage (hdc, clock1, clock2, contrast)
'Used for generating the rainbow colors on Dialog Control
Dim pixPtr As UByte Ptr
BMPinfo.bmiHeader.biSize = 40 'struct size
BMPinfo.bmiHeader.biWidth = 256
BMPinfo.bmiHeader.biHeight = 20
BMPinfo.bmiHeader.biPlanes = 1
BMPinfo.bmiHeader.biBitCount = 8
BMPinfo.bmiHeader.biSizeImage = 256*20
MakeGeneralRainbowPalette (clock1, clock2, contrast, BMPinfo.bmiColors())
hDIB = CreateDIBSection (hdc, @BMPinfo, DIB_RGB_COLORS, @newPixdata, 0, 0)
GDIFlush ()
pixPtr = newPixdata
For y = 0 To 19
For x = 0 To 255
*pixPtr = x
pixPtr += 1
Next
Next
Function = hDIB
End Function
Function MakeSolidImage (hdc, clr)
'Used for generating the Color Samples in the Configuration Dialog.
Dim pixPtr As UByte Ptr
BMPinfo.bmiHeader.biSize = 40 'struct size
BMPinfo.bmiHeader.biWidth = 8
BMPinfo.bmiHeader.biHeight = 8
BMPinfo.bmiHeader.biPlanes = 1
BMPinfo.bmiHeader.biBitCount = 8
BMPinfo.bmiHeader.biSizeImage = 8*8
BMPinfo.bmiColors(0) = clr
hDIB = CreateDIBSection (hdc, @BMPinfo, DIB_RGB_COLORS, @newPixdata, 0, 0)
GDIFlush ()
'Following is not necessary in newer versions of Windows,
' because DIBSection is initialized to all zeroes; but in Win 98 NOT!
pixPtr = newPixdata
For i = 0 To 63
*pixPtr = 0
pixPtr += 1
Next
Function = hDIB
End Function
Function ShowLastError (title$)
erro = GetLastError()
buffer$ = String$(256,32)
FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, 0, erro, 0, buffer$, Len(buffer$), 0)
MessageBox (0, buffer$, title$, MB_OK)
End Function
Function ColorToClockIndex (clr)
'returns a "clock number" where Byte 0 = 0, Byte 1 = Step value;
'Byte 3: red=0, orange=1 yellow=2, green=3, blue=4, violet=5
'Assumes clr is a "pure hue" (one clr component is 0).
If (clr And &HFF00FF) = &HFF0000 Then
Function = (clr And &H0FF00) Shl 1: Exit Function
ElseIf (clr And &H0FFFF) = &H0FF00 Then
Function = &H2FF00 - ((clr And &HFF0000) Shr 8): Exit Function
ElseIf (clr And &HFF0000) = 0 Then
Function = &H30000 + ((clr And 255) Shl 8): Exit Function
ElseIf (clr And &H0FFFF) = &H00FF Then
Function = &H40000 + ((clr And &HFF0000) Shr 8): Exit Function
ElseIf (clr And &HFFFF00) = &HFF0000 Then
Function = &H5FF00 - ((clr And 255) Shl 8): Exit Function
Else
Function = -1 'signal error, no pure hue.
EndIf
End Function
Function ClockIndexToColor (ByVal clock)
If clock >= &H60000 Then clock -= &H60000
B = clock And &HFF00
Select Case clock
Case Is < 0
Case Is < &H20000
Function = &HFF0000 + ((clock shr 1) And &H0FF00)
Case Is < &H30000
Function = &HFFFF00 - (B Shl 8)
Case Is < &H40000
Function = &H00FF00 + (B Shr 8) - B
Case Is < &H50000
Function = &H0000FF + (B Shl 8)
Case Is < &H60000
Function = &HFF00FF - (B Shr 8)
End Select
End Function
Function MakeGeneralRainbowPalette (clock1, clock2, contrast, pal())
'Contrast: from -127 (bright to dark) to 127 (dark to bright).
'Pal. turns always red-yellow-blue-red.
bright = (128-contrast) Shl 8
brightStep = contrast+contrast
If clock2 < clock1 Then clock2 += &H60000
hueStep = (clock2-clock1) Shr 8
clock = clock1
pal(0) = MakeColor (ClockIndexToColor(clock), bright Shr 8)
For i = 1 To 255
clock += hueStep
bright += brightStep
pal(i) = MakeColor (ClockIndexToColor(clock), bright Shr 8)
Next
End Function
Function MakeColor (hue, brightness)
If brightness <= 0 Then Exit Function 'return directly 0
If brightness >= 255 Then Function = &HFFFFFF: Exit Function
red = hue Shr 16
green = (hue Shr 8) And 255
blue = hue And 255
sum = red + green + blue
newSum = brightness + brightness + brightness
If newSum = sum Then Function = hue: Exit Function
If newSum < sum Then
red = red*newSum/sum
blue = blue*newSum/sum
green = green*newSum/sum
Else
factor# = (765-newSum)/(765-sum)
red = 255 - (255-red)*factor#
blue = 255 - (255-blue)*factor#
green = 255 - (255-green)*factor#
EndIf
Function = (red Shl 16) Or (green Shl 8) Or blue
End Function
.. and here the RC file:
Code: Select all
#define IDD_DIALOG 1000
#define IDC_STATI 1001
#define IDC_TRACKBAR 1002
#define IDC_COLOR1 1003
#define IDC_RAINBOW 1004
#define IDC_TRACKBAR2 1005
#define IDC_STATIC2 1006
#define IDC_COLOR2 1007
#define IDC_STC1 1008
#define IDC_CONTRAST 1009
#define IDC_EDIT 1010
#define IDC_STC2 1011
#define IDC_PALETTE 1012
#define IDC_STC3 1013
#define IDC_STC4 1014
#define IDC_STC5 1015
#define IDC_STC6 1016
#define IDC_STC7 1017
#define IDC_STC8 1018
#define IDC_STC9 1019
#define IDC_CHK1 1020
#define IDC_CHK2 1021
#define IDC_CHK3 1022
#define IDC_CHK4 1023
#define IDC_CHK5 1024
#define IDC_CHK6 1025
#define IDC_EDT1 1026
#define IDC_EDT2 1027
#define IDC_EDT3 1028
#define IDC_EDT4 1029
#define IDC_EDT5 1030
#define IDC_EDT6 1031
#define IDC_EDT7 1032
#define IDC_EDT8 1033
#define IDC_EDT9 1034
#define IDC_EDT10 1035
#define IDC_EDT11 1036
#define IDC_EDT12 1037
#define IDC_EDT13 1038
#define IDC_EDT14 1039
#define IDC_EDT15 1040
#define IDC_EDT16 1041
#define IDC_EDT17 1042
#define IDC_EDT18 1043
#define IDC_EDT19 1044
#define IDC_EDT20 1045
#define IDC_EDT21 1046
#define IDC_EDT22 1047
#define IDC_EDT23 1048
#define IDC_EDT24 1049
#define IDC_EDT25 1050
#define IDC_EDT26 1051
#define IDC_EDT27 1052
#define IDC_EDT28 1053
#define IDC_EDT29 1054
#define IDC_EDT30 1055
#define IDC_OK 1056
#define IDC_CANCEL 1057
IDD_DIALOG DIALOGEX 10,10,256,252
CAPTION "Configuration"
FONT 8,"MS Sans Serif",0,0,0
STYLE 0x10CF0000
BEGIN
CONTROL "Initial color:",IDC_STATI,"Static",0x50000201,0,0,216,12
CONTROL "",IDC_TRACKBAR,"msctls_trackbar32",0x50000000,0,12,220,20
CONTROL "0",IDC_COLOR1,"Static",0x5000000D,220,8,28,16
CONTROL "",IDC_RAINBOW,"Static",0x5000000D,4,36,208,12
CONTROL "",IDC_TRACKBAR2,"msctls_trackbar32",0x50000004,0,64,220,24
CONTROL "Final color:",IDC_STATIC2,"Static",0x50000201,0,48,220,16
CONTROL "IDC_STC",IDC_COLOR2,"Static",0x5000000D,220,48,28,16
CONTROL "Contrast:",IDC_STC1,"Static",0x50000201,220,64,36,12
CONTROL "",IDC_CONTRAST,"msctls_updown32",0x50000022,220,76,12,16
CONTROL "",IDC_EDIT,"Edit",0x50010000,232,76,24,16,0x00000200
CONTROL "Palette:",IDC_STC2,"Static",0x50000202,0,96,32,16
CONTROL "IDC_STC",IDC_PALETTE,"Static",0x5000000D,36,96,220,16
CONTROL "Wave parameters:",IDC_STC3,"Static",0x50000001,0,124,256,12
CONTROL "Activated:",IDC_STC4,"Static",0x50000201,0,140,40,12
CONTROL "x",IDC_STC5,"Static",0x50000201,40,140,40,16
CONTROL "y",IDC_STC6,"Static",0x50000201,80,140,40,16
CONTROL "Wavelength",IDC_STC7,"Static",0x50000201,120,140,40,16
CONTROL "Amplitude",IDC_STC8,"Static",0x50000201,160,140,40,16
CONTROL "Speed",IDC_STC9,"Static",0x50000201,200,140,40,16
CONTROL "1",IDC_CHK1,"Button",0x50010003,12,156,24,12
CONTROL "2",IDC_CHK2,"Button",0x50010003,12,168,24,12
CONTROL "3",IDC_CHK3,"Button",0x50010003,12,180,24,12
CONTROL "4",IDC_CHK4,"Button",0x50010003,12,192,24,12
CONTROL "5",IDC_CHK5,"Button",0x50010003,12,204,24,12
CONTROL "6",IDC_CHK6,"Button",0x50010003,12,216,24,12
CONTROL "",IDC_EDT1,"Edit",0x50010000,40,156,40,12,0x00000200
CONTROL "",IDC_EDT2,"Edit",0x50010000,80,156,40,12,0x00000200
CONTROL "",IDC_EDT3,"Edit",0x50010000,120,156,40,12,0x00000200
CONTROL "",IDC_EDT4,"Edit",0x50010000,160,156,40,12,0x00000200
CONTROL "",IDC_EDT5,"Edit",0x50010000,200,156,40,12,0x00000200
CONTROL "",IDC_EDT6,"Edit",0x50010000,40,168,40,12,0x00000200
CONTROL "",IDC_EDT7,"Edit",0x50010000,80,168,40,12,0x00000200
CONTROL "",IDC_EDT8,"Edit",0x50010000,120,168,40,12,0x00000200
CONTROL "",IDC_EDT9,"Edit",0x50010000,160,168,40,12,0x00000200
CONTROL "",IDC_EDT10,"Edit",0x50010000,200,168,40,12,0x00000200
CONTROL "",IDC_EDT11,"Edit",0x50010000,40,180,40,12,0x00000200
CONTROL "",IDC_EDT12,"Edit",0x50010000,80,180,40,12,0x00000200
CONTROL "",IDC_EDT13,"Edit",0x50010000,120,180,40,12,0x00000200
CONTROL "",IDC_EDT14,"Edit",0x50010000,160,180,40,12,0x00000200
CONTROL "",IDC_EDT15,"Edit",0x50010000,200,180,40,12,0x00000200
CONTROL "",IDC_EDT16,"Edit",0x50010000,40,192,40,12,0x00000200
CONTROL "",IDC_EDT17,"Edit",0x50010000,80,192,40,12,0x00000200
CONTROL "",IDC_EDT18,"Edit",0x50010000,120,192,40,12,0x00000200
CONTROL "",IDC_EDT19,"Edit",0x50010000,160,192,40,12,0x00000200
CONTROL "",IDC_EDT20,"Edit",0x50010000,200,192,40,12,0x00000200
CONTROL "",IDC_EDT21,"Edit",0x50010000,40,204,40,12,0x00000200
CONTROL "",IDC_EDT22,"Edit",0x50010000,80,204,40,12,0x00000200
CONTROL "",IDC_EDT23,"Edit",0x50010000,120,204,40,12,0x00000200
CONTROL "",IDC_EDT24,"Edit",0x50010000,160,204,40,12,0x00000200
CONTROL "",IDC_EDT25,"Edit",0x50010000,200,204,40,12,0x00000200
CONTROL "",IDC_EDT26,"Edit",0x50010000,40,216,40,12,0x00000200
CONTROL "",IDC_EDT27,"Edit",0x50010000,80,216,40,12,0x00000200
CONTROL "",IDC_EDT28,"Edit",0x50010000,120,216,40,12,0x00000200
CONTROL "",IDC_EDT29,"Edit",0x50010000,160,216,40,12,0x00000200
CONTROL "",IDC_EDT30,"Edit",0x50010000,200,216,40,12,0x00000200
CONTROL "OK",IDC_OK,"Button",0x50010000,60,232,64,16
CONTROL "Cancel",IDC_CANCEL,"Button",0x50010000,148,232,64,16
END
I hope it is useful.
