Library code snippets

Insert Symbols Dialog

Many applications provide an Insert symbols dialog box.... This example shows you how to create one in VB

First, add a label called lblMsg, and a picture box that fills the rest of the form called picContainer. Now, add a VerticalScrollBar called VScroll1 that goes up along the right hand side of picContainer. Next, add Label within picContainer, called lblSymbols and set its Index to 0. Finally add another label within picContainer and calll it lblBigDisplay. Then, add the code below to your form.

Option Explicit
Private nCurrentLabel As Integer
Private nNumPerLine As Integer
Private nLinesOut As Integer
Private bIgnore As Boolean
Private nMinusChars As Integer
Private sFont As String
Private Const BorderWidth As Integer = 100
Private Const SepWidth As Integer = 20
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyUp
        If Shift = 0 Then
            picContainer_KeyDown KeyCode, Shift
        End If
        KeyCode = 0
    End Select
End Sub

Private Sub Form_Load()
    ' Set the current font
    sFont = "Courier New"
    lblMsg = "Symbols contained in " & sFont
    ' set the big display to the same font
   
    nNumPerLine = 0
    ' set font and size
    With lblBigDisplay
        .Font = sFont
        .FontSize = 14
        .BackColor = &HFF0000
        .Width = 552
        .Height = 600
    End With
    With lblSymbols(0)
        .Font = sFont
        .Width = 435
        .Height = 375
    End If
    FillSymbols (0)
    bIgnore = True
    VScroll1.Max = nLinesOut
    VScroll1.Min = 0
    bIgnore = False
    ' Set the currently selected label to 0
    nCurrentLabel = 0
End Sub

' Fills the symbols
Sub FillSymbols(ByVal startnumber As Integer)
    Dim lNumOfLines As Long
    Dim i As Integer
    Dim lCurrentChar As Long
    Dim lNewLeftPos As Long
    Dim lNewTop As Long
    bIgnore = False
    ' use minus chars to take away left co-or
    nMinusChars = 1
    ' number of lines
    lNumOfLines = 1
    ' hide the first symbol
    lblSymbols(0).Left = -5000
    ' number of lines off screen
    nLinesOut = 0
    ' number of symbols per line
    'nNumPerLine = 0
    ' Hide the picture box
    picContainer.Visible = False
    For i = 1 To 223
        ' Load the new symbol label
        'On Error Resume Next
        Load lblSymbols(i)
        On Error GoTo 0
        ' change the current char - miss out
        ' the first 32 chars
        lCurrentChar = i + startnumber + 32
        If lCurrentChar > 255 Then Exit For
        ' Set caption to char
        lblSymbols(i).Caption = Chr(lCurrentChar)
        ' New left position
        ' (i - 1) [to allow left to start at 0
        ' - nMinusChars [to take away the previous
        ' symbols from prev. lines
        ' * (lblSymbols(i).Width - 12)
        ' [To move number from left plus
        ' line width
        'MsgBox ((i) - nMinusChars) * (lblSymbols(i).Width)
        lNewLeftPos = BorderWidth + ((i) - nMinusChars) * (lblSymbols(i).Width - SepWidth)
        ' If the new left pos is bigger than
        ' the container width - new symbol
        ' then start a new line
        If lNewLeftPos > picContainer.Width - lblSymbols(i).Width Then
            ' Add the number of current symbols
            ' minus the one just created
            nMinusChars = lblSymbols.Count - 1
            ' Set the number per line (excluding
            ' current symbol, if it is not set
            ' -1 for currentsymbol
            ' -1 for first label which is not shown
            If nNumPerLine = 0 Then nNumPerLine = lblSymbols.Count - 2
            ' increment the number of lines
            lNumOfLines = lNumOfLines + 1
            ' new top position (new line)
            ' lines - 1 [allow for top =0
            ' (lblSymbols(i).Height - 12)
            ' [number of lines - thick line
            lNewTop = (lNumOfLines) * (lblSymbols(i).Height - SepWidth)
            ' If the new top pos is greater than
            ' picContainer bottom line then increment
            ' lines out of screen
            If lNewTop + lblSymbols(i).Height > picContainer.Height Then
                nLinesOut = nLinesOut + 1
            End If
            ' Set the new left to include the new
            ' minuschar value
            'lNewLeftPos = ((i) - nMinusChars) * (lblSymbols(i).Width - 12)
            'MsgBox 1 * lblSymbols(i).Width
            lNewLeftPos = BorderWidth + (i - nMinusChars) * (lblSymbols(i).Width - SepWidth)
        End If
        ' Refresh pic1
        'picContainer.Refresh
        ' set top pos of symbol
        lblSymbols(i).Top = (lNumOfLines - 0.7) * (lblSymbols(i).Height - SepWidth)
        ' set new left
        lblSymbols(i).Left = lNewLeftPos
        ' make is visible
        lblSymbols(i).Visible = True
    Next
    ' Show the picture again
    picContainer.Visible = True
End Sub
' Update the currently selected symbol
Private Sub lblSymbols_Click(Index As Integer)
    On Error GoTo errhandler
    lblBigDisplay.Left = lblSymbols(Index).Left - ((lblBigDisplay.Width - lblSymbols(Index).Width) / 2)
    lblBigDisplay.Top = lblSymbols(Index).Top - ((lblBigDisplay.Height - lblSymbols(Index).Height) / 2)
    lblBigDisplay.Caption = lblSymbols(Index).Caption
    lblBigDisplay.Visible = True
    nCurrentLabel = Index
   ' Label1.Caption = "Special Char " & Asc(lblSymbols(Index).Caption)
    Exit Sub
errhandler:
    Exit Sub
End Sub

' change selection using arrow keys
'
Private Sub picContainer_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not Shift = 0 Then Exit Sub
    If KeyCode = vbKeyLeft And Not nCurrentLabel = 1 Then
        lblSymbols_Click (nCurrentLabel - 1)
    ElseIf KeyCode = vbKeyRight And Not nCurrentLabel = lblSymbols.Count - 1 Then
        lblSymbols_Click (nCurrentLabel + 1)
    ElseIf KeyCode = vbKeyUp And nCurrentLabel > nNumPerLine Then
        lblSymbols_Click (nCurrentLabel - nNumPerLine)
    ElseIf KeyCode = vbKeyDown And nCurrentLabel < lblSymbols.Count - 2 + nNumPerLine Then
        lblSymbols_Click (nCurrentLabel + nNumPerLine)
    End If
End Sub

' This code moves up or down the display
'
'
Private Sub VScroll1_Change()
    Dim lblLabel As Label
    Dim lCharStart As Long
    If Not bIgnore Then
        MousePointer = vbHourglass
        For Each lblLabel In lblSymbols
            If Not lblLabel.Index = 0 Then
                Unload lblLabel
            End If
        Next
        lCharStart = VScroll1.Value * nNumPerLine
        FillSymbols (lCharStart)
        MousePointer = vbDefault
    End If
    picContainer.SetFocus
End Sub

Private Sub VScroll1_GotFocus()
    picContainer.SetFocus
End Sub

Comments

  1. 01 Jan 1999 at 00:00

    This thread is for discussions of Insert Symbols Dialog.

Leave a comment

Sign in or Join us (it's free).

James Crowley James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audience ...
AddThis

Related discussion

Related podcasts

  • Christian Beauclair

    14 mai 2008 (�mission #0074) ::.Christian Beauclair: Stratégies de migration VB6 vers .NET Nous discutons avec Christian Beauclair des stratégies de migration VB6 vers .NET. Entre autres, nous discutons comment utiliser le "VB 6 Code Advisor" et le "Interop Forms Toolkit" pour ajouter la puiss...

Want to stay in touch with what's going on? Follow us on twitter!