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
Related articles
Related discussion
-
Run-time error '91'
by crazyidane (0 replies)
-
Problem handling Redirects with MSXML2.XMLHTTP
by brandoncampbell (2 replies)
-
vbinputbox pauses code while it waits on response. How can I reproduce that?
by brandoncampbell (1 replies)
-
Sending SMS in VB 6
by sirobnole (6 replies)
-
Comboxbox listindex in ActiveX Control
by brandoncampbell (1 replies)
This thread is for discussions of Insert Symbols Dialog.