7 years old, but maybe gives you an idea. I changed some small things, so it works with PB 4.61 (
old code here).
It loads the font, draws each character and scans the small image
for pixels. The font pixels get written into an array, so you have the
font data for drawing.
It uses an ImageGadget, you may want to change it to the newer CanvasGadget.
Code: Select all
;
; by Danilo, May 2005 - german forum
;
#speed = 75 ; milliseconds
#point_w = 14
#point_h = 7
#display_w = 50*#point_w
#display_h = 17*#point_h
#points_horz = #display_w / #point_w
#points_vert = #display_h / #point_h
#font_w = 12
#font_h = #font_w
Structure DISPLAY_FONT
x.b[#FONT_W]
y.b[#points_vert]
EndStructure
Global Dim DISPLAY(#points_horz,#points_vert)
Global Dim POINT_ID(2)
Global Dim FONT_DATA(256,#font_w,#points_vert)
Procedure InitDisplayFont()
image = CreateImage(#PB_Any,#font_w,#points_vert)
If image
font = LoadFont(#PB_Any,"Lucida Console",#font_h)
If StartDrawing(ImageOutput(image))
DrawingMode(1)
DrawingFont(FontID(font))
FrontColor(RGB($FF,$FF,$FF))
For i = 0 To 255
Box(0,0,#font_w,#points_vert,0)
;Locate(0,0)
DrawText(0,0,Chr(i))
For y = 0 To #points_vert-1
For x = 0 To #font_w-1
If Point(x,y)
FONT_DATA(i,x,y)=1
EndIf
Next x
Next y
Next i
StopDrawing()
EndIf
FreeFont(font)
FreeImage(image)
EndIf
EndProcedure
Procedure DrawDisplayText(text$,skip)
If skip
skip_x = skip%#font_w
skip_char = skip/#font_w
If skip_char
text$=Right(text$,Len(text$)-skip_char)
EndIf
EndIf
index = -1
count = Len(text$)
If count
For i = 0 To count-1
char = Asc(Mid(text$,i+1,1))
For x = 0+skip_x To #font_w-1
index + 1
If index > #points_horz
ProcedureReturn
EndIf
For y = 0 To #points_vert-1
DISPLAY(index,y)=FONT_DATA(char,x,y)
Next y
Next x
skip_x = 0
Next i
EndIf
EndProcedure
Procedure UpdateDisplay()
If StartDrawing(ImageOutput(2))
For y = 0 To #points_vert-1
For x = 0 To #points_horz-1
DrawImage(POINT_ID(DISPLAY(x,y)),x*#point_w,y*#point_h)
Next x
Next y
StopDrawing()
EndIf
EndProcedure
If CreateImage(0,#point_w,#point_h)=0 Or CreateImage(1,#point_w,#point_h)=0 Or CreateImage(2,#display_w,#display_h)=0
MessageRequester("ERROR","Cant create images !"):End
EndIf
Restore colors
For a = 0 To 1
Read col
POINT_ID(a) = ImageID(a)
If StartDrawing(ImageOutput(a))
;Ellipse(#point_w/2,#point_h/2,(#point_w-1)/2,(#point_h-1)/2,col)
Box(1,1,#point_w-1,#point_h-1,col)
StopDrawing()
EndIf
Next a
Restore text
Read.s DisplayText$
InitDisplayFont()
DrawDisplayText(DisplayText$,0):UpdateDisplay()
OpenWindow(0,0,0,#display_w,#display_h,"LeuchtDioden", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ImageGadget(1,0,0,#display_w,#display_h,ImageID(2))
AddWindowTimer(0,1,#speed)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Timer
index + 1
If index > Len(DisplayText$)*#font_w
index=0
EndIf
DrawDisplayText(DisplayText$,index):UpdateDisplay()
SetGadgetState(1,ImageID(2))
EndSelect
ForEver
DataSection
colors:
Data.i $404040, $0000FF
text:
Data.s " Das ist ein Display-Test für Plankton..."
EndDataSection