CommonControls (Replacement of the MS common controls)

[lrd_VB6]

hello

Too bad, I'm disappointed.
You have not used the code that I had proposed in the attached zip file.
I just tested the release and it does not work as well as mine.
Roll style "Align = Top" a "Align = Left" and it becomes almost imposible to adjust the width !!
I find your version a bit complicated but I have only tested on XP, so it may be there are things I do not know!

I find the code:

Private Function ChangeStyle(ByVal bSetMask As Boolean, ByVal Mask As Long) As Boolean
Dim dwStyle As Long, NewStyle As Long

    If ToolBarHandle Then
        dwStyle = SendMessage(ToolBarHandle, TB_GETSTYLE, 0, ByVal 0&)

        If bSetMask Then
            NewStyle = dwStyle Or Mask
        Else
            NewStyle = dwStyle And Not Mask
        End If

        If dwStyle <> NewStyle Then
            SendMessage ToolBarHandle, TB_SETSTYLE, 0, ByVal NewStyle
            ChangeStyle = True
        End If
    End If

End Function

Public Property Let Divider(ByVal Value As Boolean)
    PropDivider = Value

    If ChangeStyle(Not PropDivider, CCS_NODIVIDER) Then
        SetWindowPos ToolBarHandle, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
        UserControl_Resize
    End If

    UserControl.PropertyChanged "Divider"
End Property

easier to read than:

Public Property Let Divider(ByVal Value As Boolean)
    PropDivider = Value

    If ToolBarHandle <> 0 Then
Dim dwStyle As Long

        dwStyle = SendMessage(ToolBarHandle, TB_GETSTYLE, 0, ByVal 0&)

        If PropDivider = True Then
            If (dwStyle And CCS_NODIVIDER) = CCS_NODIVIDER Then
                SendMessage ToolBarHandle, TB_SETSTYLE, 0, ByVal dwStyle And Not CCS_NODIVIDER
                SetWindowPos ToolBarHandle, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            End If

        Else

            If Not (dwStyle And CCS_NODIVIDER) = CCS_NODIVIDER Then
                SendMessage ToolBarHandle, TB_SETSTYLE, 0, ByVal dwStyle Or CCS_NODIVIDER
                SetWindowPos ToolBarHandle, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            End If
        End If

        Call UserControl_Resize
    End If

    UserControl.PropertyChanged "Divider"
End Property

Then my code version is "simpler" and does not have the default when you want to change the height or width if you change the property "Align"

Private Sub UserControl_Resize()
Static InProc As Boolean

    If ToolBarHandle = 0 Then Exit Sub
Dim dwStyle As Long
Dim mWidth  As Single, mHeight As Single
Dim mAlign  As VBRUN.AlignConstants
    If InProc Then Exit Sub
    InProc = True
    dwStyle = SendMessage(ToolBarHandle, TB_GETSTYLE, 0, ByVal 0&)

    With UserControl
        mAlign = .Extender.Align
'
'Align Change ?
'
        If ChangeStyle(mAlign = vbAlignRight Or mAlign = vbAlignLeft, CCS_VERT) Then ' force resize Height or Width

            Select Case mAlign 

                Case vbAlignTop, vbAlignBottom ', vbAlignNone
                    Me.Height = 10 

                Case vbAlignLeft, vbAlignRight
                    Me.Width = 10
            End Select

        End If
' necessary if the calculation does not work
' set size AND redraw for TB_AUTOSIZE calc
        MoveWindow ToolBarHandle, 0, 0, .ScaleWidth, .ScaleHeight, 1
' 
        SendMessage ToolBarHandle, TB_AUTOSIZE, 0, ByVal 0&

        GetIdealSize mWidth, mHeight
'
' In GetIdealSize() Now
'        If (dwStyle And CCS_NODIVIDER) = 0 Then
'            mHeight = mHeight + .ScaleY(2, vbPixels, vbContainerSize)
'        End If

        Select Case mAlign

            Case vbAlignTop, vbAlignBottom ', vbAlignNone
                mWidth = Me.Width

            Case vbAlignLeft, vbAlignRight
                mHeight = Me.Height

            Case Else
'optional, force a minimum width or height
                If Me.Height > mHeight Then mHeight = Me.Height
                If Me.Width > mWidth Then mWidth = Me.Width
        End Select

        .Size mWidth, mHeight
        MoveWindow ToolBarHandle, 0, 0, .ScaleWidth, .ScaleHeight, 1
    End With

    InProc = False
End Sub

But as I said, I did do the test ONLY on XP, so ....

Otherwise, nice work, I hope I can continue to make my contribution to the building.


kind regards