Ajout d'un contrôle calendrier en dynamique sur une form, d'une manière peut conventionnelle !

0/5 (4 avis)

Snippet vu 7 597 fois - Téléchargée 19 fois

Commenter

Contenu du snippet

Tous l'intérêt de ce code est de découvrir une manière peux conventionnel pour inclure un contrôle sur une form….

Le code original est de Michel Pierron (http://www.excelabo.net/trucs/ocx_optionnel) que j’ai simplifié et complété.

Source / Exemple : 


'
' Source original : (Michel Pierron) http://www.excelabo.net/trucs/ocx_optionnel
'
' Pour tester, mettre dans en bas d’une form une TextBox nommé TextBox1, et deux boutons nommés CmdSET et CmdGET.
'
'

 
 Option Explicit
 
 Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd 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 Sub InitCommonControls Lib "comctl32" ()

' MonthCal Messages
 Private Const MCM_FIRST = &H1000
 Private Const MCM_GETCURSEL = (MCM_FIRST + 1)
 Private Const MCM_SETCURSEL = (MCM_FIRST + 2)
 Private Const MCM_SETCOLOR = (MCM_FIRST + 10)
 Private Const MCM_GETCOLOR = (MCM_FIRST + 11)
 Private Const MCM_SETFIRSTDAYOFWEEK = (MCM_FIRST + 15)
 Private Const MCM_GETFIRSTDAYOFWEEK = (MCM_FIRST + 16)

' MonthCal Styles
 Private Const MCS_MULTISELECT = &H2
 Private Const MCS_WEEKNUMBERS = &H4
 Private Const MCS_NOTODAYCIRCLE = &H8
 Private Const MCS_NOTODAY = &H10

' MonthCal Color
 Private Const MCSC_BACKGROUND = 0   ' the background color (between months)
 Private Const MCSC_TEXT = 1         ' the dates
 Private Const MCSC_TITLEBK = 2      ' background of the title
 Private Const MCSC_TITLETEXT = 3
 Private Const MCSC_MONTHBK = 4      ' background within the month cal
 Private Const MCSC_TRAILINGTEXT = 5 ' the text color of header & trailing days
  
  Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
 End Type

Private dtHwnd As Long

Private Sub Form_Load()
  InitCommonControls
  dtHwnd = CreateWindowEx(0, "SysMonthCal32", vbNullString, &H50000000 + MCS_WEEKNUMBERS, 40, 10, 200, 200, Me.hWnd, 0&, 0&, ByVal 0&)
  SendMessage dtHwnd, MCM_SETCOLOR, MCSC_BACKGROUND, ByVal &HE0E0E0
  SendMessage dtHwnd, MCM_SETCOLOR, MCSC_TITLEBK, ByVal RGB(46, 210, 50)
End Sub

Private Sub CmdGET_Click()
 Dim CurSysTime As SYSTEMTIME
  SendMessage dtHwnd, MCM_GETCURSEL, 0&, CurSysTime
  Me.TextBox1.Text = Format(DateSerial(CurSysTime.wYear, CurSysTime.wMonth, CurSysTime.wDay), "Short Date")
End Sub

Private Sub CmdSET_Click()
 Dim CurSysTime As SYSTEMTIME
  On Error Resume Next
   CurSysTime.wYear = Year(CDate(Me.TextBox1.Text))
   CurSysTime.wMonth = Month(CDate(Me.TextBox1.Text))
   CurSysTime.wDay = Day(CDate(Me.TextBox1.Text))
  On Error GoTo 0
  SendMessage dtHwnd, MCM_SETCURSEL, 0&, CurSysTime
End Sub

Private Sub Form_QueryClose(Cancel As Integer, CloseMode As Integer)
 DestroyWindow dtHwnd
End Sub

Conclusion :


Pour la récupération automatique de la date sélectionnée, on pourrait prévoir une procédure de sous classement de la fenêtre dtHwnd. Personnellement, j'utilise un simple timer et la procédure suivante :

Private Sub TimerCalendar_Timer()
Static Dt As String
Dim CurSysTime As SYSTEMTIME
Dim NewDT As String
TimerCalendar = False
SendMessage dtHwnd, MCM_GETCURSEL, 0&, CurSysTime
NewDT = Format(DateSerial(CurSysTime.wYear, CurSysTime.wMonth, CurSysTime.wDay), "Short Date")
If Dt = "" Then Dt = NewDT
If Dt <> NewDT Then
Me.TextBox1.Text = NewDT
Dt = NewDT
End If
TimerCalendar = True
End Sub

A voir également

Ajouter un commentaire Commentaires
cs_patrick Messages postés 31 Date d'inscription vendredi 19 mai 2000 Statut Membre Dernière intervention 21 juillet 2015
6 sept. 2010 à 14:21
bien vu : il manquait un simple InitCommonControls()
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 75
2 sept. 2010 à 15:04
devrait fonctionner...
manque surement un InitCommonControls(Ex ?)
cs_patrick Messages postés 31 Date d'inscription vendredi 19 mai 2000 Statut Membre Dernière intervention 21 juillet 2015
2 sept. 2010 à 14:35
salut,

- TimerCalendar = False / True en début et fin de procédure sont des sécurités que je met systématiquement sur mais Timer.

- Mon code permet un fonctionnement dans les 2 sens : tu peux soit cliquer dans le calendrier, soit modifier la date dans la TextBox et faire SET pour fixé la date sur le calendier...

...Par contre j'ai détecté un problème : LE CODE NE FONCTIONNE QUE DANS L'ENVIRONNEMENT VB !

une fois compilé, CreateWindowEx retourne 0 et rien ne s'affiche (VB5 Pro) !

Je cherche.... mais je ne comprend pas pourquoi... (compile en natif ou p-code)

A+ Patrick
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 75
2 sept. 2010 à 12:42
Si on regarde le code de ton Timer, la zone de texte ne se remplit pas toute seule, avant que l'on ne change la valeur du calendar...

ton TimerCalendar est inutile, deux intervalles ne survenant jamais en même temps.

en bref, je mettrai :

Private Sub TimerCalendar_Timer()
Dim CurSysTime As SYSTEMTIME
Dim NewDT As String
SendMessage dtHwnd, MCM_GETCURSEL, 0&, CurSysTime
NewDT = FormatDateTime(DateSerial(CurSysTime.wYear, CurSysTime.wMonth, CurSysTime.wDay), vbShortDate)
If TextBox1 <> NewDT Then
Me.TextBox1.Text = NewDT
End If
End Sub
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_patrick)