- Gurulunk, WAZE?!
- gban: Ingyen kellene, de tegnapra
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Magga: PLEX: multimédia az egész lakásban
- mefistofeles: A 15 centi nagyon rövid.........
- Geri Bátyó: Agglegénykonyha 1 – rizseshús másképp
- gerner1
Új hozzászólás Aktív témák
-
vilag
tag
Sziasztok!
Kicsit rég jártam erre...
/Szerencsére a program egy jó ideje viszonylag stabilan működik./
Most egy régi-új fejlesztési ötletet szeretnék végre befejezni, ami már félig készen van.
A lényeg az, hogy egy generált ügyiraton szeretnék vonalkódot megjeleníteni a korábban általam itt közzé tett algoritmussal.
Ez eddig meg is van.
A bibi ott van, hogy ehhez egy betűtípus telepítésére van szükség amit nyilván automatizálni szeretnék.
Részben azért, mert nem fogok mindig itt dolgozni (ez már biztos!), részben azért, mert a gépek fizikálisan is messze vannak, részben pedig azért, mert nem akarom egyesével minden gépen végrehajtani a telepítést.
A probléma az, hogy a betűtipus telepítése nem annyi, hogy a "Fonts" könyvtárba bemásolom azt.Kerestem a problémára megoldást és az alábbi kódot találtam:
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
Declare Function CreateScalableFontResource% Lib "GDI" (ByVal fHidden%, ByVal lpszResourceFile$, ByVal lpszFontFile$, ByVal lpszCurrentPath$)
Declare Function AddFontResource Lib "GDI" (ByVal lpFilename As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' This sub installs a TrueType font and makes it available to all Windows apps. It takes these arguments:
'
' FontName$ is the font's name (e.g. "Goudy Old Style")
'
' FontFileName$ is the font's filename (e.g. "GOUDOS.TTF")
'
' WinSysDir$ is the user's System folder (e.g. "C:\WINDOWS\SYSTEM" or "C:\WINDOWS\SYSTEM32")
'
' ** Before calling this sub, your code must copy the font file to the user's Fonts folder. **
'
Sub ttf_install(FontName$, FontFileName$, WinSysDir$)
Dim Ret%, Res&, FontPath$, FontRes$
Const WM_FONTCHANGE = &H1D
Const HWND_BROADCAST = &HFFFF
FontPath$ = WinSysDir$ + "\" + FontFileName$
FontRes$ = Left$(FontPath$, Len(FontPath$) - 3) + "FOT"
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)
Ret% = AddFontResource(FontRes$)
Res& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Ret% = WriteProfileString("fonts", FontName + " " & "(TrueType)", FontRes$)
End SubEzt kicsit módosítottam mert egyáltalán el sem indult, így a Sub sorból a zárójelben lévő részeket kivettem és az alatta lévő sorokkal egészítettem ki az alábbiak szerint:
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
Declare Function CreateScalableFontResource% Lib "GDI" (ByVal fHidden%, ByVal lpszResourceFile$, ByVal lpszFontFile$, ByVal lpszCurrentPath$)
Declare Function AddFontResource Lib "GDI" (ByVal lpFilename As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' This sub installs a TrueType font and makes it available to all Windows apps. It takes these arguments:
' FontName$ is the font's name (e.g. "Goudy Old Style")
' FontFileName$ is the font's filename (e.g. "GOUDOS.TTF")
' WinSysDir$ is the user's System folder (e.g. "C:\WINDOWS\SYSTEM" or "C:\WINDOWS\SYSTEM32")
' ** Before calling this sub, your code must copy the font file to the user's Fonts folder. **
Sub ttf_install() '(FontName$, FontFileName$, WinSysDir$)
FontName$ = "Vonalkód"
FontFileName$ = "code128.ttf"
WinSysDir$ = Environ("WINDIR") & "\Fonts"
Dim Ret%, Res&, FontPath$, FontRes$
Const WM_FONTCHANGE = &H1D
Const HWND_BROADCAST = &HFFFF
FontPath$ = WinSysDir$ + "\" + FontFileName$
FontRes$ = Left$(FontPath$, Len(FontPath$) - 3) + "FOT"
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)
Ret% = AddFontResource(FontRes$)
Res& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Ret% = WriteProfileString("fonts", FontName + " " & "(TrueType)", FontRes$)
End SubValamit azonban biztosan rosszul csinálok, mert nem tudom működésre bírni.
A megjegyzésben írtak szerint a betűtípus másolása megtörténik a Windows\Fonts mappába.
Nem tudom a megjegzésben mért a felhasználó Fonts mappát írja, mert olyan én nem találtam.
Esetleg itt a hiba, létre kéne hoznom egyet?
De sehol nem hivatkozik a felhasználói mappa Fonts könyvtárára...Az alábbi sornál azonban hibára futok:
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)
A hiba:
Run-time error '53':
File not found.Van valakinek ötlete, hogyan tudnám ezt a dolgot működésre bírni?
Új hozzászólás Aktív témák
- Gigabyte GA-P35-DS4 LGA 775 alaplap, + Quad Core Xeon E5420 proci
- HP VICTUS 15-FA0054NS i5-12450H / 16GB ram / 512GB / RTX 3050
- Samsung Galaxy S24 Ultra 512 GB 2027.január 22-ig garis
- Dell,14"FullHd IPS,core i5 6440H(fiz.4MAG!),8-16GB DDR4 RAM,Vil.bill,256-512GB SSD,Jó akku,szép
- HP 15.6 ",AMD A10,jó állapotú,magyar billentyűzet
- Dell Precision 5540 i7-9850H 16GB 256GB 15.6" FHD Nvidia Quadro T1000 15.6" FHD 1 év garancia
- Csere-Beszámítás! Ajándék ROG Táska! Asus Rog Ally Z1 Extreme RC71L - 512GB SSD + 16GB LPDDR5
- ÁRGARANCIA!Épített KomPhone Ryzen 5 7600X 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- Azonnali készpénzes Sony Playstation 4 Slim / PS4 Pro felvásárlás személyesen/csomagküldéssel
- BESZÁMÍTÁS! Apple MacBook Pro 14 M4 Pro 24GB RAM 512GB SSD macbook garanciával hibátlan működéssel
Állásajánlatok
Cég: FOTC
Város: Budapest