Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
FBVF_Editor.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 15.03.2010 21:51:59 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts FBVectorFont, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'####################################################################################################################################
#include once "FBVectorFont.bi" 'Font-Modul includieren
'####################################################################################################################################
ScreenRes 800, 600, 32 'Wenn kein Fehler entstand, dann Drawfläche erzeugen
Dim TASC as String 'ASCII-Variable für InKey
Dim TASC1 as UByte '-||-
Dim TASC2 as UByte '-||-
Dim TMouseR as Integer 'Mause-Variable
Dim TMouseX as Integer '-||-
Dim TMouseY as Integer '-||-
Dim TMouseZ as Integer '-||-
Dim TMouseB as Integer '-||-
Dim TMouseXL as Integer '-||-
Dim TMouseYL as Integer '-||-
Dim TMouseBL as Integer '-||-
Dim TMouseXP as Integer '-||-
Dim TMouseYP as Integer '-||-
Dim TSelChr as UByte = 65 'Variable die angibt, welches Font-Chr selektiert wurde
Dim TReDraw as UByte = 1 'Zeigt an, ob neu gezeichnet werden soll.
Dim TString as String = "ABCDEFGHIJ" 'Anzuzeigender Text
Dim TChrWidth as UInteger 'Für Neuzeichnen nötig
Dim TChrHeight as UInteger '-||-
Dim TStringWidth as UInteger '-||-
Dim TStringHeight as UInteger '-||-
Dim TStringOffX as UInteger '-||-
Dim TStringOffY as UInteger '-||-
Dim TPointListDX() as UInteger 'Für Edit-Modus
Dim TPointListDY() as UInteger '-||-
Dim TPointListC as UInteger '-||-
Dim XRaster as UInteger = 10 'Rastergrösse
Dim XRasterSteps as UInteger = FBVF_INT_FontMaxWidth 'Rasterschritte
Dim X as UInteger 'Temporäre Variable
Dim Y as UInteger '-||-
Dim XW as UInteger = 10 '-||-
Dim XH as UInteger = 46 '-||-
Dim TPointListID as UInteger = 1 '-||-
Dim TPointID as UInteger '-||-
Dim TFPointX as UInteger '-||-
Dim TFPointY as UInteger '-||-
Dim TFontID as UInteger 'Variable für die FontID
Dim RV as FBVF_GuruCode_Enum 'Return-Code Variable
RV = FBVF_LoadFile("test.fvf", TFontID) 'Versuche eine FBVectorFont-Datei zu laden
If RV <> FBVF_GURU_NoError Then 'Wenn dies fehlschlägt...
RV = FBVF_LoadFileHuman("test.txt", TFontID) '... Versuche ein 'txt' zu importieren
If RV <> FBVF_GURU_NoError Then 'Wenn dies fehlschlägt...
RV = FBVF_New(TFontID, "Test", 1) '... Ein neues Font erzeugen
If RV <> FBVF_GURU_NoError Then Print "[ERROR] "; RV: End -1 'Wenn dies fehlschlägt, Fehler ausgeben und Programm beenden
RV = FBVF_PointList_Add(TFontID, TSelChr, TPointListID) 'Neue Point-Liste erzeugen
End If
End If
Dim TMode as UByte = 1 'Programm Arbeitsmodus (Edit)
Dim TMonoMode as Ubyte = 0 'Monospace-Mode
Dim TMovePLID as UInteger 'Speichert die Punktliste des zu verschiebenden Punktes
Dim TMovePID as UInteger 'Speichert die PunktID des zu verschiebenden Punktes
Dim TAutor as String
Dim TVersion as UInteger
Dim TRevision as UInteger
Dim TEditCount as UInteger
RV = FBVF_GetFontInfo(TFontID, TAutor, TVersion, TRevision, TEditCount) 'Font-Datei Informationen abfragen
RV = FBVF_Point_FillPointGet(TFontID, TSelChr, TPointListID, TFPointX, TFPointY) 'Füllpunkt erfragen
RV = FBVF_Point_GetList(TFontID, TSelChr, TPointListDX(), TPointListDY(), TPointListC) 'Liste aller Punkte einhohlen
Do
TASC = InKey() 'InKey abfragen
If Len(TASC) > 0 Then TASC1 = TASC[0] Else TASC1 = 0 'ASCII-Code 1 zwischenspeichern
If Len(TASC) > 1 Then TASC2 = TASC[1] Else TASC2 = 0 'ASCII-Code 2 zwischenspeichern
TMouseR = GetMouse(TMouseX, TMouseY, TMouseZ, TMouseB) 'Maus-Daten erfassen
Select Case TASC1 'Prüfen, welche Taste gedrückt wurde
Case 0 'Keine Taste
Case 27 'ESC
Exit Do 'Schleife verlassen
Case 32 'Space
RV = FBVF_Point_FillPointSet(TFontID, TSelChr, TPointListID, TMouseXP, TMouseYP) 'Füllpunkt setzen
RV = FBVF_Point_FillPointGet(TFontID, TSelChr, TPointListID, TFPointX, TFPointY) 'Füllpunkt erfragen (eigentlich unnötig, nur zur demo)
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 13 'Enter
RV = FBVF_PointList_Add(TFontID, TSelChr, TPointListID) 'Neue Point-Liste erzeugen
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 48 to 57, 65 to 90, 97 to 122 '0-9, A-Z, a-z
TSelChr = TASC1 'Neues Zeichen selektieren
RV = FBVF_Point_GetList(TFontID, TSelChr, TPointListDX(), TPointListDY(), TPointListC)
If TPointListC = 0 Then RV = FBVF_PointList_Add(TFontID, TSelChr, TPointListID) 'Neue Point-Liste erzeugen
RV = FBVF_Point_FillPointGet(TFontID, TSelChr, TPointListID, TFPointX, TFPointY) 'Füllpunkt erfragen (eigentlich unnötig, nur zur demo)
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 255
Select Case TASC2 'ASCII-Code 2 auswerten
Case 107 'X-Knopf
Exit Do 'Schleife verlassen
Case 59 'F1 (Load)
RV = FBVF_LoadFile("test.fvf", TFontID) ''FBVectorFont'-Datei Laden
RV = FBVF_GetFontInfo(TFontID, TAutor, TVersion, TRevision, TEditCount) 'Neue Font-Informationen laden
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 60 'F2 (Save)
Kill "test.fvf"
RV = FBVF_SaveFile("test.fvf", TFontID) 'Font als 'FBVectorFont'-Datei abspeichern
RV = FBVF_GetFontInfo(TFontID, TAutor, TVersion, TRevision, TEditCount) 'Neue Font-Informationen laden
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 61 'F3 (Import)
RV = FBVF_LoadFileHuman("test.txt", TFontID) ''Menschlich-Lesbare' TXT-Datei laden
RV = FBVF_GetFontInfo(TFontID, TAutor, TVersion, TRevision, TEditCount) 'Neue Font-Informationen laden
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 62 'F4 (Export)
Kill "test.txt"
RV = FBVF_SaveFileHuman("test.txt", TFontID) 'Datei als 'Menschlich-Lesbare' TXT-Datei abspeichern
RV = FBVF_GetFontInfo(TFontID, TAutor, TVersion, TRevision, TEditCount)
Case 63 'F5 (Draw)
TMode = 0
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 64 'F6 (Move)
TMode = 1
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
Case 65
If TMonoMode = 0 Then TMonoMode = 1 Else TMonoMode = 0
TReDraw = 1 'Und kentlich machen, das neu gezeichnet werden soll.
' Case else: Print TASC1; " - "; TASC2
End Select
' Case else: Print TASC1
End Select
If (TMouseR >= 0) and (TMouseX >= 0) and (TMouseY >= 0) and (TMouseB >= 0) Then
If (TMouseXL <> TMouseX) or (TMouseYL <> TMouseY) Then
If (TMouseX >= XW) and (TMouseX <= (XW + (XRaster * XRasterSteps))) Then
If (TMouseY >= XH) and (TMouseY <= (XH + (XRaster * XRasterSteps))) Then
TMouseXL = TMouseX
TMouseYL = TMouseY
TMouseXP = (TMouseXL + (XRaster / 2) - XW) \ XRaster
TMouseYP = (TMouseYL + (XRaster / 2) - XH) \ XRaster
If TMovePLID > 0 Then
RV = FBVF_Point_Edit(TFontID, TSelChr, TMovePLID, TMovePID, TMouseXP, TMouseYP)
RV = FBVF_Point_GetList(TFontID, TSelChr, TPointListDX(), TPointListDY(), TPointListC)
End If
TReDraw = 1
End If
End If
End If
If TMouseBL <> TMouseB Then
TMouseBL = TMouseB
Select Case TMode
Case 0 'Draw
Select Case TMouseB
Case 0 'Alle losgelassen
TMovePLID = 0
TMovePID = 0
Case 1 'Linke Maustaste
RV = FBVF_Point_Add(TFontID, TSelChr, TPointListID, TMouseXP, TMouseYP, TPointID)
RV = FBVF_Point_GetList(TFontID, TSelChr, TPointListDX(), TPointListDY(), TPointListC)
TReDraw = 1
Case 2 'Rechte Maustaste
'RV = FBVF_Point_Del(TFontID, TSelChr, TPointID)
RV = FBVF_Point_GetList(TFontID, TSelChr, TPointListDX(), TPointListDY(), TPointListC)
TReDraw = 1
End Select
Case 1 'Move
Select Case TMouseB
Case 0 'Alle losgelassen
TMovePLID = 0
TMovePID = 0
Case 1 'Linke Maustaste
If TMovePLID = 0 Then RV = FBVF_Point_GetPLPID(TFontID, TSelChr, TMouseXP, TMouseYP, TMovePLID, TMovePID)
Case 2 'Rechte Maustaste
End Select
End Select
End If
End If
PX = 50
If TReDraw = 1 Then 'Soll neu gezeichnet werden?
TReDraw = 0 'Variable zurücksetzen
Screenlock 'Screen sperren (schützt vor flimmern)
Line (0, 0)-(800, 600), &H0, BF 'Screen leeren
Draw String (2, 2), "F1=Load (test.fvf) F2=Save (.fvf) F3=Import (.txt) F4=Export (.txt) 0-9,A-Z,a-z=CharSelect", &HFFFFFF
Draw String (2, 15), "F5=Draw F6=Move F7=Toggle Monospace Drawing", &HFFFFFF
Select Case TMode
Case 0: Draw String (15, 32), "[DRAW]", &HFFFFFF
Case 1: Draw String (15, 32), "[MOVE]", &HFFFFFF
End Select
Draw String (100, 32), "ChrID: " & TSelChr & " ASCII: >" & Chr(TSelChr) & "<", &HFFFFFF
Draw String (400, 50), "Autor: " & TAutor, &HFFFFFF
Draw String (400, 60), "Version: " & TVersion, &HFFFFFF
Draw String (400, 70), "Revision: " & TRevision, &HFFFFFF
Draw String (400, 80), "Editcount: " & TEditCount, &HFFFFFF
Line (XW - 2, XH - 2)-(XW + (XRaster * XRasterSteps) + 2, XH + (XRaster * XRasterSteps) + 2), &HFF0000, B 'Rasterrahmen erzeugen
RV = FBVF_DrawChr(TFontID, TSelChr, XW, XH, , , , , &HFF0000, &H0000FF, XRaster) 'Gewähltes Zeichen in V_MultipleSize=XRastergröse zeichnen mit Rahmenfarbe=Rot und Füllung=Blau an Position X=XW Y=XH
RV = FBVF_DrawString(TFontID, TString, 10, 450, , , , ,&HFFFFFF , &HFFFFFF, 1, , TMonoMode) 'Einige Bustaben ausgeben
RV = FBVF_GetStringDimension(TFontID, TString, , , , 1, , TStringWidth, TStringHeight, TStringOffX, TStringOffY, TMonoMode) 'Grösse des zu zeichnenen Textes ermitteln
If TMonoMode = 0 Then 'und einen Rahmen um diesen ziehen
Line (8, 448)-(12 + TStringWidth, 452 + TStringHeight), &HFFFF00, B
Else: Line (8, 448 + TStringOffY)-(12 + TStringWidth, 452 + TStringOffY + TStringHeight), &HFFFF00, B
End If
RV = FBVF_DrawString(TFontID, TString, 10, 500, , , , ,&HFFFFFF , &HFFFFFF, 0.4, , TMonoMode) 'Einige Bustaben ausgeben
RV = FBVF_DrawString(TFontID, TString, 10, 530, , , , ,&HFFFFFF , &HFFFFFF, 0.3, , TMonoMode) 'Einige Bustaben ausgeben
RV = FBVF_DrawString(TFontID, TString, 10, 555, , , , ,&HFFFFFF , &HFFFFFF, 0.2, , TMonoMode) 'Einige Bustaben ausgeben
'Rasterfeld erzeugen
Line (XW - 2 + XRaster, XH - 2 + XRaster)-(XW + 2 + (XRaster * XRasterSteps) - XRaster, XH + 2 + (XRaster * XRasterSteps) - XRaster), RGB(0, 0, 127), B
Line (XW + 2 + XRaster, XH + 2 + (XRaster * (XRasterSteps - 6)) - XRaster)-(XW + 2 + (XRaster * XRasterSteps) - XRaster, XH + 2 + (XRaster * (XRasterSteps - 6)) - XRaster), RGB(0, 0, 127)
For Y = 0 to (XRaster * XRasterSteps) Step XRaster
For X = 0 to (XRaster * XRasterSteps) Step XRaster
PSet (XW + X, XH + Y), RGB(100, 100, 100)
Next
Next
Circle (XW + TFPointX * XRaster, XH + TFPointY * XRaster), 3, &H00FF00
Line (XW + (TFPointX * XRaster) - 5, XH + (TFPointY * XRaster))-(XW + (TFPointX * XRaster) + 5, XH + (TFPointY * XRaster)), &H00FF00
Line (XW + (TFPointX * XRaster), XH + (TFPointY * XRaster) - 5)-(XW + (TFPointX * XRaster), XH + (TFPointY * XRaster) + 5), &H00FF00
Line (XW + (TMouseXP * XRaster) - 7, XH + (TMouseYP * XRaster))-(XW + (TMouseXP * XRaster) + 7, XH + (TMouseYP * XRaster)), RGB(255, 255, 255)
Line (XW + (TMouseXP * XRaster), XH + (TMouseYP * XRaster) - 7)-(XW + (TMouseXP * XRaster), XH + (TMouseYP * XRaster) + 7), RGB(255, 255, 255)
For X as UInteger = 1 to TPointListC 'Zeichen Kreise um jeden Punkt
Circle (XW + TPointListDX(X) * XRaster, XH + TPointListDY(X) * XRaster), 3, &HFFFF00
Next
Screenunlock 'Screen entsperren
End If
Sleep 1, 1 'Ein Bisschen Schlafen, Schützt vor unnötiger CPU-Überlastung
Loop
RV = FBVF_Unload(TFontID) 'Am Ende das Font wieder entladen
'ACHTUNG! Beim Entladen, wird NICHT gespeichert!
Screen 0 'DrawFläche wieder schliessen
End 0 'Programm beenden.