ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 09.01.2002

Diese Seite wurde zuletzt aktualisiert am 09.01.2002
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

Font-Wahl per Augenschein

Zurück...

(-hg) mailto:hg_fontsimagecombo@aboutvb.de

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.


Eine ComboBox mit grafischer Darstellung der Font-Namen

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.


Bequeme Auswahl der Voreinstellung eines Font-Namens über eine Eigenschaftenseite

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

Das Projekt avbFontsImageCombo (fontsimagecombo.zip - ca. 9,4 KB)



Komponenten-Übersicht

Schnellsuche




Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer