- eBay-es kütyük kis pénzért
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- Meggyi001: RTX 5060 - Az új népkártya?
- gban: Ingyen kellene, de tegnapra
- pr1mzejEE: Viszlát CoD2, CoD4, CS:GO!
- Magga: PLEX: multimédia az egész lakásban
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- bitpork: Phautós tali a Balcsinál 2025 Augusztus 2 napján (szombat)
Hirdetés
Talpon vagyunk, köszönjük a sok biztatást! Ha segíteni szeretnél, boldogan ajánljuk Előfizetéseinket!
Ú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
- XFX RX-69XTATBD9 Xfx Radeon RX 6900 XT 16 GB GDDR6 videókártya csere Rtx 4070Ti
- AKCIÓ!!! GAMER PC: RYZEN 5 4500-5600X +RX 9060XT/9070/9070XT +16-64GB DDR4! GAR/SZÁMLA!!!
- AKCIÓ!!! DDR5 GAMER PC: RYZEN 5 8400F/9600X +RX 9060XT/9070/9070XT +16-64GB DDR5! GAR/SZÁMLA!!!
- Asus X299 TUF / Beszámítás OK!
- AKCIÓ!!! GAMER PC: RYZEN 7 5700/5800X +RX 9060XT/9070/9070XT +16-64GB DDR4! GAR/SZÁMLA!!!
- Ultimate előfizetés új fiókra akár 2105 Ft/hó áron! Azonnali, automatizált aktiválással, csak Nálam!
- Jo Nesbo: LEOPÁRD (nem olvasott)
- Fém, összecsukható és kihúzható fotó állvány eladó
- AKCIÓ! Microsoft Surface 5 13,5 notebook - i5 1235U 8GB RAM 256GB SSD Intel Iris Xe IGP 27% áfa
- GYÖNYÖRŰ iPhone 13 128GB Midnight -1 ÉV GARANCIA - Kártyafüggetlen, MS3034, 100% Akkumulátor
Állásajánlatok
Cég: FOTC
Város: Budapest