fb:porticula NoPaste
Bsave?
Uploader: | Eternal_Pain |
Datum/Zeit: | 24.08.2007 15:24:45 |
#INCLUDE "vbcompat.bi"
TYPE BMPInf
Filename AS STRING
Breit AS INTEGER
Hoch AS INTEGER
END TYPE
DIM SHARED Font(0 TO 255) AS BMPInf
DIM SHARED Path AS STRING
DIM SHARED FontName AS STRING
DIM SHARED FileName AS STRING
''Enter HERE!!!! Path AND Fontname!!!
'Path=[STRING]
'FontName=[STRING]
Path="D:\FreeBASIC\SSFmcf1"
FontName="SSFmcf1"
SUB getBMPSize (BYVAL Filename AS STRING, BYREF bmp_W AS INTEGER, BYREF bmp_H AS INTEGER)
DIM AS INTEGER FF = FREEFILE
OPEN FileName FOR BINARY AS #FF
GET #FF, 19, bmp_W
GET #FF, 23, bmp_H
CLOSE #FF
END SUB
FOR l AS INTEGER=0 TO 255
Filename=Path+"\"+STR(l)+".bmp"
IF FILEEXISTS(FileName)=0 THEN
?FileName+" changed TO x"
Filename=Path+"\x.bmp"
END IF
WITH Font(l)
.Filename = Filename
getBMPSize (Filename,.Breit,.Hoch)
END WITH
NEXT l
''Maximale Breite = MaxBreit
''Maximale Hoehe = MaxHoch
DIM MaxBreit AS INTEGER=0
DIM MaxHoch AS INTEGER=0
FOR l AS INTEGER=0 TO 255
WITH Font(l)
IF .Breit > MaxBreit THEN MaxBreit = .Breit
IF .Hoch > MaxHoch THEN MaxHoch = .Hoch
END WITH
NEXT l
''
''
?"Convert "+STR(MaxBreit)+" "+STR(MaxHoch)
DIM AS UBYTE PTR FontBuffer
FontBuffer=IMAGECREATE(MaxBreit*256,MaxHoch)
DIM AS ANY PTR CharBuffer
FOR l AS INTEGER=0 TO 255
CharBuffer=IMAGECREATE(MaxBreit,MaxHoch)
BLOAD Font(l).Filename,CharBuffer
PUT FontBuffer,(l*MaxBreit,0),CharBuffer,PSET
IMAGEDESTROY(CharBuffer)
NEXT l
?"Save new BMP"
SLEEP
BSAVE ("xyzabc.bmp"),FontBuffer
IMAGEDESTROY(FontBuffer)
?"Ready."
SLEEP