Office中国论坛/Access中国论坛

标题: 用API 设置窗口背景图为拉伸的代码? [打印本页]

作者: xie62    时间: 2013-1-12 17:07
标题: 用API 设置窗口背景图为拉伸的代码?
[attach]51095[/attach]
作者: mclly2000    时间: 2013-1-12 17:33
谢谢分享,我的系统环境是win7+office2010点击该实例没有任何反应
作者: access新闻爱好者    时间: 2013-1-12 17:39
谢谢分享,呵呵。发现论坛的链接错了。
作者: xie62    时间: 2013-1-13 08:08
调用的图片不能平铺
代码:
Private Sub CmdPic_Click()   
    SetBackGround CurrentProject.Path & "\login0.jpg"
  模块  
End SubPrivate Const GCL_HBRBACKGROUND = -10
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Any, ByVal bErase As Long) As Long

Public Sub SetBackGround(wpv_Arg As Variant)

Dim wlo_Image As Object
Dim wlv_Brush As Long
Dim wlv_Hwnd As Long

If Not IsNumeric(wpv_Arg) Then

    Set wlo_Image = LoadPicture(wpv_Arg)
   
    wlv_Brush = CreatePatternBrush(wlo_Image.Handle)
   
    Set wlo_Image = Nothing

Else
   
    wlv_Brush = CreateSolidBrush(wpv_Arg)
End If
   
    wlv_Hwnd = FindWindowEx(Application.hWndAccessApp, 0, "MDIClient", vbNullString)
    SetClassLong wlv_Hwnd, GCL_HBRBACKGROUND, wlv_Brush
    InvalidateRect wlv_Hwnd, vbNullString, 1
End Sub





欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3