|
Selbst der routinierteste Anwender mit einem (foto)grafischen Gedächtnis wird kaum zu allen Fonts eine optische Vorstellung beim Lesen eines Font-Namens haben, der durchschnittliche Anwender noch viel weniger. Eine ComboBox zur Auswahl eines Fonts, die die tatsächlichen Schriftbilder darstellt, ist in vielen Textverarbeitungs- und Grafik-Programmen üblich. Auch Sie können den Anwendern Ihrer Programme diesen Komfort bieten.
Das passende Basis-Steuerelement steht in Visual Basic 6 in den Microsoft Common Controls 6 zur Verfügung: das ImageCombo-Steuerelement. Sie können es statt nur mit den Namen der Fonts in einheitlicher Schrift mit Abbildungen des Font-Namens in der jeweiligen Schrift füllen, die Sie zuvor in einheitlichen Abmessungen in ein ImageList-Steuerelement eingefügt haben.
Die Namen der aktuell installierten und verfügbaren Fonts liefert zunächst wie gewohnt die Fonts-Collection des Screen-Objekts - allerdings leider nicht in alphabetischer Reihenfolge. Lesen Sie die Font-Namen zunächst in eine simple und unsichtbar bleibende ListBox ein, deren Sorted-Eigenschaft auf True gesetzt ist - bequemer lässt sich in VB kaum sortieren. Dann bringen Sie eine (ebenfalls unsichtbar bleibende) PictureBox, deren AutoRedraw-Eigenschaft auf True gesetzt ist, auf die Höhe einer Textzeile in der Schriftgröße, in der die Font-Namen in der ImageCombo abgebildet werden sollen.
Nun wird die sortierte Liste der Font-Namen durchlaufen: Der jeweilige Font-Name wird dem Font-Objekt der PictureBox zugewiesen. Damit nicht irgendwelche undurchschaubare Anpassungen im Hintergrund die Schriftgröße und den Schriftgrad (Bold, Italic) zufällig verändern, werden diese jedes Mal nach der Namenszuweisung zurückgesetzt (Size auf die gewünschte Schriftgröße und Bold als auch Italic auf False). Das so erstellte Abbild eines jeden Font-Namens wird schließlich mit dem Font-Namen als Schlüssel in das ImageList-Steuerelement aufgenommen. Ebenfalls mit dem Font-Namen als Schlüssel und als Bildverweis wird der ComboItems-Collection der ImageCombo ein Element hinzugefügt.
Praktischerweise sollten Sie die beteiligten Steuerelemente in einem UserControl zusammenfassen. Bei diesem können Sie die Angabe der gewünschten Schriftgröße und die Voreinstellung eines Font-Namens zur Design-Zeit bzw. die Auswahl zur Laufzeit über Eigenschaften einrichten. Zur Design-Zeit kann der Font-Name im Eigenschaftenfenster manuell eingetippt oder über die Eigenschaftenseite ppgFontName ausgewählt werden. Der gewählte Font-Name wird zur Design-Zeit als einfacher Text in der ImageCombo angezeigt. Zusätzlich zu der Liste der Font-Namen gibt es in der Liste auf der Eigenschaftenseite den Eintrag "*** Ambient-Font ***", bei dessen Auswahl ein leerer String zurückgegeben wird. Ein leerer String wird bei der Zuweisung als Anforderung des Ambient-Fonts (Font des Containers, auf dem das UserControl platziert ist) interpretiert. Ähnliches gilt für die Zuweisung der Schriftgröße: Hier wird ein Wert kleiner oder gleich 0 als Anforderung der Schriftgröße des Ambient-Fonts interpretiert.
Zur Laufzeit sorgt ein Aufruf der Methode Refresh für ein erneutes Einlesen der Font-Liste und Font-Abbildungen - etwa wenn sich die Font-Liste geändert haben könnte. Die Änderung der Auswahl eines Font-Namens über das Ereignis Changed mitgeteilt, wobei der neue Font-Name als Parameter übergeben wird.
Der Code im UserControl FontImageCombo:
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_SETREDRAW = &HB
Private mFirst As Boolean
Private mLocked As Boolean
Private Const mArial = "Arial"
Private Const mDefault = "default"
Public Event Changed(FontName As String)
Private pEnabled As Boolean
Private pFontName As String
Private pFontSize As Single
Public Property Get Enabled() As Boolean
Enabled = pEnabled
End Property
Public Property Let Enabled(New_Enabled As Boolean)
pEnabled = New_Enabled
If Not mLocked Then
UserControl.Enabled = pEnabled
If Ambient.UserMode Then
ic.Enabled = pEnabled
End If
End If
PropertyChanged "Enabled"
End Property
Public Property Get FontName() As String
FontName = pFontName
End Property
Public Property Let FontName(New_FontName As String)
If mLocked Then
' Err.Raise
Exit Property
End If
With UserControl.Font
Select Case Trim$(New_FontName)
Case .Name
Exit Property
Case ""
.Name = Ambient.Font.Name
Case Else
.Name = New_FontName
End Select
pFontName = .Name
End With
If Not Ambient.UserMode Then
Me.Refresh
End If
PropertyChanged "FontName"
End Property
Public Property Get FontSize() As Single
FontSize = pFontSize
End Property
Public Property Let FontSize(New_FontSize As Single)
If mLocked Then
' Err.Raise
Exit Property
End If
With UserControl.Font
Select Case New_FontSize
Case .Size
Exit Property
Case Is <= 0
.Size = Ambient.Font.Size
Case Else
.Size = New_FontSize
End Select
pFontSize = CInt(.Size)
End With
Me.Refresh
PropertyChanged "FontSize"
End Property
Public Sub Refresh()
Dim nFont As String
Dim i As Integer
Dim nListImages As ListImages
Dim nComboItems As ComboItems
Dim nSelKey As String
If mLocked Then
' Err.Raise 288
Exit Sub
Else
mLocked = True
End If
If Ambient.UserMode Then
UserControl.Enabled = False
With ic
.Enabled = False
Set nListImages = il.ListImages
nListImages.Clear
.Refresh
If .SelectedItem Is Nothing Then
nSelKey = pFontName
Else
nSelKey = .SelectedItem.Key
End If
Set nComboItems = .ComboItems
nComboItems.Clear
.Font.Size = pFontSize
UserControl_Resize
UserControl.Refresh
.Refresh
DoEvents
SendMessage UserControl.hwnd, WM_SETREDRAW, 0, 0
With lstFonts
.Clear
For i = 0 To Screen.FontCount - 1
.AddItem Screen.Fonts(i)
Next 'i
End With
With picPaint
With .Font
.Name = mArial
.Size = pFontSize
End With
.Height = .TextHeight("A")
.Width = 3 * UserControl.ScaleWidth
il.ImageHeight = .Height \ Screen.TwipsPerPixelY
il.ImageWidth = .Width \ Screen.TwipsPerPixelX
For i = 0 To lstFonts.ListCount - 1
If i Mod 5 = 0 Then
DoEvents
End If
nFont = lstFonts.List(i)
With .Font
.Name = nFont
.Bold = False
.Italic = False
.Size = pFontSize
End With
.Cls
picPaint.Print nFont
nListImages.Add , nFont, .Image
nComboItems.Add , nFont, , nFont
Next 'i
End With
On Error Resume Next
nComboItems(nSelKey).Selected = True
If Err.Number = 0 Then
zSelectFont
End If
.Enabled = pEnabled
With UserControl
.Enabled = pEnabled
SendMessage .hwnd, WM_SETREDRAW, 1, 0
.Refresh
End With
.Refresh
End With
Else
With ic
Set .ImageList = Nothing
.Font.Size = pFontSize
With picPaint
With .Font
.Name = mArial
.Size = pFontSize
End With
.Height = .TextHeight("A")
.Width = 3 * UserControl.ScaleWidth
.Cls
With .Font
.Name = Ambient.Font.Name
.Size = Ambient.Font.Size
End With
picPaint.Print pFontName
il.ListImages.Clear
il.ImageHeight = .Height \ Screen.TwipsPerPixelY
il.ImageWidth = .Width \ Screen.TwipsPerPixelX
il.ListImages.Add , mDefault, .Image
End With
Set .ImageList = il
With .ComboItems
.Clear
.Add(, mDefault, , mDefault).Selected = True
End With
End With
End If
UserControl_Resize
mLocked = False
End Sub
Private Sub ic_Click()
zSelectFont
End Sub
Private Sub ic_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyHome
ic.ComboItems(1).Selected = True
zSelectFont
KeyCode = 0
Case vbKeyEnd
With ic.ComboItems
.Item(.Count).Selected = True
End With
zSelectFont
KeyCode = 0
End Select
End Sub
Private Sub UserControl_Initialize()
mFirst = True
End Sub
Private Sub UserControl_InitProperties()
With Ambient.Font
pFontName = .Name
pFontSize = .Size
End With
End Sub
Private Sub UserControl_Resize()
Static sInProc As Boolean
If sInProc Then
Exit Sub
Else
sInProc = True
End If
On Error Resume Next
With UserControl
.Height = ic.Height
ic.Move 0, 0, .ScaleWidth
End With
sInProc = False
End Sub
Private Sub UserControl_Show()
If mFirst Then
mFirst = False
Me.Refresh
End If
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Me.Enabled = PropBag.ReadProperty("Enabled", True)
With Ambient.Font
pFontName = PropBag.ReadProperty("FontName", .Name)
pFontSize = PropBag.ReadProperty("FontSize", CInt(.Size))
End With
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Enabled", UserControl.Enabled
With Ambient.Font
PropBag.WriteProperty "FontName", pFontName, .Name
PropBag.WriteProperty "FontSize", pFontSize, CInt(.Size)
End With
End Sub
Private Sub zSelectFont()
With ic
pFontName = .SelectedItem.Key
.ToolTipText = " " & pFontName & " - " & pFontSize & "pt. "
End With
RaiseEvent Changed(pFontName)
End Sub
Der Code der Eigenschaftenseite ppgFontName:
Private Declare Function SendMessageStr Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long
Private Const kAmbient = "*** Ambient-Font ***"
Private Sub lstFonts_Click()
With lstFonts
If .ListIndex <> CLng(.Tag) Then
Changed = True
End If
If .Text = kAmbient Then
With txt
.Text = ""
.Enabled = False
End With
Else
txt.Text = .Text
txt.Font.Name = .Text
With txt
.Enabled = True
With .Font
.Size = 10
.Bold = False
.Italic = False
End With
End With
End If
End With
End Sub
Private Sub PropertyPage_ApplyChanges()
With lstFonts
If .Text = kAmbient Then
SelectedControls(0).FontName = ""
Else
SelectedControls(0).FontName = .Text
End If
End With
End Sub
Private Sub PropertyPage_Initialize()
Dim i As Integer
With lstFonts
.AddItem kAmbient
For i = 0 To Screen.FontCount - 1
.AddItem Screen.Fonts(i)
Next 'i
.Tag = -1
End With
End Sub
Private Sub PropertyPage_SelectionChanged()
Const LB_FINDSTRINGEXACT = &H1A2
With lstFonts
.ListIndex = SendMessageStr(.hwnd, LB_FINDSTRINGEXACT, _
0, SelectedControls(0).FontName)
.Tag = .ListIndex
End With
Changed = False
End Sub
Private Sub txt_GotFocus()
With txt
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
|