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.

Any suggestion how to rapidly fill a treeview?
E.g. in the procedure _Expand() add 100000 children takes quite some time.

Thanky you, Chris

Quote:

---

Originally Posted by Chris_G33

Any suggestion how to rapidly fill a treeview?
E.g. in the procedure _Expand() add 100000 children takes quite some time.

Thanky you, Chris

---

Not possible. Consider using different control which allows virtual mode.

VBCCR 1.8.83

hi Krool,

the header of the calendar is truncated when setting VisualStyles=false

Attachment 195921

Quote:

---

Originally Posted by Mith

VBCCR 1.8.83

hi Krool,

the header of the calendar is truncated when setting VisualStyles=false

Attachment 195921

---

I can't replicate. Demo? Thx

Quote:

---

Originally Posted by Krool

I can't replicate. Demo? Thx

---

I found the reason:

you have to change the property .CalendarFont, for example to "Segoe UI" with a size of 11.

i guess the font size was not taken into account in the calculation for the size of the dropdown-calendarview-panel.

Side question : how do you get the calendar in dark mode ?

Quote:

---

Originally Posted by Crapahute

Side question : how do you get the calendar in dark mode ?

---

.VisualStyles=false and set the calendar-color-properties of the DTPicker-control yourself

Quote:

---

Originally Posted by Mith

.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.

Quote:

---

Originally Posted by Krool

Will fix both issues soon.

---

Thx! Will we get a new OCX update?

Quote:

---

Originally Posted by Mith

.VisualStyles=false and set the calendar-color-properties of the DTPicker-control yourself

---

Thanks, it helps. Anyway, I get grey bars on sides as if the calendar doesn't fill its popup window, but it's becoming better.

Another control I c'an't have in dark mode is the ImageCombo.

Quote:

---

Originally Posted by Crapahute

Another control I c'an't have in dark mode is the ImageCombo.

---

Check this thread for VB6 & DarkMode: https://www.vbforums.com/showthread.php?t=900444

Update released.

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.

Quote:

---

Originally Posted by Mith

Thx! Will we get a new OCX update?

---

Sure. Done.

VBCCR v1.8.86

Its fixed:

Attachment 195928

Thx Krool!

VBCCR 1.8.86

Hi Krool,

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.

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.Attachment 195931
Attached is screenshot see that Good Friday is shifted, likewise May Day. OS has Finnish calendar settings.

Quote:

---

Originally Posted by Mith

VBCCR 1.8.86

Hi Krool,

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.

Quote:

---

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.Attachment 195931
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

---

Attachment 195934

Quote:

---

Originally Posted by Krool

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

---

VBCCR 1.8.86

Hi Krool,

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:

Attachment 195936

Both MonthViews have .VisualStyles=FALSE and i changed only the colors of the left control:

Code:

---

        MonthView2.BackColor = gDarkMode_BackColor
        MonthView2.ForeColor = vbYellow
        MonthView2.TitleBackColor = gDarkMode_BackColor2
        MonthView2.TitleForeColor = vbGreen
        MonthView2.TrailingForeColor = vbWhite

---

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.

Quote:

---

Originally Posted by Tech99

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

---

Attachment 195934

---

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.

StartOfWeek in properties is 0.
I had presumed, that this means use system start of the week?

Quote:

---

Originally Posted by Tech99

StartOfWeek in properties is 0.
I had presumed, that this means use system start of the week?

---

Then let Weekday also use system start of week. (Remove vbMonday)

Quote:

---

Originally Posted by Mith

VBCCR 1.8.86

Hi Krool,

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:

Attachment 195936

Both MonthViews have .VisualStyles=FALSE and i changed only the colors of the left control:

Code:

---

        MonthView2.BackColor = gDarkMode_BackColor
        MonthView2.ForeColor = vbYellow
        MonthView2.TitleBackColor = gDarkMode_BackColor2
        MonthView2.TitleForeColor = vbGreen
        MonthView2.TrailingForeColor = vbWhite

---

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 ?

Quote:

---

Originally Posted by Mith

Can you add a run-time property like .hwndEditBox so i can lock the editbox myself?

---

Use the BeforeUserInput event to grab hWndEdit.

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)
    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.

Quote:

---

Originally Posted by Tech99

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)
    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 !!!!

No worky...

Code:

---

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

---

Quote:

---

Originally Posted by Krool

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 ?

---

Thats the reason i switched to .VisualStyles=false because afaik there is no SetWindowTheme-call that changes the CalendarView to DarkMode.
See https://www.vbforums.com/showthread....=1#post5690100

Quote:

---

Originally Posted by Krool

Use the BeforeUserInput event to grab hWndEdit.

---

ok, that works! no more user input:

Code:

---

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

---

Quote:

---

Originally Posted by Tech99

No worky...

Code:

---

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

---

---

Don't use vbUseSystem. Just omit the argument.

Ok, understood. Thanks.

Code:

---

dtDate = DateAdd("d", i - 1, StartDate)
If Weekday(dtDate) = vbSunday Then State(i) = True
If Weekday(dtDate) = vbSaturday Then State(i) = True
If IsArkiPyha(dtDate) Then State(i) = True ' = Arkipyhä / Mid weekday/Public holiday

---

When I try to apply Dark Mode to a MonthView object, I get grey lines/bars and ‘Today’s date’ is cropped. Here is the code I use:

Code:

---

With MonthView1
.VisualStyles = False
SetWindowTheme .hWnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
.BackColor = FRMBACKCOLOR
.ForeColor = FRMFORECOLOR
.TitleBackColor = FRMBACKCOLOR
.TitleForeColor = FRMFORECOLOR
End With

---

Attachment 195944

Quote:

---

Originally Posted by Crapahute

When I try to apply Dark Mode to a MonthView object, I get grey lines/bars and ‘Today’s date’ is cropped. Here is the code I use:

Code:

---

With MonthView1
.VisualStyles = False
SetWindowTheme .hWnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
.BackColor = FRMBACKCOLOR
.ForeColor = FRMFORECOLOR
.TitleBackColor = FRMBACKCOLOR
.TitleForeColor = FRMFORECOLOR
End With

---

Attachment 195944

---

Good catch. Fixed. The MonthView control will now resize and re-compute itself upon WM_THEMECHANGED.

The same now also for the DTPicker and it's drop-down calendar.

VBCCR 1.8.89
DTPicker-Control

Hi Krool,

any chance to get a .hwnd for the up/down-arrow-block when setting .UpDown=True to change this to DarkMode too?

Attachment 195955

Quote:

---

Originally Posted by Mith

VBCCR 1.8.89
DTPicker-Control

Hi Krool,

any chance to get a .hwnd for the up/down-arrow-block when setting .UpDown=True to change this to DarkMode too?

Attachment 195955

---

Code:

---

UpDownHandle = FindWindowEx(DTPicker1.hWnd, NULL_PTR, StrPtr("msctls_updown32"), NULL_PTR)

---

Or use DATETIMEPICKERINFO and hWndUD as of comctl32 6.1.
But yes, I will offer a property hWndUpDown. But not for OCX 1.8.

Quote:

---

Originally Posted by Krool

But yes, I will offer a property hWndUpDown. But not for OCX 1.8.

---

:ehh:

Will we get this hWndUpDown-property when you release a new OCX because of a bug fix?

btw, i used this code:

Code:

---

SetWindowTheme DTPicker4.Hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
UpDownHandle  = FindWindowEx(DTPicker4.Hwnd, 0&, "msctls_updown32", "")
SetWindowTheme UpDownHandle , 0&, StrPtr("DarkMode::FileExplorerBannerContainer")

---

and the result is:

Attachment 195962

looks not perfect because of the missing up/down arrows but better than before.

Quote:

---

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.

Quote:

---

Originally Posted by Mith

:ehh:

Will we get this hWndUpDown-property when you release a new OCX because of a bug fix?

btw, i used this code:

Code:

---

SetWindowTheme DTPicker4.Hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
UpDownHandle  = FindWindowEx(DTPicker4.Hwnd, 0&, "msctls_updown32", "")
SetWindowTheme UpDownHandle , 0&, StrPtr("DarkMode::FileExplorerBannerContainer")

---

and the result is:

Attachment 195962

looks not perfect because of the missing up/down arrows but better than before.

---

Use "DarkMode_Explorer" for the updown for better results.
Attachment 195966

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

---