Re: CommonControls (Replacement of the MS common controls)
Update released.
Included the TextIndent/PictureIndent property of a Panel in the StatusBar control.
This allows to fine-tune the placement or to give some extra space in-between for a child control on a panel.
.VisualStyles=false and set the calendar-color-properties of the DTPicker-control yourself
Good catch. That only happens from comctl 6.1 onwards. (Vista+)
In fact it is a MS bug as the dropdown does not resize when unthemed. For the default font it is just luck that it fits somewhat. (but not perfect)
Also found another bug that CalendarFont is only read from property bag but not written properly to it. Means it can't be set at design time.
Will fix both issues soon.
Bugfix that the size is incorrect for an un-themed drop-down calendar in the DTPicker control. (comctl version 6.1 [Vista+])
CalendarFont not written to the property bag in the DTPicker control.
DTPicker1_CalendarGetDayBold -> SetDayState function has bold state setting bug, when trying to set bold state other than sunday ie. midweek/public holidays.
fex. Good Friday and if New Years's Day is in mid week.
Bold state seems to be shifted by one day earlier. Sundays work ok.
Attached is screenshot see that Good Friday is shifted, likewise May Day. OS has Finnish calendar settings.
Last edited by Tech99; Apr 29th, 2026 at 11:48 PM.
i guess i maybe found another bug in the DTPicker-Control:
I set AllowUserInput=FALSE but the user still can modify the date in the editbox.
AllowUserInput = FALSE does not mean it is locked. It's just that when you press F2 or click on it there is no custom user input possible via ParseUserInput event.
Originally Posted by Tech99
DTPicker1_CalendarGetDayBold -> SetDayState function has bold state setting bug, when trying to set bold state other than sunday ie. midweek/public holidays.
fex. Good Friday and if New Years's Day is in mid week.
Bold state seems to be shifted by one day earlier. Sundays work ok.
Attached is screenshot see that Good Friday is shifted, likewise May Day. OS has Finnish calendar settings.
Can't replicate. See my code below works.. it would be maybe less confusing if the State() array would be zero-based and not one-based. But that is now impossible to change..
Code:
Private Sub DTPicker1_CalendarGetDayBold(ByVal StartDate As Date, ByVal Count As Long, State() As Boolean)
Dim i As Long
For i = 1 To Count
Select Case DateAdd("d", i - 1, StartDate)
Case #4/3/2026#, #5/1/2026#
State(i) = True
End Select
Next i
End Sub
When using 'i-1' computation. midweek/public holidays are ok, but weekends not, as shifted by one day.
Code:
Private Sub dtDeliverydate_CalendarGetDayBold(ByVal StartDate As Date, ByVal Count As Long, State() As Boolean)
Dim i As Long
Dim dtDate As Date
For i = 1 To Count
'dtDate = DateAdd("d", i, StartDate)
dtDate = DateAdd("d", i - 1, StartDate)
If Weekday(dtDate, vbMonday) = vbSunday Then State(i) = True
If Weekday(dtDate, vbMonday) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then
'State(i) = True 'Bug...
'If i < Count Then State(i + 1) = True 'Bug correction. 'Bold state setting seems to be shifted by one day earlier. Weekends (Saturdays and Sundays) work ok.>
If i < Count Then State(i) = True
End If
Next i
End Sub
AllowUserInput = FALSE does not mean it is locked. It's just that when you press F2 or click on it there is no custom user input possible via ParseUserInput event.
Can you add a run-time property like .hwndEditBox so i can lock the editbox myself?
Expand/show MonthView over one month and close it to display just one month, selected date range shifts.
Code:
Dim mStartDate As Date
Dim mEndDate As Date
Private Sub MonthView1_MouseEnter()
Debug.Print "MonthView1_MouseEnter"
MonthView1.MonthColumns = 3
If IsDate(mStartDate) And IsDate(mEndDate) Then
Debug.Print "mStartDate = " & mStartDate
Debug.Print "mEndDate = " & mEndDate
Call MonthView1_SelChange(mStartDate, mEndDate)
MonthView1.Refresh 'Refresh, does not work correctly, when selected multiple months or month other than leftmost.
End If
End Sub
Private Sub MonthView1_MouseLeave()
Debug.Print "MonthView1_MouseLeave"
MonthView1.MonthColumns = 1
End Sub
Private Sub MonthView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "MonthView1_MouseUp"
End Sub
Private Sub MonthView1_SelChange(ByVal StartDate As Date, ByVal EndDate As Date)
Debug.Print "MonthView1_SelChange - StartDate = " & StartDate & " EndDate = " & EndDate
mStartDate = StartDate
mEndDate = EndDate
lblOhje.Caption = "Selected date range = " & mStartDate & " - " & mEndDate
End Sub
Last edited by Tech99; Apr 30th, 2026 at 04:35 AM.
when using the MonthView control with .VisualStyles=FALSE and changing .TitleBackColor the color of the font of the short weekday names under the Title is changed to .TitleBackColor too!
The weekday names are nearly invisible:
Both MonthViews have .VisualStyles=FALSE and i changed only the colors of the left control:
When using 'i-1' computation. midweek/public holidays are ok, but weekends not, as shifted by one day.
Code:
Private Sub dtDeliverydate_CalendarGetDayBold(ByVal StartDate As Date, ByVal Count As Long, State() As Boolean)
Dim i As Long
Dim dtDate As Date
For i = 1 To Count
'dtDate = DateAdd("d", i, StartDate)
dtDate = DateAdd("d", i - 1, StartDate)
If Weekday(dtDate, vbMonday) = vbSunday Then State(i) = True
If Weekday(dtDate, vbMonday) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then
'State(i) = True 'Bug...
'If i < Count Then State(i + 1) = True 'Bug correction. 'Bold state setting seems to be shifted by one day earlier. Weekends (Saturdays and Sundays) work ok.>
If i < Count Then State(i) = True
End If
Next i
End Sub
In the Weekday function you use vbMonday as start of week. What's in the DTPicker?
Normally you should omit vbMonday that vb6 can calculate the weekday correctly to your system setting.
when using the MonthView control with .VisualStyles=FALSE and changing .TitleBackColor the color of the font of the short weekday names under the Title is changed to .TitleBackColor too!
The weekday names are nearly invisible:
Both MonthViews have .VisualStyles=FALSE and i changed only the colors of the left control:
Is this a bug or why does the font under the Title uses the color of .TitleBackColor?
It should use .TitleForeColor or have its one FontColor.
It seems the week title share the same color as title back color. I can't fix it as it's MS design.
Is there no dark mode theme when visual styles = True ?
Private Sub dtDeliverydate_CalendarGetDayBold(ByVal StartDate As Date, ByVal Count As Long, State() As Boolean)
Dim i As Long
Dim dtDate As Date
For i = 1 To Count
dtDate = DateAdd("d", i, StartDate)
If Weekday(dtDate, vbUseSystem) = vbSunday Then State(i) = True
If Weekday(dtDate, vbUseSystem) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then
'State(i) = True 'Bug...
If i < Count Then State(i + 1) = True 'Bug correction. 'Bold state setting seems to be shifted by one day earlier. Weekends (Saturdays and Sundays) work ok.
End If
Next i
End Sub
System start of the week is monday (Finnish regional settings).
Still needs one day adjustment in midweek/public holidays.
Private Sub dtDeliverydate_CalendarGetDayBold(ByVal StartDate As Date, ByVal Count As Long, State() As Boolean)
Dim i As Long
Dim dtDate As Date
For i = 1 To Count
dtDate = DateAdd("d", i, StartDate)
If Weekday(dtDate, vbUseSystem) = vbSunday Then State(i) = True
If Weekday(dtDate, vbUseSystem) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then
'State(i) = True 'Bug...
If i < Count Then State(i + 1) = True 'Bug correction. 'Bold state setting seems to be shifted by one day earlier. Weekends (Saturdays and Sundays) work ok.
End If
Next i
End Sub
System start of the week is monday (Finnish regional settings).
Still needs one day adjustment in midweek/public holidays.
Use i - 1 for DateAdd. And omit in Weekday. Vb6 defaults to Sunday. Which must be like that or the vbSunday constant shifts !!!!
Dim i As Long
Dim dtDate As Date
For i = 1 To Count
dtDate = DateAdd("d", i - 1, StartDate)
If Weekday(dtDate, vbUseSystem) = vbSunday Then State(i) = True
If Weekday(dtDate, vbUseSystem) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then State(i) = True ' = Arkipyhä / Mid woeekday/Public holiday
Next i
It seems the week title share the same color as title back color. I can't fix it as it's MS design.
Is there no dark mode theme when visual styles = True ?
Public Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Sub dtp1_BeforeUserInput(ByVal hWndEdit As Long)
Call SendMessageW(hWndEdit, &HCF, 1, ByVal 0&) 'EM_SETREADONLY
End Sub
Dim i As Long
Dim dtDate As Date
For i = 1 To Count
dtDate = DateAdd("d", i - 1, StartDate)
If Weekday(dtDate, vbUseSystem) = vbSunday Then State(i) = True
If Weekday(dtDate, vbUseSystem) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then State(i) = True ' = Arkipyhä / Mid woeekday/Public holiday
Next i
Re: CommonControls (Replacement of the MS common controls)
Originally Posted by Karl77
IMAGE COMBO QUESTION
I have an ImageCombo with images and text.
When an item is selected, the ImageCombo has the focus.
The image is also focused and doesn't look good.
The image is clear when I move the focus to another control (e.g. on ImageCombo1_CloseUp).
I want the image to be clear when an item is selected.
Is there a way to do this without moving the focus to another control?
Hi Karl77, is this still relevant ?
You want the images to be drawn without selected state for the combo box and the dropdown list ?
I tested with the API-Hooking-basic-working-example (x86 and x64 [twinBASIC]) and it works. For example to temporarily hook ImageList_Draw on WM_PAINT and restore afterwards. In the hooked function we remove ILD_BLEND25 and ILD_BLEND50.
I could offer an in-built property to do the task. Just let me know. I can imagine that it may be a common problem when you have "color images" which you do not want distorted when selected. Like yours.
looks not perfect because of the missing up/down arrows but better than before.
Use "DarkMode_Explorer" for the updown for better results.
Due to compatibility I cannot add all the time new features to OCX 1.8. Sometimes it is even impossible. The implemented hWndUpDown looks like this:
Code:
#If VBA7 Then
Public Property Get hWndUpDown() As LongPtr
#Else
Public Property Get hWndUpDown() As Long
#End If
If DTPickerHandle <> NULL_PTR Then
If ComCtlsSupportLevel() >= 2 Then
Dim DTPI As DATETIMEPICKERINFO
DTPI.cbSize = LenB(DTPI)
SendMessage DTPickerHandle, DTM_GETDATETIMEPICKERINFO, 0, ByVal VarPtr(DTPI)
hWndUpDown = DTPI.hWndUD
Else
hWndUpDown = FindWindowEx(DTPickerHandle, NULL_PTR, StrPtr("msctls_updown32"), NULL_PTR)
End If
End If
End Property