Hatte ich nur schnell in FreeBasic hingeschmiert: Code: #Include "windows.bi" Extern "windows-ms" Sub linkVersion Naked Alias "linkVersion" () Export Asm .quad 2 End Asm End Sub End Extern Type DelphiString c As Integer = -1 l As Integer = 0 s As ZString * 1024 Declare Sub set(newstring As String) End Type Sub DelphiString.set(newstring As String) l = Len(newstring) s = newstring End Sub Dim Shared As DelphiString font1, font2 Function onStartup Cdecl Alias "onStartup" (pluginName As ZString Ptr) As Boolean Export Var p = CurDir() & "\Fonts" Var f = Dir(p & "\*.*") Do While Len(f) AddFontResource(p & "\" & f) f = Dir() Loop Dim As ZString * 1024 f1, f2 GetPrivateProfileString(pluginName, "Font1", "", @f1, SizeOf(f1), CurDir() & "\DynRPG.ini") GetPrivateProfileString(pluginName, "Font2", "", @f2, SizeOf(f2), CurDir() & "\DynRPG.ini") font1.set(f1) font2.set(f2) If font1.l Then *CPtr(Any Ptr Ptr, &h4884A8) = @font1.s EndIf If font2.l Then *CPtr(Any Ptr Ptr, &h4884BF) = @font2.s EndIf Return TRUE End Function Sub onExit Cdecl Alias "onExit" () Export Var p = CurDir() & "\Fonts" Var f = Dir(p & "\*.*") Do While Len(f) RemoveFontResource(p & "\" & f) f = Dir() Loop End Sub
#Include "windows.bi" Extern "windows-ms" Sub linkVersion Naked Alias "linkVersion" () Export Asm .quad 2 End Asm End Sub End Extern Type DelphiString c As Integer = -1 l As Integer = 0 s As ZString * 1024 Declare Sub set(newstring As String) End Type Sub DelphiString.set(newstring As String) l = Len(newstring) s = newstring End Sub Dim Shared As DelphiString font1, font2 Function onStartup Cdecl Alias "onStartup" (pluginName As ZString Ptr) As Boolean Export Var p = CurDir() & "\Fonts" Var f = Dir(p & "\*.*") Do While Len(f) AddFontResource(p & "\" & f) f = Dir() Loop Dim As ZString * 1024 f1, f2 GetPrivateProfileString(pluginName, "Font1", "", @f1, SizeOf(f1), CurDir() & "\DynRPG.ini") GetPrivateProfileString(pluginName, "Font2", "", @f2, SizeOf(f2), CurDir() & "\DynRPG.ini") font1.set(f1) font2.set(f2) If font1.l Then *CPtr(Any Ptr Ptr, &h4884A8) = @font1.s EndIf If font2.l Then *CPtr(Any Ptr Ptr, &h4884BF) = @font2.s EndIf Return TRUE End Function Sub onExit Cdecl Alias "onExit" () Export Var p = CurDir() & "\Fonts" Var f = Dir(p & "\*.*") Do While Len(f) RemoveFontResource(p & "\" & f) f = Dir() Loop End Sub
-- Mir war nichtmal bewusst dass ich nominiert wurde, aber: Cool! Hälfte des Lobes muss aber unbedingt an Archeia!Now all new and shiny: CherryShare | Patches und Tools | Programmwunschthread | www.cherrytree.at | Cherry = CherryDT
Foren-Regeln