Development | .NET Compact Framework

Free DateTimePicker for Compact Framework
Written by Carole Mitchell  [author's bio]  [read 66551 times]
Edited by Derek

         

Page 1  Page 2  Page 3 

The modified code for the datetime picker module is:

Imports System.Text
Imports System.Runtime.InteropServices
Module DT_Picker

#Region "API Declares"
Public Declare Function DestroyWindow Lib "Coredll" Alias "DestroyWindow" _
(ByVal hwnd As IntPtr) As Integer
Private Declare Function GetWindowText Lib "Coredll" Alias "GetWindowTextW" _
(ByVal hwnd As IntPtr, _
ByVal lpString As Char(), _
ByVal cch As Integer) As Integer
Private Declare Function GetWindow Lib "Coredll" Alias "GetWindow" _
(ByVal hwnd As IntPtr, ByVal wCmd As Integer) As IntPtr
Private Declare Function FindWindow Lib "Coredll" Alias "FindWindowW" _
(ByVal lpClassName As Char(), _
ByVal lpWindowName As Char()) As IntPtr
Private Declare Function SetWindowPos Lib "Coredll" _
(ByVal hwnd As IntPtr, _
ByVal hWndInsertAfter As Integer, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal cx As Integer, _
ByVal cy As Integer, _
ByVal wFlags As Integer) As Integer
Declare Function SendMessageSTR Lib "Coredll" Alias "SendMessageW" _
(ByVal hwnd As IntPtr, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Char()) As Integer
Declare Function SendMessageLNG Lib "Coredll" Alias "SendMessageW" _
(ByVal hwnd As IntPtr, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer
Declare Function SendMessageSystemTime Lib "Coredll" Alias "SendMessageW" _
(ByVal hwnd As IntPtr, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
ByVal lParam As SystemTime) As Integer
Declare Function CreateWindowEx Lib "Coredll" _
Alias "CreateWindowExW" ( _
ByVal dwExStyle As Integer, _
ByVal lpClassName As Char(), _
ByVal lpWindowName As Char(), _
ByVal dwStyle As Integer, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hWndParent As IntPtr, _
ByVal hMenu As Integer, _
ByVal hInstance As Integer, _
ByVal lpParam As Char()) As IntPtr

Declare Function InitCommonControlsEx Lib "Commctrl" _
(ByRef init As InitCommonControlsExType) As Boolean
#End Region

#Region "Global Var & Const"
Public Structure InitCommonControlsExType
Public dwSize As Integer 'size of this structure
Public dwICC As Integer 'flags indicating which classes to be initialized
End Structure
'-- Variable to pass the Window Handler
Private DTPicker_hWnd As Integer
'-- Constants
Private Const DATETIMEPICK_CLASS = "SysDateTimePick32"
Private Const ICC_DATE_CLASSES = &H100
'-- Month Calendar color atributes
'-- background color (between months)
Private Const MCSC_BACKGROUND = 0
'-- dates within a month
Private Const MCSC_TEXT = 1
'-- background of the title
Private Const MCSC_TITLEBK = 2
'-- text within the calendar's title
Private Const MCSC_TITLETEXT = 3
'-- background of a month
Private Const MCSC_MONTHBK = 4
'-- the text color of header & trailing days
Private Const MCSC_TRAILINGTEXT = 5
'-- Date/Time Picker properties
' use UPDOWN instead of MONTHCAL
Private Const DTS_UPDOWN = &H1
' allow a NONE selection
Private Const DTS_SHOWNONE = &H2
' use the short date format (app must forward WM_WININICHANGE messages)
Private Const DTS_SHORTDATEFORMAT = &H0
' use the long date format (app must forward WM_WININICHANGE messages)
Private Const DTS_LONGDATEFORMAT = &H4
' use the time format (app must forward WM_WININICHANGE messages)
Private Const DTS_TIMEFORMAT = &H9
' allow user entered strings (app MUST respond to DTN_USERSTRING)
Private Const DTS_APPCANPARSE = &H10
' right-align popup instead of left-align it
Private Const DTS_RIGHTALIGN = &H20
'-- Date/Time Picker Messages
Private Const DTM_GETSYSTEMTIME = &H1001
Private Const DTM_SETSYSTEMTIME = &H1002
Private Const DTM_GETRANGE = &H1003
Private Const DTM_SETRANGE = &H1004
Private Const DTM_SETFORMATA = &H1005
Private Const DTM_SETFORMATW = &H1032
Private Const DTM_SETMCCOLOR = &H1006
Private Const DTM_GETMCCOLOR = &H1007
Private Const DTM_GETMONTHCAL = &H1008
Private Const DTM_SETMCFONT = &H1009
Private Const DTM_GETMCFONT = &H100A
'-- Month Calendar Messages
Private Const MCM_GETCURSEL = &H1001
Private Const MCM_SETCURSEL = &H1002
Private Const MCM_GETMAXSELCOUNT = &H1003
Private Const MCM_SETMAXSELCOUNT = &H1004
Private Const MCM_GETSELRANGE = &H1005
Private Const MCM_SETSELRANGE = &H1006
Private Const MCM_GETMONTHRANGE = &H1007
Private Const MCM_SETDAYSTATE = &H1008
Private Const MCM_GETMINREQRECT = &H1009
Private Const MCM_SETCOLOR = &H100A
Private Const MCM_GETCOLOR = &H100B
Private Const MCM_SETTODAY = &H100C
Private Const MCM_GETTODAY = &H100D
Private Const MCM_HITTEST = &H100E
' SetWindowPos() hwndInsertAfter values
Private Const WS_POPUP = &H80000000
Private Const WS_BORDER = &H800000
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
' SetWindowPos Flags
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
' The frame changed: send WM_NCCALCSIZE
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
' Don't do owner Z ordering
Private Const SWP_NOOWNERZORDER = &H200
'Relationship's parameters for GetWindow function
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 pnlDateTimePickerText As String

#End Region

#Region "Custom Methods"

Public Function SetDTP_Format(ByVal DTPr_hWnd As IntPtr, _
ByVal strFormat As String) As Boolean
'strFormat like: "dd'.'MM'.'yy HH':'mm" or "dd'.'MM'.'yy "
Try
SendMessageSTR(DTPr_hWnd, DTM_SETFORMATW, 0, strFormat)
Return True
Catch ex As Exception
Return False
End Try
End Function
Private Function getAPI_Error() As String
Try
Return "Last WinAPI error No. was: " & Marshal.GetLastWin32Error
Catch ex As Exception
End Try
End Function
Public Function getDTP_Time(ByVal DTP_hWnd As IntPtr) As String
Dim syt As SystemTime = New SystemTime
Try
SendMessageSystemTime(DTP_hWnd, DTM_GETSYSTEMTIME, 0, syt)
If syt Is Nothing Then
MsgBox(getAPI_Error, MsgBoxStyle.Critical, "WinAPI Error")
Return ""
Else
Return syt.ToDateString
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fout")
Finally
syt = Nothing
End Try
End Function
Public Sub DTPicker_SetDate(ByVal DTPr_hWnd As IntPtr, ByVal NewDate As Date)
Dim syt As New SystemTime
syt.Day = UInt16.Parse(DatePart(DateInterval.Day, NewDate).ToString)
syt.Month = UInt16.Parse(DatePart(DateInterval.Month, NewDate).ToString)
syt.Year = UInt16.Parse(DatePart(DateInterval.Year, NewDate).ToString)
syt.Second = UInt16.Parse(DatePart(DateInterval.Second, NewDate).ToString)
syt.Minute = UInt16.Parse(DatePart(DateInterval.Minute, NewDate).ToString)
syt.Hour = UInt16.Parse(DatePart(DateInterval.Hour, NewDate).ToString)
syt.DayOfWeek = UInt16.Parse(DatePart(DateInterval.Weekday, NewDate).ToString)
SendMessageSystemTime(DTPr_hWnd, MCM_SETCURSEL, 0, syt)
End Sub
Public Function Load_DTPicker(ByVal FormHandle As IntPtr, _
ByVal pnlDTP_Text As String, ByVal cWidth As Integer, _
ByVal cHeight As Integer) As IntPtr
Dim ret_hWnd As IntPtr
Dim childControl_hWnd As IntPtr
Dim host_hWnd As IntPtr
Dim b As Boolean
Dim icFlag As InitCommonControlsExType
icFlag.dwSize = Marshal.SizeOf(icFlag)
icFlag.dwICC = ICC_DATE_CLASSES
b = InitCommonControlsEx(icFlag)
pnlDateTimePickerText = pnlDTP_Text
Try
childControl_hWnd = GetWindow(FormHandle, GW_CHILD)
host_hWnd = creeper(childControl_hWnd)
If IntPtr.Zero.Equals(host_hWnd) Then
MsgBox("Can't find parent Form Handle.The error no. returned is: " & _
Marshal.GetLastWin32Error, MsgBoxStyle.Critical, "WinAPI Error")
Return IntPtr.Zero
Else
ret_hWnd = CreateWindowEx(0, "SysDateTimePick32".ToCharArray, _
"".ToCharArray, WS_VISIBLE Or WS_BORDER Or WS_CHILD, 0, 0, cWidth, _
cHeight, host_hWnd, 0, 0, Nothing)
If IntPtr.Zero.Equals(ret_hWnd) Then
MsgBox("Can't create DTPicker. returned is: " & _
Marshal.GetLastWin32Error, MsgBoxStyle.Critical, "WinAPI Error")
Return IntPtr.Zero
Else
Return ret_hWnd
End If
'MsgBox(h & " <>" & Marshal.GetLastWin32Error)
End If
Catch ex As Exception
MsgBox(ex.Message)
Return IntPtr.Zero
End Try
End Function
#End Region

#Region "Extra Code"
Private Function creeper(ByVal h As IntPtr) As IntPtr
Do
If isDTPicker(h) Then
Return h
End If
Dim h1 As IntPtr = GetWindow(h, GW_CHILD)
Dim h2 As IntPtr
If Not (IntPtr.Zero.Equals(h1)) Then
If isDTPicker(h1) Then
Return h1
End If
h2 = creeper(h1)
End If
If Not (IntPtr.Zero.Equals(h2)) Then
h = h2
Exit Do
Else
h = GetWindow(h, GW_HWNDNEXT)
End If

Loop While Not IntPtr.Zero.Equals(h)
If IntPtr.Zero.Equals(h) Then
Return IntPtr.Zero
Else
Return h
End If
End Function
Private Function isDTPicker(ByVal h As IntPtr) As Boolean
Dim sb As StringBuilder = New StringBuilder
Dim c1(250) As Char ' = Space(250)
GetWindowText(h, c1, 250)
'MsgBox("Can't create DTPicker. returned is: " &
'Marshal.GetLastWin32Error, MsgBoxStyle.Critical, "WinAPI Error")
sb.Append(c1)
If (sb.ToString.CompareTo(pnlDateTimePickerText) = 0) Then
Return True
Else
Return False
End If
End Function
#End Region

Public Class SystemTime
Public Year As UInt16
Public Month As UInt16
Public DayOfWeek As UInt16
Public Day As UInt16
Public Hour As UInt16
Public Minute As UInt16
Public Second As UInt16
Public MilliSecond As UInt16
Public Function ToDBString() As String
Return String.Format("{0:D4}-{1:D2}-{2:D2} {3:D2}:{4:D2}:{5:D2}.{6:D3}", _
Year.ToString, Month.ToString, Day.ToString, Hour.ToString, Minute.ToString, Second.ToString, MilliSecond.ToString)
End Function
Public Function ToDateString() As String
Return String.Format("{0:D4}/{1:D2}/{2:D4}", Month.ToString, Day.ToString, Year.ToString)
End Function
End Class
End Module

Previous Page

Back to .NET Compact Framework | [Article Index]