Code: Select all
; Title: Mini Image Font
; Author: Fluid Byte
; Test-Platform: Windows XP SP3
; PB Version: 4.30
; E-Mail: fluidbyte@web.de
Structure MIF_DATA
Sprite.i
Width.b
Height.b
RealWidth.w
Spacing.b
EndStructure
Procedure MIF_CreateFont(SZF=1,SPC=0)
Protected *mifd.MIF_DATA = AllocateMemory(SizeOf(MIF_DATA))
If SZF < 1 : SZF = 1 : EndIf
*mifd\Width = 7 * SZF : *mifd\Height = 6 * SZF : *mifd\RealWidth = 112 * SZF : *mifd\Spacing = SPC
Protected lpBuffer = AllocateMemory(1462)
UnpackMemory(?_MIF_ImgageFont,lpBuffer)
If SZF > 1
Protected hbmFont = CatchImage(#PB_Any,lpBuffer,1462)
ResizeImage(hbmFont,112 * SZF,24 * SZF)
*mifd\Sprite = CreateSprite(#PB_Any,112 * SZF,24 * SZF)
StartDrawing(SpriteOutput(*mifd\Sprite))
DrawImage(ImageID(hbmFont),0,0)
StopDrawing() : FreeImage(hbmFont)
Else
*mifd\Sprite = CatchSprite(#PB_Any,lpBuffer)
EndIf
TransparentSpriteColor(*mifd\Sprite,RGB(0,128,0))
FreeMemory(lpBuffer)
ProcedureReturn *mifd
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure MIF_DrawText(*mifd.MIF_DATA,X,Y,Text$)
Protected c, Length = Len(Text$)-1, Frame, RowNum, ClipX
For c=0 To Length
Frame = PeekB(@Text$ + c) & $FF - ' '
RowNum = (Frame * *mifd\Width) / *mifd\RealWidth
ClipX = (Frame - (*mifd\RealWidth / *mifd\Width * RowNum)) * *mifd\Width
ClipSprite(*mifd\Sprite,ClipX,RowNum * *mifd\Height,*mifd\Width,*mifd\Height)
DisplayTransparentSprite(*mifd\Sprite,X + c * (*mifd\Width + *mifd\Spacing),Y)
Next
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure MIF_FreeFont(*mifd.MIF_DATA)
If *mifd : FreeSprite(*mifd\Sprite) : FreeMemory(*mifd) : ProcedureReturn 1 : EndIf
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DataSection
_MIF_ImgageFont:
Data.l $05B6434A,$071F0000,$A9BB4768,$146B20D0,$CA126829,$184AB008,$080CB825,$81E20246,$10607400,$001E4398
Data.l $981C1730,$4E010204,$020200A0,$03C05E00,$03804FFC,$C02D4093,$59041409,$08962200,$0E010807,$05700320
Data.l $5025F04C,$16802104,$55433050,$9FF07C90,$8118FE48,$B2021C00,$44032807,$A8048600,$78320BB0,$5E811229
Data.l $01C682A0,$0810C1C3,$E02A08DF,$71165500,$150007E8,$2B050CE0,$8BF94978,$00C24806,$24E190C9,$260363A0
Data.l $C0041BF0,$F831C559,$D2F011A5,$E0E3FC0A,$D21A621B,$401F1341,$08186693,$FD1A6D20,$F804E398,$634B2186
Data.l $043ECA35,$1248C074,$A0614C0E,$3A843F01,$768209B0,$11B7C208,$43BC34A0,$C200244D,$008A22A1,$03E46818
Data.l $59468CA8,$A8CA4F82,$99F82308,$A66CA054,$A08E1369,$1751BC28,$26C23673,$D7AC9794,$42A4211C,$80725802
Data.l $6932930A,$26C6D273,$C05693B3,$6C2A1488,$A3681123,$854931F8,$E3674862,$0AC1A140,$EA177A44,$99DFC4A1
Data.l $7A28506D,$3B80A5ED,$83A0A0E3,$320A9002,$02AC03C2,$018A0DB3,$AA28BD9C,$E4C90AB3,$CA286803,$AF2C2885
Data.l $AE15628C,$10B80480,$0C583205,$82AA8AD4,$0F010E8B,$B020D330,$D8531031,$F152C0C2,$5B003110,$94D824B3
Data.l $8A1EF145,$7AB70780,$878B3560,$C204A229,$37AC5E77,$B244B6FA,$5AB245BB,$B76C0ACB,$074D9E4C,$12C7D968
Data.l $ADE71107,$50C0DC0A,$81864814,$441CAA5A,$BF2F65C4,$0754F223,$A6516540,$40A83441,$E082B1A0,$7586DDC8
Data.l $E1B8165A,$68F468A0,$6A24C911,$0D191B62,$071AE1F5,$073882C6,$51826940,$7167C0C8,$2C26850A,$9B103144
Data.l $5B1DC1F3,$08B00712,$48D0460B,$E7C35332,$5E222126,$13244558,$81653625,$9C10061B,$31900CD9,$00818957
Data.l $2B36080A,$B0EF332C,$7EC6C208,$B9E07C14,$8A20B6C6,$508D7187,$AB31E115,$4CF00AB0,$FE30C431,$F02A4BD9
Data.l $1E13C46D,$AD2F0E66,$A6118930,$37CC3E34,$D8FD8CA8,$8A92034B,$2D261CD9,$CDC01460,$3870A1C2,$0000B126
Data.b $FC,$97
EndDataSection
A small example program:
Code: Select all
InitSprite() : InitKeyboard()
OpenWindow(0,0,0,640,480,"Mini Image Font",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0)
Define EventID, *mifd1.MIF_DATA, *mifd2.MIF_DATA, *mifd3.MIF_DATA
*mifd1 = MIF_CreateFont()
*mifd2 = MIF_CreateFont(0,5)
*mifd3 = MIF_CreateFont(2)
Repeat
Repeat
EventID = WindowEvent()
Select EventID
Case #PB_Event_CloseWindow : End
EndSelect
Until EventID = 0
ExamineKeyboard()
ClearScreen($756055)
MIF_DrawText(*mifd1,50,50,"!" + Chr(34) + "#$%&'()*+,-./0123456789:;<=>?@")
MIF_DrawText(*mifd1,50,70,"ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_")
MIF_DrawText(*mifd1,50,120,UCase("the quick brown fox jumps over the lazy dog."))
MIF_DrawText(*mifd1,50,140,UCase("lorem ipsum dolor sit amet."))
MIF_DrawText(*mifd2,50,200,UCase("this font uses a different spacing!"))
MIF_DrawText(*mifd3,50,260,UCase("this font is resized by the factor 2"))
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
MIF_FreeFont(*mifd1) : MIF_FreeFont(*mifd2) : MIF_FreeFont(*mifd3)