Страница: 1 |
|
Вопрос: Установка обоев с помощью api
|
Добавлено: 30.09.07 12:11
|
|
Автор вопроса: mechanical_man
|
Есть такая проблема: устанавливаю обои с помощью api Systemparametersinfo , но не могу задать расположение обоев (по центру, замостиь...). Подскажите, пожалуйста...
Ответить
|
Номер ответа: 2 Автор ответа: Sneaks
Вопросов: 9 Ответов: 84
|
Профиль | | #2
|
Добавлено: 30.09.07 15:29
|
делал на 6 ке:
это в модуль
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
' Routine to change the windows wallpaper.
' Call - ChangeWallPaper "c:\winnt\hello.bmp","Stretch"
' First param is name (and path) of required bmp.
' Second param is display type flag (either "Center", "Stretch" or "Tile".
'
Public Sub ChangeWallPaper(NewPaper As String, DisplayType As String)
Dim LTemp As Long
If DisplayType <> "Center" And DisplayType <> "Tile" And DisplayType <> "Stretch" Then
 isplayType = "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
' Cut down version of the write routine in the registry module
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
это на форму
Private Sub Command3_Click()
ChangeWallPaper "c:\freeware.bmp", "Center"
End Sub
Private Sub Command4_Click()
ChangeWallPaper "", "Center"
End Sub
на счет нет точно не знаю но думаю так же
Ответить
|
Страница: 1 |
Поиск по форуму