'***************************************************** fonction raffraichissement du visuel du visuel **********************************
Sub visual() ' raffraichissement du visual
Dim ctrl, All, T&, elem, X&, L&, B, q&, nom$, nomparent$, w, wx
For Each ctrl In Frame1.Controls
Me.Controls.Remove ctrl.Name
Next
Set All = docXML.getelementsbytagname("*")
T = 5
For Each elem In All
With Me.Frame1
X = X + 1
nom = IIf(IsNull(elem.getattribute("id")), elem.tagname, elem.getattribute("id"))
Set B = .Controls.Add("Forms.Label.1", nom, True)
If elem.getattribute("onLoad") <> "" Then tbxRibbonOnLoad = elem.getattribute("onLoad")
L = 0
If X >= 2 Then
nomparent = IIf(IsNull(elem.ParentNode.getattribute("id")), elem.ParentNode.tagname, elem.ParentNode.getattribute("id"))
'MsgBox nom & vbCrLf & nomparent
L = .Controls(nomparent).Left + 20
End If
With B
If elem.tagname = "group" Then T = T + 10: w = 120 Else w = 120:
.Move L, T, w, 17:
.Caption = IIf(IsNull(elem.getattribute("label")), " " & elem.tagname, " " & elem.getattribute("label"))
If elem.tagname = "separator" Then .Caption = "separator"
.BorderStyle = 1
.PicturePosition = 0
If Not IsNull(elem.getattribute("imageMso")) Then B.Picture = Application.CommandBars.GetImageMso(elem.getattribute("imageMso"), 25, 25)
.TextAlign = 1
.ControlTipText = "--" & UCase(elem.tagname) & "--" & elem.getattribute("label")
End With
If elem.tagname <> "ribbon" And elem.tagname <> "customUI" Then
q = q + 1: ReDim Preserve cls(1 To q): Set cls(q).BtX = B
End If
Select Case elem.tagname
Case "ribbon": B.BackColor = RGB(220, 220, 220)
Case "tabs": B.BackColor = RGB(200, 200, 200)
Case "tab": B.BackColor = RGB(180, 180, 180)
Case "group": B.BackColor = RGB(255, 150, 150)
Case "box": B.BackColor = IIf(elem.getattribute("boxStyle") = "vertical", RGB(255, 255, 150), RGB(150, 255, 255))
Case "button": B.BackColor = RGB(0, 190, 255)
Case "gallery": B.BackColor = RGB(255, 255, 150)
Case "dynamicMenu": B.BackColor = RGB(0, 255, 0)
Case "menu": B.BackColor = RGB(100, 255, 100)
Case "comboBox": B.BackColor = RGB(255, 0, 190)
Case "editBox": B.BackColor = RGB(240, 240, 240)
Case "dropDown": B.BackColor = RGB(235, 0, 190)
Case "buttonGroup": B.BackColor = RGB(0, 0, 100): B.ForeColor = vbWhite
Case "toggleButton": B.BackColor = RGB(100, 0, 100): B.ForeColor = vbWhite
Case "splitButton": B.BackColor = RGB(0, 120, 150): B.ForeColor = vbWhite
End Select
T = T + 18
End With
If elem.getattribute("image") <> "" Then
B.Picture = LoadPicture(getcopyWMF(dossierimage & "\" & Dir(dossierimage & "\" & elem.getattribute("image") & ".*")))
End If
wx = IIf(B.Width + B.Left > wx, B.Width + B.Left, wx)
Next
Me.Repaint
Frame1.ScrollHeight = Frame1.Controls(Frame1.Controls.Count - 1).Top + 30
Frame1.ScrollTop = Frame1.ScrollHeight
Frame1.ScrollWidth = wx
End Sub