Installierte Schriftarten in Kombinationsfeld laden (Access 2003)

  • Access

Es gibt 18 Antworten in diesem Thema. Der letzte Beitrag () ist von vba_newsbie.

    Installierte Schriftarten in Kombinationsfeld laden (Access 2003)

    so habe ich es versucht:

    Quellcode

    1. Option Compare Database
    2. Option Explicit
    4. Declare Function wlib_GetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long
    5. Declare Function wlib_GetFontCount Lib "msaccess.exe" Alias "#61" (ByVal hdc As Long) As Long
    6. Declare Function wlib_GetFontList Lib "msaccess.exe" Alias "#62" (ByVal hdc As Long, fiFonts() As wlib_FONTINFO) As Long
    7. Declare Function wlib_ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hdc As Long) As Long
    8. Declare Function wlib_GetSizeCount Lib "msaccess.exe" Alias "#63" (ByVal hdc As Long, ByVal szFont As String) As Long
    9. Declare Function wlib_GetSizeList Lib "msaccess.exe" Alias "#64" (ByVal hdc As Long, ByVal szFont As String, lSizeList() As Long) As Long
    10. Declare Sub wlib_AccChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hWnd As Long, rgb As Long)
    11. Declare Function wlib_FTwipsFromFont Lib "msaccess.exe" Alias "#67" (ByVal stFontName As String, ByVal iSize As Long, ByVal iWeight As Long, ByVal fItalic As Long, ByVal fUnderline As Long, ByVal cch As Long, ByVal stCaption As String, ByVal cchUseMaxWidth As Long, dx As Long, dy As Long) As Integer
    12. Declare Function wlib_GetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    13. Declare Function wlib_GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    15. Dim rgfiFonts() As wlib_FONTINFO
    16. Global wlib_rgaii() As WLIB_ADDININFO
    17. Global mlbl_mlbi As MLBL_INFO
    18. Global wlib_caii As Integer
    20. Type WLIB_POINT
    21. x As Long
    22. Y As Long
    23. End Type
    25. Type MLBL_INFO
    26. StRptName As String
    27. fBrowse As Integer
    28. iLabelId As Integer
    29. fUserSizes As Integer
    30. fMetric As Integer
    31. fDotMatrix As Integer
    32. fPortrait As Integer
    33. cItemsAcross As Integer
    34. stFontName As String
    35. iFontSize As Integer
    36. iFontWeight As Integer
    37. lFontColor As Long
    38. fItalic As Integer
    39. fUnderline As Integer
    40. dytextbox As Integer
    41. dxGrid As Integer
    42. dyGrid As Integer
    43. fUsrPrefsChng As Integer
    44. fOpenGroupBox As Integer
    45. ptLabelSize As WLIB_POINT
    46. dxdySpace As WLIB_POINT
    47. xLeftMargin As Integer
    48. xRightMargin As Integer
    49. yTopMargin As Integer
    50. ptOrigin As WLIB_POINT
    51. End Type
    53. Type STYL_CONTROLSIZINGINFO
    54. stFontName As String
    55. iFontSize As Integer
    56. iFontWeight As Integer
    57. fFontItalic As Integer
    58. fFontUnderline As Integer
    59. stCaption As String
    60. cch As Integer
    61. iBorderStyle As Integer
    62. iBorderWidth As Integer
    63. iSpecialEffect As Integer
    64. cchUseMaxWidth As Integer
    65. dxLine As Long
    66. dyLine As Long
    67. dxBorder As Long
    68. dyBorder As Long
    69. End Type
    71. Type WLIB_ADDININFO
    72. stName As String
    73. rsStrings As Recordset
    74. stStringsField As String
    75. End Type
    77. Type wlib_FONTINFO
    78. fRasterFont As Long
    79. rgstName As String * 32
    80. End Type
    82. Global styl_xPixelPerInch As Integer
    83. Global styl_yPixelPerInch As Integer
    84. Global styl_xTwipsPerPixel As Integer
    85. Global styl_yTwipsPerPixel As Integer
    88. Sub wlib_SmartCtlPropSet(ByRef ctl As Control, stProp As String, vVal As Variant)
    89. ' Setze im Control (z.B. Feld) "Ctl" das Property "stProp" auf den Wert "vVal"
    90. ' z.B: Setze im Feld "Me!bxcolor" das Property "Backcolor" auf den entsprechenden Wert
    91. If (ctl.Properties(stProp) <> vVal) Then ctl.Properties(stProp) = vVal
    92. End Sub
    95. Function wlib_StFromSz(szTmp As String) As String
    96. Dim ich As Integer
    97. ich = InStr(1, szTmp, vbNullChar, vbBinaryCompare)
    98. If ich Then
    99. wlib_StFromSz = Left$(szTmp, ich - 1)
    100. Else
    101. wlib_StFromSz = szTmp
    102. End If
    103. End Function
    106. Function wlib_StFromAccessIds(ID As Long) As String
    107. On Error GoTo wlib_StFromAccessIds_Err
    108. wlib_StFromAccessIds = Application.AppLoadString(ID)
    109. wlib_StFromAccessIds_Exit:
    110. Exit Function
    111. wlib_StFromAccessIds_Err:
    112. wlib_StFromAccessIds = ""
    113. Resume wlib_StFromAccessIds_Exit
    114. End Function
    116. Public Function SchriftBestimmen(Optional I As Integer = 1) As String
    117. On Error GoTo Err_Click
    119. 'Dim FeldBEZ
    120. 'FeldBEZ = "VBFT" & CStr(I)
    122. 'If Not Nz(dlookup(FeldBEZ, "VB-Firma"), "") = "" Then
    123. ' SchriftBestimmen = dlookup(FeldBEZ, "VB-Firma")
    124. 'Else
    125. SchriftBestimmen = "Arial,10,Falsch,Falsch"
    126. 'End If
    128. Exit_Click:
    129. Exit Function
    130. Err_Click:
    131. msgbox Err.Description
    132. Resume Exit_Click
    133. End Function
    137. Public Function SchriftZuweisen()
    138. Dim Steuerelement As Control
    139. On Error GoTo Err_Click
    140. Dim Schriftart As String, Schriftgr, Schriftfett, Schriftkursiv
    141. Dim SchriftInfo As String
    142. Dim I%, i1%, i2%, i3%, Zaehler%, z$
    143. msgbox "TEst"
    144. SchriftInfo = SchriftBestimmen(1)
    146. For I = 1 To Len(SchriftInfo)
    147. z = Mid$(SchriftInfo, I, 1)
    148. If z = "," Then
    149. Zaehler = Zaehler + 1
    150. If Zaehler = 1 Then
    151. i1 = I
    152. End If
    153. If Zaehler = 2 Then
    154. i2 = I
    155. End If
    156. If Zaehler = 3 Then
    157. i3 = I
    158. End If
    159. End If
    160. Next I
    162. Schriftkursiv = Mid$(SchriftInfo, i3 + 1, Len(SchriftInfo))
    163. Schriftfett = Mid$(SchriftInfo, i2 + 1, i3 - i2 - 1)
    164. Schriftgr = Mid$(SchriftInfo, i1 + 1, i2 - i1 - 1)
    165. Schriftart = Mid$(SchriftInfo, 1, i1 - 1)
    167. With Steuerelement
    168. .FontName = Schriftart
    169. .FontSize = Schriftgr
    170. .FontBold = Schriftfett
    171. .FontItalic = Schriftkursiv
    172. End With
    174. Exit_Click:
    175. Exit Function
    176. Err_Click:
    177. msgbox Err.Description
    178. Resume Exit_Click
    179. End Function
    181. Public Function Schriftart1() As String
    182. Schriftart1 = SchriftAnalyse(1, "Art")
    183. End Function
    184. Public Function Schriftart2() As String
    185. Schriftart2 = SchriftAnalyse(2, "Art")
    186. End Function
    187. Public Function Schriftart3() As String
    188. Schriftart3 = SchriftAnalyse(3, "Art")
    189. End Function
    190. Public Function Schriftkursiv1() As Boolean
    191. Schriftkursiv1 = SchriftAnalyse(1, "kursiv")
    192. End Function
    193. Public Function Schriftkursiv2() As Boolean
    194. Schriftkursiv2 = SchriftAnalyse(2, "kursiv")
    195. End Function
    196. Public Function Schriftkursiv3() As Boolean
    197. Schriftkursiv3 = SchriftAnalyse(3, "kursiv")
    198. End Function
    199. Public Function Schriftfett1() As Boolean
    200. Schriftfett1 = SchriftAnalyse(1, "fett")
    201. End Function
    202. Public Function Schriftfett2() As Boolean
    203. Schriftfett2 = SchriftAnalyse(2, "fett")
    204. End Function
    205. Public Function Schriftfett3() As Boolean
    206. Schriftfett3 = SchriftAnalyse(3, "fett")
    207. End Function
    208. Public Function SchriftGroesse1() As Integer
    209. SchriftGroesse1 = SchriftAnalyse(1, "Größe")
    210. End Function
    211. Public Function SchriftGroesse2() As Integer
    212. SchriftGroesse2 = SchriftAnalyse(2, "Größe")
    213. End Function
    214. Public Function SchriftGroesse3() As Integer
    215. SchriftGroesse3 = SchriftAnalyse(3, "Größe")
    216. End Function
    218. Public Function SchriftAnalyse(SchriftNr As Integer, Info As String)
    219. 'Dim Schriftart As String, Schriftgr As Integer, Schriftfett As Boolean, Schriftkursiv As Boolean
    220. On Error GoTo Fehler
    221. Dim SchriftInfo As String
    222. Dim I%, i1%, i2%, i3%, Zaehler%, z$
    224. SchriftInfo = SchriftBestimmen(SchriftNr)
    226. For I = 1 To Len(SchriftInfo)
    227. z = Mid$(SchriftInfo, I, 1)
    228. If z = "," Then
    229. Zaehler = Zaehler + 1
    230. If Zaehler = 1 Then
    231. i1 = I
    232. End If
    233. If Zaehler = 2 Then
    234. i2 = I
    235. End If
    236. If Zaehler = 3 Then
    237. i3 = I
    238. End If
    239. End If
    240. Next I
    241. Select Case Info
    242. Case "kursiv"
    243. SchriftAnalyse = Mid$(SchriftInfo, i3 + 1, Len(SchriftInfo))
    244. Case "fett"
    245. SchriftAnalyse = Mid$(SchriftInfo, i2 + 1, i3 - i2 - 1)
    246. Case "Größe"
    247. SchriftAnalyse = Mid$(SchriftInfo, i1 + 1, i2 - i1 - 1)
    248. Case "Art"
    249. SchriftAnalyse = Mid$(SchriftInfo, 1, i1 - 1)
    250. End Select
    252. fehler2:
    253. Exit Function
    254. Fehler:
    255. msgbox Err.Description
    256. End Function


    es treten folgende Fehler auf:

    unzulässige Verwendung von NULL in form_open
    InitFontList: DLL-Einsprungpunkt 61 in msaccess.exe
    Objectvariable oder with-Blockvariable nicht festgelegt

    Weiß mir keinen Rat mehr. Bin für jede Hilfe dankbar. Danke im Vorraus

    InitFontList: DLL-Einsprungpunkt 61 in msaccess.exe wird folgender Zeile geworfen:

    Declare Function wlib_GetFontCount Lib "msaccess.exe" Alias "#61" (ByVal hdc As Long) As Long

    Dieser Code lief in Access 97 wunderbar aber nun in Access2003 nicht mehr, bei gleichem BS.

    Gruss

    Mit folgender Sub realisiere ich das in .NET:

    Quellcode

    1. Private Sub RTFBOX_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    2. Dim myFonts As New InstalledFontCollection
    4. For Each oFont As FontFamily In myFonts.Families
    5. Debug.Print(oFont.Name)
    6. ' Listbox mit einer Auswahl an Schriftart füllen
    7. ListBox3.Items.Add(oFont.Name)
    8. ' Vorauswahl in der Listbox
    9. ListBox3.SelectedIndex = 0
    10. Next
    12. ' Listbox mit einer Auswahl an Schriftgrößen füllen
    13. For Each no As Integer In Enumerable.Range(8, 17)
    14. ListBox4.Items.Add(no)
    15. Next
    16. ' Vorauswahl in der Listbox
    17. ListBox4.SelectedIndex = ListBox4.Items.IndexOf(10)
    19. 'Lineal einblenden
    21. End Sub


    Die Frage ist halt wie schreibe ich das so um, das es in Access 2003 funktioniert.

    okay, du nennst dich new(s)bie, verwendest aber api... okay, ich nehm's mal zur kenntnis

    Ich habe keinen Plan, könnte mir aber vorstellen, dass die entsprechende API von A97 zu A2003 geändert hat. Vielleicht hat die API-Funktion ja plötzlich mehr Argumente oder andere Typen? Woher Du die schlauen DECLAREs hast, weiss ich nicht, aber vielleicht suchst Du dort weiter...

    Und nach etwas googlen ist mir nun klar, dass die APIs die du verwendest erstens NICHT DOKUMENTIERT sind, d.h. jederzeit von Version zu Version ändern können und zweitens, dass die offensichtlich schon früh, also unter A97 durch jemanden mit viel Geduld per try and error ausprobiert und quasi-dokumentiert wurden. Ergo: Kein Grund für Access 2003 das zu tun, was du gerne möchtest....

    Vielleicht hilft Dir aber dieser Link hier weiter. Ist zwar eine recht umständliche Lösung, aber immerhin:

    exceltip.com/st/Display_all_in…_Microsoft_Excel/511.html

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „harryhirsch“ ()

    harryhirsch schrieb:

    okay, du nennst dich new(s)bie, verwendest aber api... okay, ich nehm's mal zur kenntnis

    Ich habe keinen Plan, könnte mir aber vorstellen, dass die entsprechende API von A97 zu A2003 geändert hat. Vielleicht hat die API-Funktion ja plötzlich mehr Argumente oder andere Typen? Woher Du die schlauen DECLAREs hast, weiss ich nicht, aber vielleicht suchst Du dort weiter...

    Und nach etwas googlen ist mir nun klar, dass die APIs die du verwendest erstens NICHT DOKUMENTIERT sind, d.h. jederzeit von Version zu Version ändern können und zweitens, dass die offensichtlich schon früh, also unter A97 durch jemanden mit viel Geduld per try and error ausprobiert und quasi-dokumentiert wurden. Ergo: Kein Grund für Access 2003 das zu tun, was du gerne möchtest....

    Vielleicht hilft Dir aber dieser Link hier weiter. Ist zwar eine recht umständliche Lösung, aber immerhin:

    http://www.exceltip.com/st/Display_all_installed_fonts_(Word)_using_VBA_in_Microsoft_Excel/511.html
    also so richtig weiß ich nicht was ich zu Deinem Post schreiben soll. Auf jedenfall Danke für den Link!

    Nun, ich bin ja nicht gerade der Profi, wenn's um Fonts geht, aber ist es nicht so, dass True Type Schriften frei skalierbar sind, da Vektorgrafiken? Damit wären ja theoretisch alle Grössen "verfügbar". Kann es sein, dass Du aufgrund der Drop-Down-Listen in Word o.ä. davon ausgehst, dass es nur bestimmte Grössen gibt?

    Und vielleicht könntest Du ja noch die einfache Lösung posten, die Du gefunden hast...

    Hallo harryhirsch,

    ja poste mal eben die Lösung für das befüllen einer ComboBox mit den Installierten Schriftarten.

    Visual Basic-Quellcode

    1. Option Compare Database
    3. Option Explicit
    5. Public Const NTM_REGULAR = &H40&
    6. Public Const NTM_BOLD = &H20&
    7. Public Const NTM_ITALIC = &H1&
    8. Public Const TMPF_FIXED_PITCH = &H1
    9. Public Const TMPF_VECTOR = &H2
    10. Public Const TMPF_DEVICE = &H8
    11. Public Const TMPF_TRUETYPE = &H4
    12. Public Const ELF_VERSION = 0
    13. Public Const ELF_CULTURE_LATIN = 0
    14. Public Const RASTER_FONTTYPE = &H1
    15. Public Const DEVICE_FONTTYPE = &H2
    16. Public Const TRUETYPE_FONTTYPE = &H4
    17. Public Const LF_FACESIZE = 32
    18. Public Const LF_FULLFACESIZE = 64
    20. Type LOGFONT
    21. lfHeight As Long
    22. lfWidth As Long
    23. lfEscapement As Long
    24. lfOrientation As Long
    25. lfWeight As Long
    26. lfItalic As Byte
    27. lfUnderline As Byte
    28. lfStrikeOut As Byte
    29. lfCharSet As Byte
    30. lfOutPrecision As Byte
    31. lfClipPrecision As Byte
    32. lfQuality As Byte
    33. lfPitchAndFamily As Byte
    34. lfFaceName(LF_FACESIZE) As Byte
    35. End Type
    37. Type NEWTEXTMETRIC
    38. tmHeight As Long
    39. tmAscent As Long
    40. tmDescent As Long
    41. tmInternalLeading As Long
    42. tmExternalLeading As Long
    43. tmAveCharWidth As Long
    44. tmMaxCharWidth As Long
    45. tmWeight As Long
    46. tmOverhang As Long
    47. tmDigitizedAspectX As Long
    48. tmDigitizedAspectY As Long
    49. tmFirstChar As Byte
    50. tmLastChar As Byte
    51. tmDefaultChar As Byte
    52. tmBreakChar As Byte
    53. tmItalic As Byte
    54. tmUnderlined As Byte
    55. tmStruckOut As Byte
    56. tmPitchAndFamily As Byte
    57. tmCharSet As Byte
    58. ntmFlags As Long
    59. ntmSizeEM As Long
    60. ntmCellHeight As Long
    61. ntmAveWidth As Long
    62. End Type
    64. Private Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, ByVal LParam As Long, ByVal dw As Long) As Long
    65. Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
    66. Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
    68. Private Declare Function GetFocus Lib "USER32" () As Long
    70. 'Declare variables required for this module.
    71. Dim WrkCtrl As Control 'will hold the ComboBox or ListBox Control to be filled
    72. Dim FontArray() As String 'The Array that will hold all the Fonts (needed for sorting)
    73. Dim FntInc As Integer 'The FontArray element incremental counter.
    76. Private Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As Long
    77. Dim FaceName As String
    79. 'convert the returned string to Unicode
    80. FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
    82. 'Dimension the FontArray array variable to hold the next Font Name.
    83. ReDim Preserve FontArray(FntInc)
    84. 'Place the Font name into the newly dimensioned Array element.
    85. FontArray(FntInc) = Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
    87. 'continue enumeration
    88. EnumFontFamProc = 1
    90. 'Increment the Array Element Counter.
    91. FntInc = UBound(FontArray) + 1
    92. End Function
    94. Public Sub EnumFontToControl(ByVal Frm As String, ByVal Ctrl As String)
    95. Dim LF As LOGFONT
    96. Dim hdc As Long
    97. Dim I As Integer
    99. 'Set the WrkCtrl Control variable to the passed
    100. 'control we want to fill wih Font Names. This
    101. 'control must be either a ComboBox or a ListBox.
    102. Set WrkCtrl = Forms(Frm).Controls(Ctrl)
    104. 'Set the Row Source Type for the ComboBox or
    105. 'ListBox to "Value List".
    106. WrkCtrl.RowSourceType = "Value List"
    108. 'Clear the current List (if any) within the
    109. 'control.
    110. WrkCtrl.RowSource = ""
    112. 'Retrieve the DC handle of the ComboBox or ListBox
    113. 'to be filled. The GetHWND function is also used to
    114. 'get the DC.
    115. hdc = GetDC(GetHWND(WrkCtrl))
    117. 'Enumerate the fonts
    118. EnumFontFamiliesEx hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
    120. 'Finished Enumeration. Release the DC.
    121. ReleaseDC GetHWND(WrkCtrl), hdc
    123. 'Sort the FontArray string array.
    124. Call QuickSortStringArray(FontArray(), 0, UBound(FontArray))
    126. 'Fill the Passed ComboBox or ListBox Conrol with the
    127. 'system Fonts found.
    128. For I = 0 To UBound(FontArray)
    129. WrkCtrl.AddItem Item:=FontArray(I)
    130. Next I
    132. 'Free memory...
    133. Set WrkCtrl = Nothing
    134. FntInc = 0
    135. Erase FontArray
    136. End Sub
    138. Public Function GetHWND(Ctrl As Control) As Long
    139. 'This function will get the Handle of a MS-Access
    140. 'Control.
    142. 'Set focus onto the Control we want to get the
    143. 'Handle from (this must be done)
    144. Ctrl.SetFocus
    146. 'Use the API GetFocus Function to retrieve the
    147. 'Handle and return it.
    148. GetHWND = GetFocus&()
    149. End Function
    151. Public Sub QuickSortStringArray(avarIn() As String, ByVal intLowBound As Integer, _
    152. ByVal intHighBound As Integer)
    153. 'GENERAL SUB-PROCEDURE
    154. '=====================
    156. 'Quicksorts the passed array of Strings
    157. 'avarIn() - array of Strings that gets sorted
    158. 'intLowBound - low bound of array
    159. 'intHighBound - high bound of array
    161. 'Declare Variables...
    162. Dim intX As Integer, intY As Integer
    163. Dim varMidBound As Variant, varTmp As Variant
    165. 'Trap Errors
    166. On Error GoTo PROC_ERR
    168. 'If there is data to sort
    169. If intHighBound > intLowBound Then
    170. 'Calculate the value of the middle array element
    171. varMidBound = avarIn((intLowBound + intHighBound) \ 2)
    172. intX = intLowBound
    173. intY = intHighBound
    175. 'Split the array into halves
    176. Do While intX <= intY
    177. If avarIn(intX) >= varMidBound And avarIn(intY) <= varMidBound Then
    178. varTmp = avarIn(intX)
    179. avarIn(intX) = avarIn(intY)
    180. avarIn(intY) = varTmp
    181. intX = intX + 1
    182. intY = intY - 1
    183. Else
    184. If avarIn(intX) < varMidBound Then
    185. intX = intX + 1
    186. End If
    187. If avarIn(intY) > varMidBound Then
    188. intY = intY - 1
    189. End If
    190. End If
    191. Loop
    193. 'Sort the lower half of the array
    194. QuickSortStringArray avarIn(), intLowBound, intY
    196. 'Sort the upper half of the array
    197. QuickSortStringArray avarIn(), intX, intHighBound
    198. End If
    200. PROC_EXIT:
    201. 'Outta here
    202. Exit Sub
    204. PROC_ERR:
    205. 'Display the Error Trapped
    206. MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    207. "QuickSortStringArray"
    208. 'Jump to...
    209. Resume PROC_EXIT
    210. End Sub



    Gestern, 15:43
    Von harryhirsch


    Nun, ich bin ja nicht gerade der Profi, wenn's um Fonts geht, aber ist es nicht so, dass True Type Schriften frei skalierbar sind, da Vektorgrafiken? Damit wären ja theoretisch alle Grössen "verfügbar". Kann es sein, dass Du aufgrund der Drop-Down-Listen in Word o.ä. davon ausgehst, dass es nur bestimmte Grössen gibt?

    Und vielleicht könntest Du ja noch die einfache Lösung posten, die Du gefunden hast...



    Ich habe dieComboxBox in Access für die Schriftgrößen manuell befüllt mit den Werten von 8 -72. Bei Arial oder Times New Roman funktioniert das Ändern der Schriftgröße wunderbar. Aber einigen ändern leider nicht. Deshalb brauche ich die verfügbaren Schriftgrößen für die asgewählte Schriftart. Denn es sollen alle auf dem System installierten Schriftarten angeboten werden.

    Gruß

    Wenn ich es richtig sehe brauchst Du die GetTextMetrics-API. siehe hier activevb.de/tipps/vb6tipps/tipp0537.html.
    Das Beispiel müsste relative einfach umsetzbar sein.

    Aber wieso nutzt Du nicht den eingebauten Dialog siehe hier accessruncommand.com/codeex/19.htm
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „INOPIAE“ ()

    moin moin,

    @INOPIAE

    ich weiß zwar mom nicht wie mir das Bsp. von activevb.de helfen soll, aber die Idee mit der GetTextMetrics-API ist interessant. Werde ich mir mal anschauen.

    Den eingebaute Standarddialog möchte ich ja nicht nutzen, weil ich die Schriftarten und deren verfügbare Schriftgrößen in einer separaten ComboBox darstellen möchte. Und das muss doch irgendwie machbar sein...

    Die Schriftarten habe ich bereits geladen in einer ComboBox, nun fehlt mir also die ComboBox für die Schriftgrößen....

    Gruss

Facebook