Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
[Function]SPrint.bi
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 09.06.2010 21:19:15 |
/'
[Function]SPrint ("Erweiterte Version von [Sub]SPrint")
Wichtig: 'Benoetigt eine [SPFF]' _VOR_ dem einbinden der Funktion!
Mehr flexibilitaet zum einsetzen eines Bit-Fonts ohne Externe Dateien
gegenueber seines vorgaengers. Fonts sind nun mit variabler Zeichenbreite
moeglich und die Daten sind in einer extra Function 'ausgelagert'
Die "VORHER" einzubinden ist.
Aenderungen:
- SPrint ist eine Function und liefert einen Integerwert zurueck
- - Zusaetzlich hinzugefuegt ist die SPFFOption
0 - Setzt ganz normal den Text mit dem vorher eingebundenen Font
1 - Gibt die breite des auszugebenen Text in Pixel zurueck
2 - Gibt die Zeichenhoehe zurueck
3 - !:Gibt den fuer die Fontdaten genutzen Speicher wieder frei
Example:
'SPrint (X, Y, Text$, Farbe, OutPtr, Option)
'Schreibt ab position 100x100 pixel den Text 'Hallo Welt' in Weiss
SPrint 100,100,"Hallo Welt"
'Die Laenge von Hallo Welt in Pixel ausgeben lassen
Dim TextLaenge as Integer
TextLaenge=SPrint (0,0,"Hallo Welt",,,1)
'/
#IfNDef SFont_Data
Type SFont_Data
ChrHeigth as UByte ptr
ChrWidth as UByte ptr
ChrData as UInteger ptr
End Type
#EndIf
#IfNDef SPrintFontData
'#Error -SPFF not defined
#Define SPrintFontData Return 0
#EndIf
Function SPrint (BYVAL PositionX AS INTEGER, _
BYVAL PositionY AS INTEGER, _
BYVAL Text AS STRING, _
BYVAL Farbe AS UINTEGER=&hFFFFFFFF, _
BYREF DrawBuffer AS ANY PTR=0, _
BYVAL SPFFOption as Integer=0) as Integer
Static SFont as SFont_Data
Select Case SPFFOption
Case 0 'Normal Output
If Trim(Text)="" Then Return 0
''Objekt/Buffergroesse ermitteln
DIM GetInteger AS INTEGER PTR=DrawBuffer
'Groesse des Buffer in den Gezeichnet werden soll
DIM DrawBufferVersion AS INTEGER
DIM DrawBufferSizeX AS INTEGER
DIM DrawBufferSizeY AS INTEGER
'Wenn DrawBuffer=0 dann direkt auf den Screen zeichnen
IF DrawBuffer=0 OR DrawBuffer=SCREENPTR THEN
SCREENINFO DrawBufferSizeX,DrawBufferSizeY
DrawBuffer=0
ELSE
'..sonst Groesse des Buffers ermitteln in den gezeichnet werden soll
GetInteger=DrawBuffer
DrawBufferVersion=GetInteger[0]
IF DrawBufferVersion<>&h7 THEN Return 0
DrawBufferSizeX=GetInteger[2]
DrawBufferSizeY=GetInteger[3]
END IF
DIM Text_laenge AS UShort
DIM Zeichen AS UByte
DIM AZeichen AS UShort
DIM APosition as UInteger=0
Text_laenge=LEN(Text)
If SFont.ChrHeigth=0 Then
'SFont=
SPrintFontData
End If
FOR AZeichen=0 TO Text_laenge-1
Zeichen=Text[AZeichen]
FOR Y AS INTEGER=0 TO SFont.ChrHeigth[0]-1
FOR X AS INTEGER=0 TO SFont.ChrWidth[Zeichen]-1
IF BIT(SFont.ChrData[(Zeichen*SFont.ChrHeigth[0])+Y],X) THEN
IF (PositionX+X+(APosition)) > -1 AND _
(PositionX+X+(APosition)) < DrawBufferSizeX AND _
(PositionY+Y) > -1 AND _
(PositionY+Y) < DrawBufferSizeY THEN
PSET DrawBuffer,(PositionX+X+APosition,PositionY+Y),Farbe
END IF
END IF
NEXT X
NEXT Y
APosition+=SFont.ChrWidth[Zeichen]
NEXT AZeichen
Return 0
Case 1 'Ermitteln der Textlaenge in Pixeln
Dim TLen as UInteger=0
If Trim(Text)="" Then Return 0
If SFont.ChrHeigth=0 Then
'SFont=
SPrintFontData
End If
For C as Integer=0 to Len(Text)-1
TLen += SFont.ChrWidth[Text[C]]
Next C
Return TLen
Case 2 'Rueckgabe der Zeichenhoehe
If SFont.ChrHeigth=0 Then
'SFont=
SPrintFontData
End If
Return SFont.ChrHeigth[0]
Case 3 ' Speicher wieder freigeben
If SFont.ChrHeigth=0 Then Return 0
With SFont
Deallocate (.ChrHeigth)
Deallocate (.ChrWidth)
Deallocate (.ChrData)
End With
SFont.ChrHeigth=0
SFont.ChrWidth=0
SFont.ChrData=0
Return 0
End Select
END Function