Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Load system fonts in combo
Message
De
10/06/2003 16:49:25
 
 
À
Tous
Information générale
Forum:
ASP.NET
Catégorie:
Autre
Titre:
Load system fonts in combo
Divers
Thread ID:
00798630
Message ID:
00798630
Vues:
64
Hello everyone, I am trying to create a toolbar for my richtextbox control. I was looking for a way to populate my dropdownlist with the system fonts. Below is one method I have found, but I am having a little trouble converting it to VB.NET. I need help converting the parameter Any, passing the parameter AddressOf EnumFontFamProc, converting lfFaceName(LF_FACESIZE) As Byte, and vbUnicode. Any suggestions or should I be using something else. Thanks for the help.
Option Explicit

'Font enumeration types
Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64

Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte

  lfFaceName(LF_FACESIZE) As Byte
End Type

Type NEWTEXTMETRIC
  tmHeight As Long
  tmAscent As Long
  tmDescent As Long
  tmInternalLeading As Long
  tmExternalLeading As Long
  tmAveCharWidth As Long
  tmMaxCharWidth As Long
  tmWeight As Long
  tmOverhang As Long
  tmDigitizedAspectX As Long
  tmDigitizedAspectY As Long
  tmFirstChar As Byte
  tmLastChar As Byte
  tmDefaultChar As Byte

  tmBreakChar As Byte
  tmItalic As Byte
  tmUnderlined As Byte
  tmStruckOut As Byte
  tmPitchAndFamily As Byte
  tmCharSet As Byte
  ntmFlags As Long
  ntmSizeEM As Long
  ntmCellHeight As Long
  ntmAveWidth As Long
End Type

' ntmFlags field flags
Public Const NTM_REGULAR = &H40&
Public Const NTM_BOLD = &H20&
Public Const NTM_ITALIC = &H1&

' tmPitchAndFamily flags
Public Const TMPF_FIXED_PITCH = &H1

Public Const TMPF_VECTOR = &H2
Public Const TMPF_DEVICE = &H8
Public Const TMPF_TRUETYPE = &H4

Public Const ELF_VERSION = 0
Public Const ELF_CULTURE_LATIN = 0

' EnumFonts Masks
Public Const RASTER_FONTTYPE = &H1
Public Const DEVICE_FONTTYPE = &H2
Public Const TRUETYPE_FONTTYPE = &H4

Declare Function EnumFontFamilies Lib "gdi32" Alias _
   "EnumFontFamiliesA" _
   (ByVal hDC As Long, ByVal lpszFamily As String, _
   ByVal lpEnumFontFamProc As Long, LParam As Any) As Long Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
   ByVal hDC As Long) As Long

Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, _
   ByVal FontType As Long, LParam As ListBox) As Long
Dim FaceName As String
Dim FullName As String
  FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
  LParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
  EnumFontFamProc = 1

End Function

Sub FillComboWithFonts(CB As ComboBox)
Dim hDC As Long
  CB.Clear
  hDC = GetDC(CB.hWnd)
  EnumFontFamilies hDC, vbNullString, AddressOf EnumFontFamProc, CB
  ReleaseDC CB.hWnd, hDC
End Sub
Randy Belcher
AFG Industries, Inc.
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform