Keskustelu: Ohjelmointikysymykset: VB6: Näytönsäästäjä <vb6>

'***Moduliin

Option Explicit
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Const HKEY_CURRENT_USER = &H80000001
Global Const SPIF_SENDWININICHANGE = &H2
Global Const SPIF_UPDATEINIFILE = &H1
Global Const SPI_GETSCREENSAVETIMEOUT = 14
Global Const SPI_SETSCREENSAVETIMEOUT = 15
Global Const SPI_GETSCREENSAVEACTIVE = 16
Global Const SPI_SETSCREENSAVEACTIVE = 17
Global Const SPI_SETDESKWALLPAPER = 20


Public Sub Tausta(NewPaper As String, DisplayType As String)
Dim LTemp As Long
If DisplayType <> "Center" And DisplayType <> "Tile" And DisplayType <> "Stretch" Then
   DisplayType = "Stretch"
End If
If DisplayType = "Center" Then
   WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", "0"
   WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "0"
ElseIf DisplayType = "Tile" Then
   WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", "1"
   WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "0"
ElseIf DisplayType = "Stretch" Then
   WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", "0"
   WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "2"
End If
LTemp = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, NewPaper, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub

Private Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, NewVal As String)
Dim lResult As Long, lKeyValue As Long
Dim InLen As Long
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
InLen = Len(NewVal)
lResult = RegSetValueEx(lKeyValue, Key, 0&, 1&, NewVal, InLen)
lResult = RegFlushKey(lKeyValue)
lResult = RegCloseKey(lKeyValue)
End Sub




'***Formiin

Private Sub Command1_Click()
Tausta CommonDialog1.FileName, "Center"
End Sub

Private Sub Command2_Click()
Tausta CommonDialog1.FileName, "Stretch"
End Sub

Private Sub Command3_Click()
Tausta CommonDialog1.FileName, "Tile"
End Sub

Private Sub Command4_Click()
Tausta "", "Center"
End Sub

Private Sub Command5_Click()
CommonDialog1.Filter = "Bitmap (*.bmp)|*.bmp"
10
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then GoTo 10
Tausta CommonDialog1.FileName, "Center"
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
End Sub