刷新屏幕

方法二
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As Any, ByVal bErase As Long) As Long


Private Sub Command1_Click()
Call InvalidateRect(0, ByVal 0&, True)
End Sub

一个比一个厉害...

King 你跟潜水怎么出这种东西。。�

????? 怎么了？我记得以前好象ＣＢＭ老师还找过这东西呢�

呵呵你还记得啊, 当时就是因为桌面背景图片要 "即时" 更新, 当时想到的办法就是只要能刷新就OK了, 但那时就是找不到答案, 因祸得福, 却让我得到了更好的解决方式,云霞散人的一个参数就搞定了.

参数？什么参数，透露一下啊

您的那个软件做完了吗?
我也做过一个.可是 显示位置 (拉伸,平铺,居中) 我做不出来.
不知可否把您的那个发一份给我研究一下?

YM_0433@163.com

先谢过.

我没做那么多,我只做 "拉伸", 其它很简单啊, 居中就是用 (screen.width-picture1.width)\2 与 (screen.height-picture1.height)\2

平铺就是几张小图片用屏幕的宽与高去除上图片的宽与高, 这个你不会的话我再给你写下代码吧.

回7F 下面这行就是重点
SystemParametersInfo SPI_SETDESKWALLPAPER, 0, wallpaper, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE



Private 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
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2
Dim jj%, wallpaper$
Private Sub Form_Load()
 Command1.Caption = "更换桌面"
End Sub

Private Sub Command1_Click()
 CommonDialog1.DialogTitle = "Choose a bitmap"
 CommonDialog1.Filter = "Windows Bitmaps (*.BMP)|*.bmp|All Files (*.*)|*.*"
 CommonDialog1.ShowOpen
 If CommonDialog1.FileName <> "" Then
 wallpaper = CommonDialog1.FileName
 jj = InStrRev(wallpaper, ".")
 If jj > 0 Then
 If UCase(Mid(wallpaper, jj + 1, Len(wallpaper) - jj)) <> "BMP" Then
 wallpaper = Mid(wallpaper, 1, jj - 1)
 wallpaper = wallpaper & ".bmp"
 '这是我代码里面的 Picture1本身有一张图片
 SavePicture Picture1.Picture, wallpaper
 End If
 SystemParametersInfo SPI_SETDESKWALLPAPER, 0, wallpaper, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
 End If
 End If
End Sub

'这是小图片 "平铺" 后设为桌面
'添加Picture1

Private 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
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2
Dim i%, t%, wallpaper$, rtn&

Private Sub Form_Load()
 Me.AutoRedraw = True
 Me.Width = Screen.Width: Me.Height = Screen.Height
 Me.Move 0, 0
 With Picture1
 .BorderStyle = 0
 .AutoSize = True
 .Picture = LoadPicture("c:\fball.gif")
 .Move Screen.Width, 0
 End With
End Sub

Private Sub Form_Activate()
 PictureTile Me, Picture1
 rtn = MsgBox("您确定要将本张图片设为桌面吗 ?", vbYesNo, "桌面背景")
 If rtn = 6 Then
 wallpaper = "c:\ttt.bmp"
 '************************* 存为 .bmp
 SavePicture Me.Image, wallpaper
 '************************* 设为桌面
 SystemParametersInfo SPI_SETDESKWALLPAPER, 0, wallpaper, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
 End If
End Sub

Sub PictureTile(Frm As Form, Pic As PictureBox)
 For t = 0 To Frm.Height Step Picture1.ScaleHeight
 For i = 0 To Me.Width Step Picture1.ScaleWidth
 Me.PaintPicture Picture1.Picture, i, t
 Next i
 Next t
End Sub