[RESOLVED] set font bold in listbox

[luca90]

how to set in bold font, the first and third row in listbox?

[dilettante]

These things can be done but it is a lot of work. You might want to look at 3rd party OCXs for such things.

Doing them in pure VB6 requires a lot of hacking. First you have to hook control creation in order to cause a ListBox to be created with the "owner drawn" style. Then you need subclassing to capture the messages that get sent, and then do the drawing of text within the control yourself.

Since a ListBox is meant for user input (not output display) nobody ever bothers to go to all this trouble very often. The most common use might be as a font face picker where you want the list to provide a preview of each font. Another might be weird cases where you want an icon image as well as text, but things are already getting excessive at that point.

Searches should turn up a description of the process and maybe some sample code. You could also look at the old Common Controls Replacement Project © or efforts that try to replace that like Krool's controls in the CodeBank.

But you have probably chosen the wrong control.

[SamOscarBrown]

You mean something like this?...

[luca90]

You mean something like this?...

yes!
sorry me for delay.

[SamOscarBrown]

Well....I did not do as you asked (using a LISTBOX), but instead, used a flexgrid (as dile pointed out: "But you have probably chosen the wrong control.")

Here's the code (notice the commented sections)

Option Explicit


'add MsFlexGrid to Form1, rename to "Grid1"
'change Grid1 properties as follows:
'Width = 2985
'Height = any height you want
'GridLines = 0
'GridLinesFixed = 0
'Cols = 1
'ScrollBars = 2
'BackColorBkg set to White
'BorderStyle = 0


Private Sub Form_Load()
    Grid1.Col = 0
    Grid1.Rows = 9  'only as an example....you can populate your grid (list) any way you want
    Grid1.ColWidth(0) = 3000  'experimented with ColWidth based on Width property
    Dim i As Integer
    Grid1.TextMatrix(0, 0) = "Sam Brown"
    Grid1.TextMatrix(1, 0) = "dilettante"
    Grid1.TextMatrix(2, 0) = "Schmidt"
    Grid1.TextMatrix(3, 0) = "Elroy"
    Grid1.TextMatrix(4, 0) = "DataMiser"
    Grid1.TextMatrix(5, 0) = "wqweto"
    Grid1.TextMatrix(6, 0) = "Niya"
    Grid1.TextMatrix(7, 0) = "luca90"
    Grid1.TextMatrix(8, 0) = "Shaggy Hiker"
    For i = 0 To Grid1.Rows - 1 Step 2   'every other row set to bold starting with row 0
        Grid1.Row = i
        Grid1.Col = 0
        Grid1.CellFontBold = True
    Next i
End Sub

[SamOscarBrown]

And to make the grid 'act/look' like a listbox when clicked, add this:

Private Sub Grid1_Click()    Dim i As Integer
    Dim rowNum As Integer
    rowNum = Grid1.RowSel
    For i = 0 To Grid1.Rows - 1
        Grid1.Row = i
        Grid1.CellBackColor = vbWhite
        Grid1.CellForeColor = vbBlack
    Next i
    Grid1.Row = rowNum
    Grid1.CellBackColor = &HD77800
    Grid1.CellForeColor = vbWhite
End Sub

[dilettante]

Or better yet use the proper system colors. Then your user interface doesn't fall apart if the user has accessibility themes or something active.

[SamOscarBrown]

true

[SamOscarBrown]

something like this, dile?

Option Explicit
'to get system colors
Private Declare Function GetSysColor Lib "user32" _
    (ByVal nIndex As Long) As Long
Private Type COLORREF
    RED_VALUE As Byte
    GREEN_VALUE As Byte
    BLUE_VALUE As Byte
End Type


'add MsFlexGrid to Form1, rename to "Grid1"
'change Grid1 properties as follows:
'Width = 2985
'Height = any height you want
'GridLines = 0
'GridLinesFixed = 0
'Cols = 1
'ScrollBars = 2
'BackColorBkg set to White
'BorderStyle = 0


Private Sub Form_Load()
    Grid1.Col = 0
    Grid1.Rows = 9  'only as an example....you can populate your grid (list) any way you want
    Grid1.ColWidth(0) = 3000  'experimented with ColWidth based on Width property
    Dim i As Integer
    Grid1.TextMatrix(0, 0) = "Sam Brown"
    Grid1.TextMatrix(1, 0) = "dilettante"
    Grid1.TextMatrix(2, 0) = "Schmidt"
    Grid1.TextMatrix(3, 0) = "Elroy"
    Grid1.TextMatrix(4, 0) = "DataMiser"
    Grid1.TextMatrix(5, 0) = "wqweto"
    Grid1.TextMatrix(6, 0) = "Niya"
    Grid1.TextMatrix(7, 0) = "luca90"
    Grid1.TextMatrix(8, 0) = "Shaggy Hiker"
    For i = 0 To Grid1.Rows - 1 Step 2   'every other row set to bold starting with row 0
        Grid1.Row = i
        Grid1.Col = 0
        Grid1.CellFontBold = True
    Next i


End Sub


Private Sub Grid1_Click()
    Dim i As Integer
    Dim rowNum As Integer
    rowNum = Grid1.RowSel
    For i = 0 To Grid1.Rows - 1
        Grid1.Row = i
        Grid1.CellBackColor = GetSysColor(7)
        Grid1.CellForeColor = GetSysColor(9)
    Next i
    Grid1.Row = rowNum
    Grid1.CellBackColor = GetSysColor(13)
    Grid1.CellForeColor = GetSysColor(5)
End Sub

[dilettante]

Since the "color" properties of the control are OLE_COLOR you don't have to do all of that. Just use the named constants we already have in VB6 (built in SystemColorConstants enum).

[SamOscarBrown]

example?

[The trick]

Doing them in pure VB6 requires a lot of hacking. First you have to hook control creation in order to cause a ListBox to be created with the "owner drawn" style. Then you need subclassing to capture the messages that get sent, and then do the drawing of text within the control yourself.

Don't need hook control creation because the Checkbox style already implemented using the ownerdraw technique. See the example.

[Schmidt]

And again, an example which can solve the problem without APIs, SubClassing or eternal OCX-dependencies:

The only thing needed in an empty Form-Project, is a reference to 'Microsoft HTML Object library'...

Option Explicit

Private HtmlCtl As VBControlExtender, HtmlDoc As IHTMLDocument

Private Sub Form_Load()
  Set HtmlCtl = Controls.Add("ScriptBridge.ScriptBridge.1", "HtmlCtl")
      HtmlCtl.Visible = True
      HtmlCtl.object.Scrollbar = True
      HtmlCtl.Move 0.1 * ScaleWidth, 0.1 * ScaleHeight, 0.8 * ScaleWidth, 0.8 * ScaleHeight
  
  Dim style As String
      style = "html    {overflow-x:hidden; overflow-y:scroll;}" & vbCrLf & _
              "body    {font-family:Arial; font-size:9pt; margin:0; padding:0;}" & vbCrLf & _
              "p       {padding:4px; margin:0; line-height:110%;}" & vbCrLf & _
              "p:hover {background-color:lightcyan;}" & vbCrLf & _
              "p:focus {background-color:lightblue;}"
 
  Set HtmlDoc = HtmlCtl.object
      HtmlDoc.write "<!doctype html><meta http-equiv='X-UA-Compatible' content='IE=Edge'/>" & _
                    "<script>var frm;function cb(li){frm.List_Click(li)}</script><style>" & style & "</style><body></body>"
  Set HtmlDoc.Script.frm = Me
  
  RefreshListContent Split("Item1,Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Item10,Item11", ",")
End Sub

Private Sub RefreshListContent(sArr)
  Dim i As Long, p() As String: p = sArr '<- make a copy of the incoming string-array
  For i = 0 To UBound(p)
    If i Mod 2 = 0 Then p(i) = "<b>" & p(i) & "</b>" 'wrap all even-indexed p-entries in bold-tags
    
    p(i) = "<p id='" & i + 1 & "' onfocus='cb(this)' tabindex='0'>" & p(i) & "</p>" 'finally wrap a p-tag around the p-items
  Next
  HtmlDoc.body.innerHTML = Join(p, vbLf) 'overwrite the Doc-body-content with the new joined result
End Sub

Public Sub List_Click(ByVal li As Object)
  Caption = "ID=" & li.id & ", Text=" & li.innerText
End Sub

The above example now supports also:
- hovering on List-entries
- and also clicking on List-entries (incl. coloring of the selected Item)

Additional note:
The only used interface from the MS-HTML-Typelib is: IHTMLDocument,
which is fully compatible with all lower Win-OS-versions, down to XP, which means:
- one can paste the above code into an empty Form in a VB6-IDE which runs on XP
- then compile on XP and run the little Executable on a Win10-machine
- and vice versa (compile from a VB6-IDE on Win10 + run the Executable on XP)

HTH

Olaf

[Niya]

And again, an example which can solve the problem without APIs, SubClassing or eternal OCX-dependencies:

The only thing needed in an empty Form-Project, is a reference to 'Microsoft HTML Object library'...

It doesn't work on my PC:-

[Schmidt]

The message tells you quite clearly, what to do... (in the last sentence)...

And the cause for the message was, that you checked the MS-HTML-Object-lib in over:
- the Component-Dialogue
- and not over the References-Dialogue

Olaf

[Niya]

The message tells you quite clearly, what to do... (in the last sentence)...

And the cause for the message was, that you checked the MS-HTML-Object-lib in over:
- the Component-Dialogue
- and not over the References-Dialogue

Olaf

Ah ok it works now. I didn't find it in references the first time so I assumed it must be in Components.

[SamOscarBrown]

Great work, Olaf.

But one must remember the 'experience' of the requestor. If luca90 decides to use what you posted (and it is very clever, IMO), then he'll end up with 1, several other questions about positioning and so forth, and 2, will probably not understand your code, but simply 'steal' it (copy-paste without understanding).

And I am not saying my approach was any better, by no means, but considering who asked, I offered a 'simple-to-understand' alternative to a listbox with functions as he asked. (at least I think it is simple and 'looks like' what he might have desired.)

Please don't take this wrong, Olaf...you have a great grasp of the VB language.

Sammi

[Niya]

Olaf's solution is more HTML than VB6. If luca is familiar with HTML and CSS he would be fine.

[Schmidt]

But one must remember the 'experience' of the requestor.

I don't really post my stuff "exclusively for the requestor only"
(hoping that a breeze of fresh air is recognized and appreciated by others as well).

If luca90 decides to use what you posted ...

Then you're right - he will end up with probably "other questions",
but I guess he'll ask regarding "any solution", no matter the approach
(in case it was not really Copy&Paste-friendly)...

@Niya
Yes, it requires a bit of knowledge about HTML and CSS, but in that case -
Google will be of great assistance (with tons of examples, how to achieve certain formattings).

FWIW, I've encapsulated this in a little UserControl, which now supports:
- AddItem
- Clear
Methods, so that the normal usage does not differ all that much from a normal ListBox in ones Host-Form.

It can then produce the following (formatted output)


Here the Form-Code for this UC-based approach:
(since most of the Base-HTML and CSS formatting happens in the UC, the Form-Code is
left with only a few CSS-Format-strings via an optional Param in the AddItem-method)

Option Explicit

Private Sub Form_Load()
  ucHtmlList1.InitDefaultStyle "Arial", 9
 
  ucHtmlList1.AddItem "Group 1", "grp1", "font-weight:bold; color:blue"
  AddSubItemsForGroup "grp1"
  
  ucHtmlList1.AddItem "Group 2", "grp2", "font-weight:bold; color:red"
  AddSubItemsForGroup "grp2"
  
  ucHtmlList1.AddItem "Group 3", "grp3", "font-weight:bold; color:green"
  AddSubItemsForGroup "grp3"
End Sub

Private Sub AddSubItemsForGroup(ByVal GroupId As String)
  Dim i As Long
  For i = 1 To 3
    ucHtmlList1.AddItem ChrW(8226) & " SubItem " & i, GroupId & "_" & i, "padding-left:10px"
  Next
End Sub

Private Sub ucHtmlList1_Click(ByVal ItemText As String, ByVal ItemID As String)
  Caption = ItemText & ", ID=" & ItemID
End Sub

And here the necessary Code for a Project-Private UserControl, named ucHtmlList:

Option Explicit

Event Click(ByVal ItemText As String, ByVal ItemID As String)

Private HtmlCtl As VBControlExtender, HtmlDoc As IHTMLDocument, mCount As Long, InitDone As Boolean

Private Sub UserControl_Initialize()
  Set HtmlCtl = Controls.Add("ScriptBridge.ScriptBridge.1", "HtmlCtl")
      HtmlCtl.Visible = True
      HtmlCtl.object.Scrollbar = True
  Appearance = 0: BorderStyle = 1 'set the UC to a thin (non-3D) BorderStyle
End Sub

Public Sub InitDefaultStyle(FontName, Optional FontSize = 9, Optional SelectColor = &HFFDDD0, Optional HoverColor = &HFFEEE0)
  Dim Style As String
      Style = "html    {overflow-x:hidden; overflow-y:scroll;}" & vbCrLf & _
              "body    {font-family:" & FontName & "; font-size:" & FontSize & "pt; margin:0; padding:0;}" & vbCrLf & _
              "p       {padding:4px; margin:0; line-height:110%; width:300%}" & vbCrLf & _
              "p:hover {background-color:" & ToHTMLColorString(HoverColor) & ";}" & vbCrLf & _
              "p:focus {background-color:" & ToHTMLColorString(SelectColor) & ";}"
  
  Set HtmlDoc = HtmlCtl.object
      HtmlDoc.write "<!doctype html><meta http-equiv='X-UA-Compatible' content='IE=Edge'/>" & _
                    "<script>var ctl; function cb(p){ctl.List_Click(p)}</script>" & _
                    "<style>" & Style & "</style><body></body>"
  Set HtmlDoc.Script.ctl = Me
  InitDone = True
End Sub

Private Function ToHTMLColorString(ByVal Color) As String
  If VarType(Color) = vbString Then
     ToHTMLColorString = Color
  Else
     Color = Right("00000" & Hex(Color), 6)
     ToHTMLColorString = "#" & Mid(Color, 5, 2) & Mid(Color, 3, 2) & Left(Color, 2)
  End If
End Function

Private Sub UserControl_Resize()
  HtmlCtl.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Public Property Get Count() As Long
  Count = mCount
End Property

Public Sub AddItem(ByVal ItemText As String, Optional ByVal ItemID As String, Optional ByVal Style As String)
  If InitDone Then mCount = mCount + 1 Else Exit Sub
  If Len(Style) Then Style = "style='" & Style & "' "
  If Len(ItemID) = 0 Then ItemID = mCount
  HtmlDoc.Body.insertAdjacentHTML "beforeend", "<p " & Style & "id='" & ItemID & "' onfocus='cb(this)' tabindex='0'>" & ItemText & "</p>"
End Sub

Public Sub Clear()
  If InitDone Then HtmlDoc.Body.innerHTML = "": mCount = 0
End Sub

Public Sub List_Click(ByVal p As Object) 'our callback (addressed from within the Scriptlet)
  RaiseEvent Click(p.innerText, p.ID)    'just delegate the incoming info to the outside
End Sub

Private Sub UserControl_Show()
  If InitDone Then Set HtmlDoc.Script.ctl = Me      'to avoid cycle-references
End Sub
Private Sub UserControl_Hide()
  If InitDone Then Set HtmlDoc.Script.ctl = Nothing 'to avoid cycle-references
End Sub

HTH

Olaf

[ChrisE]

I don't where the Data comes from, but if it comes from a DB and the tables are properly setup
I would use a Flexgrid and use the Merge

here a Pic of the result after loading the Categories > Products



I'm reluctant to post Code, because Luca always want's finished code

EDIT:
well I will post the Query

sSQL = "SELECT Products.ProductID, Products.ProductName, Categories.CategoryName " & _
"FROM Categories LEFT JOIN Products ON Categories.CategoryID = Products.CategoryID"

[dday9]

@Schmidt - If you're going to recommend something that leverages HTML, I'd suggest using the right DOM rather than using paragraph tags. For example:

<select multiple>
  <optgroup label="Group 1">
    <option>SubItem 1</option>
    <option>SubItem 2</option>
    <option>SubItem 3</option>
  </optgroup>
  <optgroup label="Group 2">
    <option>SubItem 4</option>
    <option>SubItem 5</option>
    <option>SubItem 6</option>
  </optgroup>
  <optgroup label="Group 3">
    <option>SubItem 7</option>
    <option>SubItem 8</option>
    <option>SubItem 9</option>
  </optgroup>
</select>

With optional styling:

select { height: 100vh; width: 100vw; }
select option:before { content: '\2022'; padding-right: 0.25rem; }
select option { color: black; }
select option:hover { background-color: rgba(0, 0, 0, 0.35); }
select optgroup:nth-child(1) { color: blue; }
select optgroup:nth-child(2) { color: red; }
select optgroup:nth-child(3) { color: green; }

Fiddle: https://jsfiddle.net/2dguj0aL/

[Schmidt]

If you're going to recommend something that leverages HTML,
I'd suggest using the right DOM rather than using paragraph tags.

In this case here, there's no need to follow "DOM-rules" strictly -
since we don't have a "normal WebPage, which renders a list as part of a whole document".

What we have instead is the (quite old, but sufficient) Trident-Engine of the IE-libs,
which can use "the document" exclusively for a single purpose only:
- Rendering a List

For example:

<select multiple>
  <optgroup label="Group 1">
    <option>SubItem 1</option>
    <option>SubItem 2</option>
    <option>SubItem 3</option>
  </optgroup>
  ...
</select>

Nope, that would not fly, when you want to support Click-Events also on the Group-Items,
or when you want to specify your own Selection-Color.

Olaf

[SamOscarBrown]

luca....

You marked this as Resolved..what did you finally end up with in your code? (one of the several options above?)

[dday9]

In this case here, there's no need to follow "DOM-rules" strictly

Olaf

I guess that’s sort of the modus operandi of a VB6 developer.

[Schmidt]

I guess that’s sort of the modus operandi of a VB6 developer.

Well, that's one way to put it ... though here I'm wondering:

"When an explanation flies right over the head of a .NET-dev, does it make a sound?"

Olaf

[Niya]

Well, that's one way to put it ... though here I'm wondering:

"When an explanation flies right over the head of a .NET-dev, does it make a sound?"

Olaf

I think what dday was implying by his comment is that VB6 developers play it more "fast and loose". Those of us who have been in .Net for years aren't really used to such thinking anymore. We more or less do things the "recommended" way most of the time. We are a very "by the book" bunch.

[CreativeDreamer]

I realize that this has been resolved but I came across an activeX that does Bold, Different Colours and even Option buttons and Checkboxes which may come in handy for someone else who may need these features.




ultrbox2.zip