i need to find the font folder programatically on windows and put all the fonts into a listbox on my program
but how can i find the font folder??
on my machine its C:\windows\fonts
but its different on other peoples
can someone help me
Printable View
i need to find the font folder programatically on windows and put all the fonts into a listbox on my program
but how can i find the font folder??
on my machine its C:\windows\fonts
but its different on other peoples
can someone help me
Try this:
Fonts is always the same.VB Code:
Option Explicit Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _ "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Sub Command1_Click() Dim strSave As String, strPath As String strSave = String(200, Chr$(0)) strPath = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) & "\Fonts" MsgBox strPath End Sub
thanks :D
here's how to get it outright:VB Code:
Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _ (ByVal hwnd As Long, ByVal pszPath As String, ByVal csidl As Long, ByVal fCreate As Long) As Long Private Const CSIDL_FONTS = &H14& Private Sub Form_Load() Debug.Print GetFolderPath(CSIDL_FONTS) End Sub Private Function GetFolderPath(ByVal lID As Long) As String Dim sPath As String sPath = Space$(260) SHGetSpecialFolderPath Me.hwnd, sPath, lID, False GetFolderPath = Left$(sPath, InStr(sPath, vbNullChar) - 1) End Function
Not necessary - there is a more precise way to determine any special folder path:Quote:
Originally Posted by gavio
VB Code:
Option Explicit Private Const CSIDL_FONTS = &H14 Private Const MAX_PATH = 260 Private Const NOERROR = 0 Private Type SHTEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHTEMID End Type Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, pidl As ITEMIDLIST) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Private Function GetSpecialfolder(CSIDL As Long) As String Dim res As Long Dim IDL As ITEMIDLIST Dim sPath As String 'Get the special folder res = SHGetSpecialFolderLocation(100, CSIDL, IDL) If res = NOERROR Then 'Create a buffer sPath = Space$(512) 'Get the path from the IDList res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) 'Remove the unnecessary chr$(0)'s GetSpecialfolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1) Exit Function End If GetSpecialfolder = "" End Function Private Sub Command1_Click() Debug.Print GetSpecialfolder(CSIDL_FONTS) End Sub
If that is all you want to do, then you don't need to know where the Fonts folder isQuote:
Originally Posted by Pouncer
VB Code:
Private Sub Form_Load() Dim i As Long For i = 0 To Screen.FontCount - 1 List1.AddItem Screen.Fonts(i) Next End Sub
... and to take it a bit further here a very nice sample:
Enumerate Windows Fonts with Font Preview
:thumb: Cool! :thumb: I had not run into this tidbit before.Quote:
Originally Posted by RhinoBull
Randy is The Man! :)