Experiment met listboxen voor log en foutberichten op scherm en Ik kan de logberichten daarin zetten met lsbx.Add(s, 0) .
Maar ik wil het op een minder storende manier:
- Ik heb op mijn Form een aparte listbox voor fouten lsbxErr en één voor gewone logberichten lsbxLog
- Die zitten samen in een dichtklapbaar parent (Expander), zodat ze niet in de weg staan als ze niet relevant zijn.
- Als het maximaal aantal lijnen in de listbox (iSize) is overschreden, wordt de oudste lijn verwijderd (onderste)
| Form content here.. …. …. Expander with lsbx’s starts under here : | Note: expanded = lsbx’s visible |
| lsbxLog: – log line 0 – log line 1 .. | lsbxEr: – err line 0 – err line 1 … |
Zet de instellingen van de form objecten:
- Form Arrangement: vertical
- Form content Expand: True
- Expander.Arrangement: Horizontal
- Expander Expand: True
- Iedere listbox Expand: True
We willen het verloop van de berichten zo:
- Een logbericht komt bovenaan bij in lsbxLog, en verandert niets aan de zichtbaarheid (als Expander open of gesloten stond blijft dat zo)
- Een errormessage komt bovenaan in de lsbxError, en opent de parent Expander.
- Het laatste bericht komt als Tooltip te staan van de eigen Listbox én als text van de parent expander; bij gesloten expander is zo het laatste bericht leesbaar.
Om hetzelfde te kunnen doen op al onze forms zetten we de code in MMain:
Public Const csHide As String = "h"
Public Const csShow As String = "s"
Public Const csUnchanged As String = "u"
Public iMaxLsbxLen As Integer = 100
Public Sub addToListbox(lsbx As ListBox, s As String, iSize As Integer, sHideShowUnchanged As String, bCompress As Boolean)
Dim myExpanderParent As Expander
lsbx.Tooltip = s
If lsbx.Tag = "" Then
lsbx.Tag = 0
Endif
' add to list if needed
If bCompress And lsbx.Count > 0 Then
' show repeated item with added string and keep in mind when comparing again..
If (lsbx[0].Text = s) Or (lsbx[0].Text = s & " (++)") Then
If lsbx[0].Text = s
lsbx[0].Text &= " (++)" ' show it is repeated several times
Endif
lsbx.Tag = lsbx.Tag + 1 ' last consecutive count
Else
lsbx.Add(s, 0)
lsbx.Tag = 1
Endif
lsbx.Tooltip &= " (R:" & lsbx.Tag & ")"
Else
lsbx.Add(s, 0)
Endif
' add size
lsbx.Tooltip &= "; Size:" & lsbx.Count
' adjust parent to make message visible even with closed expander
myExpanderParent = lsbx.Parent
Try myExpanderParent.Text = s
Try myExpanderParent.Tooltip = lsbx.Name
If Error Then
Message.Error(Error.Text)
Endif
' keep within limits
If lsbx.Count > IIf(isize, iSize, iMaxLsbxLen) Then
Try lsbx.Remove(IIf(isize, iSize, iMaxLsbxLen))
If Error Then
Print "Could not trim " & lsbx.Name & ": " & Error.Text
Endif
Endif
' does this trigger the parent to expand to make change visible?
Select sHideShowUnchanged
Case "h"
Try myExpanderParent.Hidden = True ' assume parent is Expander
Case "s"
Try myExpanderParent.Hidden = False ' assume parent is Expander
Case Else ' incl empty
' leave unchanged
End Select
If Error Then
Message.Error(Error.Text)
Endif
End
Uitbreidingen of aanpassen bv:
- bewaar log/err in bestand.


