[VB.NET] Installazione di font TTF sulla macchina

[cepu96]

Salve a tutti,
Ho sottomano questo codice VB per installare font TTF:

Dim Ret%, Res&
Const WM_FONTCHANGE = &H1D
Const HWND_BROADCAST = &HFFFF
Const FontPath$ = "Arial.TTF"
Const FontRes$ = "Arial.FOT"
Const FontName$ = "Arial"
Const WinPath$ = "c:\windows"
Ret% = CreateScalableFontResource(0, FontRes$, FontPath$, WinPath$)
Ret% = AddFontResource(FontRes$)
Res& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Ret% = WriteProfileString("fonts", FontName$ + " Arial (TrueType)", FontRes$)

Mi potreste aiutare a capire come convertirlo in VB.NET?

EDIT: ho risolto, ma non riesco a cancellare la discussione!

[power.mobile]

piuttosto che chiuderla sarebbe meglio se postassi la soluzione in modo che chi avrà il tuo stesso problema saprà come risolverlo...

[alka]

Originariamente inviato da power.mobile
piuttosto che chiuderla sarebbe meglio se postassi la soluzione in modo che chi avrà il tuo stesso problema saprà come risolverlo...

Quoto e sottoscrivo.

[cepu96]

Ok giusto
Questo codice serve a installare un font sul PC
E' sintetizzabile tutto in questa API:

<System.Runtime.InteropServices.DllImport("gdi32.dll")> _
Public Shared Function AddFontResource(ByVal lpszFilename As String) As Integer
End Function

La quale accetta come unico parametro il percorso del font da installare

[cepu96]

Bisogna specificare che non li installa proprio... con Word ad esempio li vedi, ma se cerchi di utilizzarli su VB.NET non funge

EDIT:
Rettifico: sembra che carichi il Font come risorsa, non capisco bene!

EDIT2:
Ecco il codice giusto:

<DllImport("gdi32")> _
    Function AddFontResource(ByVal lpFileName As String) As Integer
    End Function

    <DllImport("user32.dll")> _
    Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function

    <DllImport("kernel32.dll", SetLastError:=True)> _
    Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
    End Function

    Sub Main()
        IO.File.Copy(My.Application.Info.DirectoryPath & "\nomefont.TTF", "C:\WINDOWS\Fonts\nomefont.TTF", True)
        Dim Ret As Integer
        Dim Res As Integer
        Dim FontPath As String
        Const WM_FONTCHANGE As Integer = &H1D
        Const HWND_BROADCAST As Integer = &HFFFF
        FontPath = "C:\WINDOWS\Fonts\nomefont.TTF"
        Ret = AddFontResource(FontPath)
        Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
        Ret = WriteProfileString("fonts", "nomefont.TTF (TrueType)", My.Application.Info.DirectoryPath & "\nomefont.TTF")

[MItaly]

Questo codice fallirà clamorosamente su qualunque macchina in cui la cartella dei font non è in c:\Windows\Fonts, ad esempio qualunque macchina su cui Windows sta su un'unità diversa da c: (tipico il caso del setup di Windows che installa su d: facendo casino con la partizione di recovery, o di più versioni di Windows installate) o in cui la cartella di Windows ha un nome diverso (fino a Windows 2000 gli OS di famiglia NT stavano di default in una cartella chiamata WINNT, e se si installa Windows su un drive con già una cartella Windows viene creata una cartella Windows(01)).

Perché non imparate ad usare le cacchio di special folders?

[cepu96]

Si lo so che dovrei usare quelle, ma qual'è? System?

[MItaly]

Environment.GetFolderPath(Environment.SpecialFolde r.Fonts) ti restituisce il percorso della directory dei font.
Tra l'altro, per concatenare i percorsi usa Path.Combine, in modo da non fare casini con eventuali backslash mancanti.

[cepu96]

Non esiste Environment.SpecialFolder.Fonts , uso la versione 2.0 del framework

[MItaly]

Purtroppo il valore per Fonts è stato aggiunto solo in seguito; in tal caso, per ottenere la cartella fonts devi usare la API SHGetFolderPath usando come valore CSIDL la costante CSIDL_FONTS.