michaelblasin
Anmeldungsdatum: 09.11.2010 Beiträge: 38
|
Verfasst am: 02.04.2018, 13:44 Titel: Unicode für ein dreisprachiges Lexikon |
|
|
Hallo,
Ich habe eine Lösung für die Darstellung von Russisch, Griechisch und Chinesisch gefunden, die allerdings nicht sehr elegant ist.
Ich habe alle Zeichen aus der Unicode Tabelle aufsteigende in ein '.Txt' File auf dem Bildschirm angezeigt, mit 'Snipping Tool' in eine '.Png' kopiert und durch ein Programm die Pixel in einen eigenen Zeichensatz kopiert. Also von 20 Hex bis FFFF Hex (Die chinesischen Zeichen gehen von 2DF0 bis A0C7 und von F618 bis FFEF).
Das muß ich zwar für jede Zeichengröße und Schriftart machen (jeweils 2 Stunden Arbeit), aber es funktioniert.
Ich habe mir vor längerer Zeit etwas über Schriftarten heruntergeladen, aber ich weiß nicht mehr von wo und und von wem.
Es handelt sich um FBTrueType in 'Verschiedenes für Zeichensätze'
Es gibt 5 Beispiele Test01,02,03,04,05.
Test05.Bas funktioniert für griechisch und russisch, aber nicht für chinesisch.
Hat jemand eine Idee, ob man das Problem damit lösen könnte.?
Nachstehend das heruntergeladene Programm, ergänzt um 'chinesisch'
Code: | #include once "FBTrueType.bi"
sub TTPrint overload(byval font as long,byval x as integer,byval y as integer,byref txt as string,byval col as ulong=rgb(255,255,255),byval size as integer=24)
dim as FontProps fProps
dim as GlyphProps gProps
dim as integer maxw,maxh,bytes,cx=x,cy=y
if screenptr()=0 then return
screeninfo maxw,maxh,,bytes
if bytes<>4 then return
if size<4 then return
var nChars=len(txt) : if nChars<1 then return
if FontPorperties(font, size, fprops) then return
nChars-=1
for i as integer = 0 to nChars
var char = txt[i]
if char<33 then
if char=32 then cx+=size\4
else
var index1 = GlyphIndex(font, char)
if index1<>GLYPH_NOT_FOUND then
dim as long index2 = iif(i<nChars,GlyphIndex(font,txt[i+1]),0)
if index2=GLYPH_NOT_FOUND then index2=0
if GlyphProperties(font, fProps, gProps, index1,index2) = 0 then
if cx+gProps.w>=maxw then cy += fProps.advanceHeight : cx=x
var AlphaChannel = GlyphImageCreate(font, fProps, gProps,index1)
if AlphaChannel then
var glyph = ImageCreate(gProps.w,gProps.h,col)
put glyph,(0,0),AlphaChannel,ALPHA
put (cx,cy + gProps.y),glyph,ALPHA
ImageDestroy glyph
ImageDestroy AlphaChannel
end if
cx += gProps.advanceWidth + gProps.kernAdvance
end if
end if
end if
next
end sub
sub TTPrint (byval font as long,byval x as integer,byval y as integer,byref txt as wstring,byval col as ulong=rgb(255,255,255),byval size as integer=24)
dim as FontProps fProps
dim as GlyphProps gProps
dim as integer maxw,maxh,bytes,cx=x,cy=y
if screenptr()=0 then return
screeninfo maxw,maxh,,bytes
if bytes<>4 then return
if size<4 then return
var nChars=len(txt) : if nChars<1 then return
if FontPorperties(font, size, fprops) then return
nChars-=1
for i as integer = 0 to nChars
var char = txt[i]
if char<33 then
if char=32 then cx+=size\4
else
var index1 = GlyphIndex(font, char)
if index1<>GLYPH_NOT_FOUND then
dim as long index2 = iif(i<nChars,GlyphIndex(font,txt[i+1]),0)
if index2=GLYPH_NOT_FOUND then index2=0
if GlyphProperties(font, fProps, gProps, index1,index2) = 0 then
if cx+gProps.w>=maxw then cy += fProps.advanceHeight : cx=x
var AlphaChannel = GlyphImageCreate(font, fProps, gProps,index1)
if AlphaChannel then
var glyph = ImageCreate(gProps.w,gProps.h,col)
put glyph,(0,0),AlphaChannel,ALPHA
put (cx,cy + gProps.y),glyph,ALPHA
ImageDestroy glyph
ImageDestroy AlphaChannel
end if
cx += gProps.advanceWidth + gProps.kernAdvance
end if
end if
end if
next
end sub
dim as integer maxw=640,maxh=480
screenres maxw,maxh,32
'const fontfile = "DejaVuSans-Bold.ttf"
const fontfile = "Arial.ttf"
chdir exepath()
' load the font
var font = FontLoad(fontfile)
if font<0 then
print "error: loading: " & fontfile & " " & ErrorText(font)
beep : sleep : end 1
end if
dim as wstring * 20 russian = "Привет, мир!"
'dim as wstring * 20 greek = "Καλημέρα κόσμε!"
dim as wstring * 20 chinese = "你好,世界!" 'von mir hinzugefügt
dim as integer y=10
for i as integer = 0 to 11
if i and 1 then
TTPrint font,32,y,russian,rgb(i*16,128,255-i*16),16+i*4
else
'TTPrint font,32,y,greek,rgb(i*16,128,255-i*16),16+i*4
TTPrint font,32,y,chinese,rgb(i*16,128,255-i*16),16+i*4
end if
y+=16+i*4
next
sleep |
|
|