Access911.net   |   a9BBS   |   OTaA System  
  搜索文章:  
Access911欢迎您光临  
   主页      上传      繁體版       论坛     
设为首页  |  加入收藏   
  
你现在的位置:文章索引 -> 文章分类 -> API  
 首页|  近日更新|  下载  |  文章索引  |  搜索|  术语|  承接工程|  
 
系统正在加载内容,请耐心等待...
 
 查询
 窗体
 报表
 
 
 VBA
 函数
 ADO/DAO/ADO.NET
 API
 ADP
 安全
 发布
 OA
 ASP/ASP.NET
 其他语言
 控件
 DELPHI
 C#/.Net
 本站
 其他
 小例程
 常用软件
 参考文档
 业主作品
 网友大作
 
 
友情链接
 access911.net
 
访问人次
 1701909
 
站长 E-Mail
 net911@sina.com
 access911@gmail.com
 
RSS 订阅

显示附加信息 >>>

如何获取以及设置ACCESS主窗体的大小及位置?

作者:cg1  摘自:access911.net  :cg1  更新日期:2008-1-30  浏览人次:

 

问题:

如何获取以及设置ACCESS主窗体的大小及位置?

 

回答:

'//按 ALT+F11 转到 vba 界面,
'//新建一个模块
'//将以下代码 COPY 进去
'//将光标停在 Function RunTest() 这行
'//按 F5 即可运行
'//运行结束后转到 ACCESS 使用界面,即可看到效果


'-----------------------------------------------
'自定义数据类型,GetAccessWindow的返回值

Public Type AWPix
    Left As Long
    Top As Long
    Width As Long
    Height As Long
End Type

'-----------------------------------------------
'获取、设置 Window状态的API

Public 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
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
    ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Type RECT '屏幕坐标中随同窗口装载的矩形
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'-----------------------------------------------
'获取分辩率设置的 API

Public Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
Public Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const DIRECTION_VERTICAL = 1
Public Const DIRECTION_HORIZONTAL = 0


'-----------------------------------------------
'获取窗体缩放状态的 API
'缩放状态

Public Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
'是否最小化
Public Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
'是否可见
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long


'---------------------------------------------
'设置窗体状态的 API

Public Const SW_HIDE = 0            '隐藏
Public Const SW_SHOWNORMAL = 1      '普通(还原)
Public Const SW_SHOWMINIMIZED = 2   '最小化
Public Const SW_SHOWMAXIMIZED = 3   '最大化

Public Declare Function apiShowWindow Lib "user32" _
    Alias "ShowWindow" (ByVal hwnd As Long, _
    ByVal nCmdShow As Long) As Long
'----------------------------------------------

'像素转换成缇,本站以前文章中已经介绍过了。
'    关于单位“缇”与“像素”的转换,以及缇与其他单位(例如:厘米)之间的转换《窗体》
'    http://access911.net/index.asp?u1=a&u2=72FAB41E13DCE9F3

Function PixelsToTwips(rlngPixels As Long, rlngDirection As Long) As Long
On Error GoTo PixelsToTwips_Err
    
    Dim lngDeviceHandle As Long
    Dim lngPixelsPerInch As Long
    lngDeviceHandle = apiGetDC(0)
    If rlngDirection = DIRECTION_HORIZONTAL Then  '水平X方向
        lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
    Else       '垂直Y方向
        lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
    End If
    lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
    PixelsToTwips = rlngPixels * 1440 / lngPixelsPerInch
    
PixelsToTwips_Exit:
    On Error Resume Next
    Exit Function
    
PixelsToTwips_Err:
    MsgBox Err.Description, vbExclamation, "access911.net"
    Resume PixelsToTwips_Exit
    
End Function

'===========================================================
' 过程及函数名:  RunTest
' 版本号      :  --
' 说明        :  本过程只用于演示如何用VBA+WINAPI 控制
'                 Access 主窗体的位置和大小
' 引用        :  --
' 输入参数    :  --
' 输出值      :  --
' 返回值      :  --
' 调用演示    :  RunTest
' 最后修改日期:  2008-1-30 16:36:00
' 示例地址    :  http://access911.net/?kbid;72FABE1E1ADCE8F3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Function RunTest()
    '显示当前Access主窗体的高度
    Debug.Print GetAccessWindow.Height
    '设置当前Access窗体:
    '宽 553像素,高400像素,距离上边20像素,左边12像素

    SetAccessWindow 12, 20, 553, 400
End Function


'===========================================================
' 过程及函数名:  GetAccessWindow
' 版本号      :  --
' 说明        :  获取 ACCESS 主窗体的大小及位置,获取单位是
'                 像素,如果要转为ACCESS的度量衡单位“Twip缇”
'                 可以用函数 PixelsToTwips 转换。
'                 注意,本函数还定义了一个 Type AWPix
' 引用        :  --
' 输入参数    :  --
' 输出值      :  --
' 返回值      :  返回自定义类型 AWPix 数据。
' 调用演示    :  Debug.Print GetAccessWindow.Height
' 最后修改日期:  2008-1-30 16:36:00
' 示例地址    :  http://access911.net/?kbid;72FABE1E1ADCE8F3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Function GetAccessWindow() As AWPix
    Dim intWidth As Long, intHeight As Long
    Dim tAWPix As AWPix
    Dim lngRet As Long
    Dim Rc As RECT
    Dim lngHwndMDI As Long
    '获取ACCESS主窗体内嵌子对象的句柄
    lngHwndMDI = FindWindowEx(Application.hWndAccessApp, _
        0&, "MDIClient", "")
    '上边距中不包含工具栏和菜单栏。尝试去掉工具栏看一下结果,然后再加上工具栏再看看结果
    'lngRet = GetWindowRect(lngHwndMDI, Rc)
    
    '获取整个ACCESS窗体最外侧的尺寸,在Win2003+acc2003的情况下最大化时每边都需要+4

    lngRet = GetWindowRect(Application.hWndAccessApp, Rc)
    
    
    
    With tAWPix
        .Top = Rc.Top
        .Left = Rc.Left
        .Height = Rc.Bottom - Rc.Top
        .Width = Rc.Right - Rc.Left
    End With
    
    GetAccessWindow = tAWPix
End Function


'===========================================================
' 过程及函数名:  SetAccessWindow
' 版本号      :  --
' 说明        :  设置 ACCESS 主窗体的大小及位置,设置单位是像素
' 引用        :  --
' 输入参数    :  --
' 输出值      :  --
' 返回值      :  --
' 调用演示    :  SetAccessWindow 0,0,150,566
' 最后修改日期:  2008-1-30 16:36:00
' 示例地址    :  http://access911.net/?kbid;72FABE1E1ADCE8F3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Function SetAccessWindow(ByVal XLeft As Long, _
    ByVal YTop As Long, _
    ByVal XWidth As Long, _
    ByVal YHeight As Long)
    
    Dim lngHwndMDI As Long
    Dim lngRet As Long
    Dim Rc As RECT
    If IsZoomed(Application.hWndAccessApp) = 1 Or _
        IsIconic(Application.hWndAccessApp) = 1 Then
        apiShowWindow Application.hWndAccessApp, SW_SHOWNORMAL
    End If
    MoveWindow Application.hWndAccessApp, XLeft, YTop, XWidth, YHeight, True
End Function


Windows 2003 + Access 2003 测试通过
下载示例:
http://access911.net/down/eg/eg_accessmainwindow.rar
(42KB)

 

本站文章旨在为该问题提供解决思路及关键性代码,并不能完成应该由网友自己完成的所有工作,请网友在仔细看文章并理解思路的基础上举一反三、灵活运用。

access911.net 原创文章,作者本人对文章保留一切权利。
如需转载必须征得作者同意并注明本站链接

 

 
相关文章
     没有手动相关文章
 
评论
     查看或发表更多的评论,请单击这里。
 
 
 
 
 
   
  Access911.net   |   a9BBS   |   OTaA System   |
建站日期:2000年4月2日  |  设计施工:陈格 ( access911 & cg1 )
 Copyright © 2000 - 2003 COMET, 陈格 保留所有权利