设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2233|回复: 0
打印 上一主题 下一主题

[模块/函数] 图片“拉伸”问题?

[复制链接]
跳转到指定楼层
1#
发表于 2013-3-13 09:25:27 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
使用这个图片模块时对图片大小要求,使用小图片时显示多个图。如何改为拉伸模式?

Option Compare Database

Private 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


分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-13 14:52 , Processed in 0.099615 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表