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

显示附加信息 >>>

如何让日期控件不占据窗体上的空间?

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

 

问题:

如何让日期控件不占据窗体上的空间?
如何获取某个控件在窗体上的绝对像素或者缇位置?

 

回答:

思路,直接新建一个frmCalendarSelect窗体,添加一个日期控件,然后设置窗体弹出为是。其他窗体需要选择日期时只要打开frmCalendarSelect窗体,并将该窗体停靠在控件下方即可。

停靠在哪里,也就是某个控件在屏幕上的绝对位置只需要用 API ClientToScreen 就可以找到。

'//按 ALT+F11 转到 vba 界面,
'//新建一个模块
'//将以下代码 COPY 进去

'ClientToScreen 需要使用
Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Enum TwipsTransfer
    DIRECTION_VERTICAL = 1
    DIRECTION_HORIZONTAL = 0
End Enum

'apiGetDeviceCaps 的参数
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90

'SetWindowPos wFlags 参数使用的常数
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOMOVE = &H2
Public Const SWP_DRAWFRAME = &H20


'相对位置转换为屏幕绝对位置
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

'移动窗体,或者更改窗体在屏幕上的Z轴顺序
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
    ByVal hWndinsertAfter As Long, ByVal x As Long, ByVal y As Long, _
    ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


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
'获取分辩率设置的 API
Public Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
    

'像素转换成缇,本站以前文章中已经介绍过了。
'    关于单位“缇”与“像素”的转换,以及缇与其他单位(例如:厘米)之间的转换《窗体》
'    http://access911.net/index.asp?u1=a&u2=72FAB41E13DCE9F3
Public Function PixelsToTwips(ByVal pixels As Long, ByVal direction As TwipsTransfer) As Long
On Error GoTo PixelsToTwips_Err
    
    Dim lngDeviceHandle As Long
    Dim lngPixelsPerInch As Long
    lngDeviceHandle = apiGetDC(0)
    If direction = DIRECTION_HORIZONTAL Then  '水平X方向
        lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
    Else       '垂直Y方向
        lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
    End If
    lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
    PixelsToTwips = pixels * 1440 / lngPixelsPerInch
    
PixelsToTwips_Exit:
    On Error Resume Next
    Exit Function
    
PixelsToTwips_Err:
    MsgBox Err.Description, vbExclamation, "access911.net"
    Resume PixelsToTwips_Exit
    
End Function


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

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


'===========================================================
' 过程及函数名:  PopupCalendarForm
' 版本号      :  --
' 说明        :  在单个窗体视图下,根据传入的 TextBox 对象的
'                 位置打开预制的frmCalendarSelect 窗体,以简
'                 化选择日期的操作且日期控件不占用当前窗体的空间。
'                 必须预先创建并设置好 frmCalendarSelect 窗体,
'                 具体代码请看本示例中的《frmCalendarSelect》
' 引用        :  --
' 输入参数    :  textBox ,文本框对象,按地址传递。当选择某个日期后
'                 该日期将被赋值给 textBox 控件。frmCalendarSelect 窗体
'                 也将停靠在 textBox 的下放。
' 输出值      :  --
' 返回值      :  --
' 调用演示    :  PopupCalendarForm Me.Text0
' 最后修改日期:  2008-2-2 23:36:00
' 示例地址    :  http://access911.net/?kbid;72FABE1E1ADCE9F3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================
Public Function PopupCalendarForm(ByRef textBox As Control)
    Dim p As POINTAPI
    
    Dim frm As Form
    Set frm = textBox.Parent
    If isExistsSection(frm, acHeader) = True Then  '需要考虑页眉的影响
        p.y = TwipsToPixels(textBox.Top + textBox.Height + frm.Section(acHeader).Height, DIRECTION_VERTICAL)
    Else
        p.y = TwipsToPixels(textBox.Top + textBox.Height, DIRECTION_VERTICAL)
    End If
    
    If frm.RecordSelectors = True Then
        p.x = TwipsToPixels(textBox.Left, DIRECTION_HORIZONTAL) + 15    '需要考虑记录选择器的影响
    Else
        p.x = TwipsToPixels(textBox.Left, DIRECTION_HORIZONTAL) - 8
    End If
    
      
    ClientToScreen textBox.Parent.hwnd, p
    

    DoCmd.OpenForm "frmCalendarSelect"
    DoCmd.MoveSize PixelsToTwips(p.x, DIRECTION_HORIZONTAL), PixelsToTwips(p.y, DIRECTION_VERTICAL)
    'API SetWindowPos 也可以达到此效果
    'SetWindowPos Forms("frmCalendarSelect").hwnd, 0, p.x + 14, p.y, 0, 0, SWP_NOSIZE
    
    '告知日期选择窗体数据应该回送给哪个控件
    Set Forms("frmCalendarSelect").ctl = textBox
End Function


'用错误陷阱判断某个节是否存在
Public Function isExistsSection(ByVal frm As Form, _
    ByVal whichSection As AcSection) As Boolean
On Error GoTo isExistsSection_Err

    Dim s As Section
    Set s = frm.Section(whichSection)
    isExistsSection = True


    Exit Function
    
isExistsSection_Err:
    Select Case Err.Number
    Case 2462   '不存在
        isExistsSection = False
    Case Else
        isExistsSection = False
        Debug.Print Err.Number, Err.Description
    End Select
End Function


示例下载:
http://access911.net/down/eg/eg_controlLocation.rar
(35KB)
Windows2003 + Access2003 上测试通过

要使窗体变为透明可以参考这里的例子
http://www.accdb.net/article.asp?id=867

 

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

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

 

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