Office中国论坛/Access中国论坛

标题: 纯Access的日期控件 [打印本页]

作者: chenzhirong2008 时间: 2009-1-18 13:24
标题: 纯Access的日期控件
[attach]34608[/attach]好久没上来, 居然连ID都忘了, 注册了新ID,顺便放点东西, 如果觉得有用就最好了.

作者: boy1 时间: 2009-1-18 16:10
标题: 坐个沙发
坐个沙发

作者: andymark 时间: 2009-1-18 19:11
谢谢分享~~

作者: WDLRCZT 时间: 2009-1-18 19:42
支持一下

作者: Henry D. Sy 时间: 2009-1-18 21:00
谢谢分享

作者: tmtony 时间: 2009-1-18 21:07
支持一下

作者: changweiren 时间: 2009-1-18 22:20
Very Good! Thanks!

作者: beenet 时间: 2009-1-18 22:42
let me see see

作者: towerman 时间: 2009-1-19 08:39
学习一下[:24]

作者: wang_93 时间: 2009-1-22 10:25
谢谢分享，楼主辛苦了

作者: jingyu 时间: 2009-1-23 16:26
谢谢分享

作者: todaynew 时间: 2009-1-23 18:44

原帖由 chenzhirong2008 于 2009-1-18 13:24 发表
34608好久没上来, 居然连ID都忘了, 注册了新ID,顺便放点东西, 如果觉得有用就最好了.

好东西！[:28]

作者: kele030 时间: 2009-1-23 20:47
谢谢分享~~

作者: koutx 时间: 2009-1-23 21:02
Acess中的日期控件可不如VB.net中的好用，下载学学这个

作者: 123shusheng 时间: 2009-1-31 17:17
12335

作者: ty_1029 时间: 2009-1-31 17:22
收藏了~~` 把你所有的论坛ID都注册成一个不就可以了~~

我就是这样的,呵呵

作者: 小小鸟 时间: 2009-2-2 12:02
看看效果如何。

作者: Grant 时间: 2009-2-2 12:47
学习了,谢谢

作者: 4848 时间: 2009-2-5 09:57
学习学习

作者: lgcsee 时间: 2009-2-5 10:49
要好好学习一下！

作者: 7777777 时间: 2009-2-18 14:57
谢谢分享~~

作者: 小小鸟 时间: 2009-2-27 12:01
谢谢分享，学习中...

作者: chaojianan 时间: 2009-2-27 14:43
支持，谢谢分享。

作者: qdkj2002 时间: 2009-2-28 01:30
谢谢分享

作者: 没牙兔兔 时间: 2009-2-28 19:58
感谢
下载看看

作者: 没牙兔兔 时间: 2009-2-28 20:01
试用了
挺不错的，谢谢楼主分享

作者: wjsfeng 时间: 2009-2-28 21:28
真的很不错

作者: DDBB2 时间: 2009-3-1 14:55
3KS

作者: DDBB2 时间: 2009-3-1 14:56

作者: DDBB2 时间: 2009-3-1 14:57

作者: DDBB2 时间: 2009-3-1 14:58

作者: DDBB2 时间: 2009-3-1 14:59

:victory:

作者: arksore 时间: 2009-4-23 17:08
太棒了，不顶不行了

作者: 86869986 时间: 2009-4-28 14:31
支持一下啊

作者: lkkl66 时间: 2009-4-28 16:18
1# chenzhirong2008
顶一下，嗅一嗅，谢谢分享！

作者: 13555609005 时间: 2009-4-29 22:51
谢谢分享

作者: 快乐王 时间: 2009-4-30 00:29
就喜欢这样不用回复也能看到附件的方式。

作者: xhbqt 时间: 2009-4-30 02:16
谢谢，分享

作者: lurong 时间: 2009-5-5 23:33
谢谢实例

作者: xhbqt 时间: 2009-5-7 00:47
已用，很好，谢谢

作者: xryacc2 时间: 2009-5-21 22:01
支持一下，辛苦了

作者: apsfxc1 时间: 2009-5-22 08:13
看看学习

作者: zhao__feng 时间: 2009-7-19 19:15
谢谢分享~~

作者: liuqi67 时间: 2009-7-21 12:42
xuexi!

作者: wzh 时间: 2009-7-23 10:37
谢谢分享

作者: ndbs 时间: 2009-7-23 23:07
好东西，谢谢了

作者: qhp-soft 时间: 2009-7-24 00:29
支持一下

作者: jndsjhm 时间: 2009-7-27 23:28
谢谢分享

作者: shoupi99 时间: 2009-7-28 08:59
很有价值哦，谢谢分享啦！

作者: 鱼儿游游 时间: 2009-10-17 19:03

作者: zxklzxm1983 时间: 2009-10-17 21:37

谢谢

作者: zxklzxm1983 时间: 2009-10-17 21:41

刚看勒一下，真漂亮谢谢

作者: qdkj2002 时间: 2009-10-20 16:29
谢谢分享

作者: passcet123 时间: 2009-10-23 09:44
学习了。。谢谢楼主。。

作者: sxgaobo 时间: 2009-10-23 10:38
谢谢楼主了！！！
如果月份能是中文的（一月、二月、......）就更好了啊！

作者: caijianhua1978 时间: 2009-10-23 22:40
支持一下，顶一下

作者: c101 时间: 2009-10-23 23:10
谢谢分享

作者: sagemeyou 时间: 2009-11-8 11:32
谢谢分享

作者: ADAM 时间: 2009-11-28 21:29
不足之处:日期窗未跟随点击按钮定位

作者: chenzhirong2008 时间: 2009-11-28 22:03
附随点击按钮定位的代码, 但个人觉得为这个功能带这么多代码不值得.
Public Function PositionFormRelativeToControl(frmName As String, ctl As Access.Control, Optional Position As Long = 0) As Boolean
Position:
' 0 = Underneath
' 1 = On Top
' 2 = Right side
' 3 = Left side
' 4 = Bottom Right Hand Corner

Dim m_hWndSection As Long

Dim frm As Access.Form

Dim hWndMDI As Long
Dim MDIborderX As Long
Dim MDIborderY As Long

Dim rc As RECT
Dim rcWin As RECT
Dim pt As POINTAPI
Dim lOffsetX As Long, lOffsetY As Long

Dim m_ScreenWidth As Long
Dim m_ScreenHeight As Long

Dim lStyle As Long

On Error Resume Next

DoCmd.OpenForm frmName
Set frm = Forms.Item(frmName)

If Not frm Is Nothing Then

m_hWndSection = fFindSectionhWnd(ctl)

GetScreenDPI
m_ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
m_ScreenHeight = GetSystemMetrics(SM_CYSCREEN)

Select Case Position

      Case 0
      lOffsetX = ctl.Left / (TWIPSPERINCH / m_ScreenXdpi)
      lOffsetY = (ctl.Top + ctl.Height) / (TWIPSPERINCH / m_ScreenYdpi)

      Case 1
      lOffsetX = ctl.Left / (TWIPSPERINCH / m_ScreenXdpi)
      lOffsetY = (-frm.WindowHeight + ctl.Top) / (TWIPSPERINCH / m_ScreenYdpi)

      Case 2
      lOffsetX = (ctl.Left + ctl.Width) / (TWIPSPERINCH / m_ScreenXdpi)
      lOffsetY = (ctl.Top) / (TWIPSPERINCH / m_ScreenYdpi)

      Case 3
      lOffsetX = (ctl.Left - frm.WindowWidth) / (TWIPSPERINCH / m_ScreenXdpi)
      lOffsetY = (ctl.Top) / (TWIPSPERINCH / m_ScreenYdpi)

      Case 4
      lOffsetX = (ctl.Left + ctl.Width) / (TWIPSPERINCH / m_ScreenXdpi)
      lOffsetY = (ctl.Top + ctl.Height) / (TWIPSPERINCH / m_ScreenYdpi)

      Case Else
      lOffsetX = ctl.Left / (TWIPSPERINCH / m_ScreenXdpi)
      lOffsetY = (ctl.Top + ctl.Height) / (TWIPSPERINCH / m_ScreenYdpi)

End Select

lRet = GetWindowRect(m_hWndSection, rc)

pt.X = lOffsetX + rc.Left&
pt.Y = lOffsetY + rc.Top

lRet = GetWindowRect(frm.hwnd, rcWin)

With rcWin
      If m_ScreenWidth - pt.X < .Right - .Left Then
            pt.X = m_ScreenWidth - (.Right - .Left)
      ElseIf pt.X < 2 Then 'm_S
            pt.X = 2
      End If

      If m_ScreenHeight - pt.Y < .Bottom - .Top Then
         pt.Y = m_ScreenHeight - (.Bottom - .Top)
      ElseIf pt.Y < 2 Then
         pt.Y = 2
      End If

End With

If Not frm.PopUp = True Then

      hWndMDI = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", TITLE)
      lRet = ScreenToClient(hWndMDI, pt)

      lRet = GetWindowRect(hWndMDI, rcWin)
      lRet = GetClientRect(hWndMDI, rc)
      MDIborderX = ((rcWin.Right - rcWin.Left) - (rc.Right - rc.Left))
      MDIborderY = ((rcWin.Bottom - rcWin.Top) - (rc.Bottom - rc.Top))

      lStyle = GetWindowLong(hWndMDI, GWL_STYLE)

      If lStyle And WS_HSCROLL Then
         MDIborderY = MDIborderY - GetSystemMetrics(SM_CYHSCROLL)
      End If

      If lStyle And WS_VSCROLL Then
         MDIborderX = MDIborderX - GetSystemMetrics(SM_CXVSCROLL)
      End If
      MDIborderX = MDIborderX / 2
      MDIborderY = MDIborderY / 2
Else

      MDIborderX = GetSystemMetrics(SM_CXBORDER)
      MDIborderY = GetSystemMetrics(SM_CYBORDER)
End If

Call SetWindowPos(frm.hwnd, 0&, pt.X - MDIborderX, pt.Y - MDIborderY, 0, 0, SWP_NOSIZE)

End If

Set frm = Nothing

PositionFormRelativeToControl = True

End Function

Private Sub GetScreenDPI()
Dim lngDC As Long

lngDC = GetDC(0)
m_ScreenXdpi = apiGetDeviceCaps(lngDC, LOGPIXELSX)
m_ScreenYdpi = apiGetDeviceCaps(lngDC, LOGPIXELSY)

lngDC = ReleaseDC(0, lngDC)
End Sub

Private Function fFindSectionhWnd(ctl As Access.Control) As Long
On Error GoTo Err_fFindSectionhWnd
Dim hWnd_LSB As Long
Dim hWnd_Temp As Long

Dim rc As RECT
Dim pt As POINTAPI

Dim SectionCounter As Long
Dim ctr As Long

   Select Case ctl.Section
      Case acDetail '0
         SectionCounter = 2
      Case acHeader '1
         SectionCounter = 1
      Case acFooter '2
         SectionCounter = 3
      Case Else
   End Select
ctr = 1
If TypeOf ctl.Parent Is Access.Page Then
      If TypeOf ctl.Parent.Parent Is Access.TabControl Then
         If TypeOf ctl.Parent.Parent.Parent Is Access.Form Then
            hWnd_LSB = apiGetWindow(ctl.Parent.Parent.Parent.hwnd, GW_CHILD)
         End If
      End If
Else

      hWnd_LSB = apiGetWindow(ctl.Parent.hwnd, GW_CHILD)
End If
Do
      If fGetClassName(hWnd_LSB) = "OFormSub" Then
         If ctr = SectionCounter Then
            fFindSectionhWnd = hWnd_LSB
            Exit Function
         End If
         ctr = ctr + 1
      End If
      hWnd_LSB = apiGetWindow(hWnd_LSB, GW_HWNDNEXT)
Loop While hWnd_LSB <> 0
fFindSectionhWnd = 0

Exit_fFindSectionhWnd:
Exit Function

Err_fFindSectionhWnd:
MsgBox Err.Description
Resume Exit_fFindSectionhWnd

End Function

Private Function fGetClassName(hwnd As Long)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
strBuffer = Space$(MAX_LEN)
lngLen = apiGetClassName(hwnd, strBuffer, MAX_LEN)
If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function

作者: chenzhirong2008 时间: 2009-11-28 22:04
还有API 声明
Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function ScreenToClient Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function apiGetWindowLong Lib "user32" _
  Alias "GetWindowLongA" _
  (ByVal hwnd As Long, _
  ByVal nIndex As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function apiGetDeviceCaps Lib "gdi32" _
Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Declare Function apiGetWindow Lib "user32" _
Alias "GetWindow" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) _
As Long

Private Declare Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount 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 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

' Window Styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000                '  WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000

Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000

Private Const WS_TILED = WS_OVERLAPPED
Private Const WS_ICONIC = WS_MINIMIZE
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW

Private Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Private Const WS_CHILDWINDOW = (WS_CHILD)

Private Const WS_EX_DLGMODALFRAME = &H1&
Private Const WS_EX_NOPARENTNOTIFY = &H4&
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_ACCEPTFILES = &H10&
Private Const WS_EX_TRANSPARENT = &H20&

Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
Private Const GW_MAX = 5

Private Const GWL_HINSTANCE = (-6)
Private Const GWL_STYLE = (-16)

Private Const TWIPSPERINCH = 1440&

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const BITSPIXEL = 12

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOOWNERZORDER = &H200

Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER

Private Const HWND_TOP = 0
Private Const HWND_BOTTOM = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const TITLE = ""

Private m_ScreenXdpi As Long
Private m_ScreenYdpi As Long

Private lRet As Long

作者: 易碎的玫瑰香水 时间: 2009-12-16 12:53
学习一下

作者: luke99 时间: 2009-12-22 16:29
是好东西

作者: c101 时间: 2009-12-22 18:11
谢谢分享

作者: 82077802 时间: 2009-12-22 18:14
let me see see

作者: wufeng980114 时间: 2009-12-24 20:47
支持并学习着

作者: bang820404 时间: 2009-12-26 00:38
高高

作者: heqing3000 时间: 2009-12-26 05:39
支持了

作者: wufeng980114 时间: 2010-1-8 22:15
谢谢支持

作者: lzbboy 时间: 2010-1-17 21:49
的风格上的风格

作者: 沙漠186 时间: 2010-1-21 11:01
的风格上的风格

作者: liangzhenye 时间: 2010-1-27 22:56
学习学习

作者: 文棣 时间: 2010-2-2 10:18
学习学习

作者: zqjie 时间: 2010-2-2 17:42
看看，楼主辛苦了

作者: xsm361 时间: 2010-3-20 10:35
谢谢分享，十分有用, 楼主辛苦了

作者: 风啸啸 时间: 2010-3-20 13:24
支持一个。

作者: mrd_wxqs 时间: 2010-4-18 19:31
谢谢分享，下了收藏。

作者: andluo 时间: 2010-6-13 00:30
学习了

作者: andluo 时间: 2010-6-13 00:36
辛苦！

作者: sxgaobo 时间: 2010-6-19 16:03
使用中，非常好！不好意思，提个小问题，
[attach]42483[/attach]
这样选择应该是2010-5-30，可结果是2010-6-30，楼主能否修改下啊！！！谢谢了

作者: sxgaobo 时间: 2010-6-22 21:33
希望楼主能看看啊！

作者: lovehere 时间: 2010-6-23 09:19
学习一下

作者: michael100 时间: 2010-6-23 12:02
谢谢分享

作者: cc.man 时间: 2010-6-28 14:20
正在找，多谢

作者: ZHENGLIAN 时间: 2010-8-22 17:56
谢谢分享，楼主辛苦了

作者: 熊霸天下 时间: 2010-8-23 07:05
楼主辛苦！

作者: xjb_test 时间: 2010-8-24 16:58
谢谢分享

作者: yyinfo 时间: 2010-8-25 20:29
谢谢了新人就是要多多学习

作者: ilikeu 时间: 2010-9-14 19:12
最好能做成中文版的，那才更加实用！

作者: huid_5029 时间: 2010-9-22 00:31
学习下。。。

作者: li08hua 时间: 2010-10-18 02:53
支持！

作者: wu8313 时间: 2017-6-19 15:09
本帖最后由 wu8313 于 2017-6-21 11:08 编辑

ilikeu 发表于 2010-9-14 19:12
最好能做成中文版的，那才更加实用！

我把控件画得更大了一点，换了中文标签，看起来更清爽了。

作者: wu8313 时间: 2017-6-19 15:15

sxgaobo 发表于 2010-6-19 16:03
使用中，非常好！不好意思，提个小问题，

这样选择应该是2010-5-30，可结果是2010-6-30，楼主能否修改下 ...

确实有这个情况。好在文本框不是有显示给你看嘛，也没多大关系。

作者: lovesgh 时间: 2017-12-6 22:07
谢谢收藏

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)