Schreibschrift als Laufschrift (bb+) von ???
mit dem folgenden Programm kann man eine Textzeile in Schreibschrift malen und diese dann in verschiedenen Geschwindigkeiten neu schreiben lassen.

mit "Aufzeichnen" beginnt der Spass, mit der linken Maustaste ins Canvas zeichnen, für eine Schreibpause kurz oder lange Pause drücken (auch mehrmals)
beenden mit "Ende Aufnahme"

mit "Zeichnen" kann man sich die Schrift nun ansehen

Tempo und Dicke verändern

"Clear" alles weg

mit Save wird das ganze in eine Datei geschrieben


Das zweite Programm (Zeichnen)kann man überall einbauen wenn man will und die Schreibschrift dann in eigene Programme einbinden
per Offset die Startposition der Schrift



[code:1:a9dabb9a63]
; Programm Schreibschrift Malen
; von Garfield Winfried Rothenberg 2003
Global Prog_Window_Width = 810 ; Hauptprogrammfenster maximale Breite
Global Prog_Window_Hight = 600 ; Hauptprogrammfenster maximale Höhe
Global main_window = CreateWindow("Programm XYZ",(ClientWidth(Desktop())-Prog_Window_Width)/2,(ClientHeight(Desktop())-Prog_Window_Hight)/2,Prog_Window_Width,Prog_Window_Hight,0,15)
SetStatusText main_window,Prog_Window_Width + " x " + Prog_Window_Hight ; Anzeige wie groß das Fenster ist

Type Schrift
Field x
Field y
End Type

Global Tempo = 1
Global Dicke = 5
Global cr = 200 ; Farbe
Global cg = 200
Global cb = 100

Global Can1 = CreateCanvas (5,0,800,150,main_window)
SetBuffer CanvasBuffer(Can1)

Global Slider_Tempo = CreateSlider(250,230,250,10,main_window)
SetSliderRange(Slider_Tempo,1,10)
SetSliderValue (Slider_Tempo,10-Tempo)
Global Label_Tempo = CreateLabel("Tempo",200,228,40,20,main_window)
Global Tempotext = CreateLabel(Tempo,510,228,40,20,main_window)
Global Slider_Dicke = CreateSlider(250,270,250,10,main_window)
SetSliderRange(Slider_Dicke,1,10)
SetSliderValue (Slider_Dicke,Dicke)
Global Label_Dicke = CreateLabel("Dicke",200,268,40,20,main_window)
Global DickeText = CreateLabel(Dicke,510,268,40,20,main_window)

Global But1 = CreateButton("Aufzeichnen",25,180,100,25,main_window,1)
Global But2 = CreateButton("Zeichnen",365,180,140,25,main_window,1)
Global But3 = CreateButton("Ende Aufnahme",135,180,100,25,main_window,1)
Global But4 = CreateButton("Clear",265,180,60,25,main_window,1)
Global But5 = CreateButton("Ende",665,180,100,25,main_window,1)
Global But6 = CreateButton("Save",535,180,100,25,main_window,1)
Global But7 = CreateButton("kurze Pause",125,152,100,25,main_window,1)
Global But8 = CreateButton("lange Pause",235,152,100,25,main_window,1)


Mainprogramm()
End

; Hauptprogramm
Function Mainprogramm()
Repeat

id=WaitEvent()
MB = EventData()
ES = EventSource()
Select EventID()

Case $401
Select ES
Case But1 : Aufnahme()
Case But2 : Zeichnen()
Case But4 : clear()
Case but5 :End
Case But6 : Save()
Case Slider_Tempo : Tempo_Set()
Case Slider_Dicke : Dicke_Set()
End Select
End Select

If KeyDown(1) Then End

Forever

End Function

End

Function Aufnahme()
Cls
FlipCanvas can1
Repeat
id=WaitEvent()

MB = EventData()
ES = EventSource()
Select EventID()
Case $401
If ES = But3 Then SetStatusText main_window,"ENDE " : Cls : FlipCanvas can1:Exit
If ES = But7
For x = 1 To 100
ZS.Schrift = New Schrift
ZSX = XOLD; zeichnen auf einen Punkt der schon da war
ZSY = YOLD
Next
End If
If ES = But8
For x = 1 To 200
ZS.Schrift = New Schrift
ZSX = XOLD; zeichnen auf einen Punkt der schon da war
ZSY = YOLD
Next
End If
Case $201:SetStatusText main_window,"Aufnahme......"
If ES = Can1

While Not KeyDown(1)
id=WaitEvent(0)
MB = EventData()
ES = EventSource()

Select EventID()
Case $202 : Exit
End Select

XOLD = ZX : ZX = MouseX(Can1)
YOLD = ZY : ZY = MouseY(Can1)
If (ZX - XOLD) Or (ZY - YOLD) <> 0
ZS.Schrift = New Schrift
ZSX = ZX
ZSY = ZY
Zeichnen_para(ZSX,ZSY)
End If
Wend
End If
End Select
If KeyDown(1) Then Exit
Forever
End Function

Function Zeichnen_para(xx,yy)
Oval (xx,yy,Dicke,Dicke,1)
FlipCanvas can1
End Function

Function Zeichnen()
Cls
Color cr,cg,cb
FlipCanvas can1
For ZS.Schrift = Each Schrift
Oval (ZSX,ZSY,Dicke,Dicke,1)
Delay Tempo
FlipCanvas can1
Next
End Function

Function Clear()
For ZS.Schrift = Each Schrift
Delete ZS
Next
End Function

Function Tempo_Set()
Tempo = SliderValue(Slider_Tempo)
Tempo = 10 - Tempo
SetGadgetText Tempotext,Tempo
End Function

Function Dicke_Set()
Dicke = SliderValue(Slider_Dicke)
SetGadgetText DickeText,Dicke
End Function

Function Save()
Datei = WriteFile("Schrift.szs")
WriteShort (Datei,Tempo)
WriteShort (Datei,Dicke)
WriteShort (Datei,cr)
WriteShort (Datei,cg)
WriteShort (Datei,cb)
For ZS.Schrift = Each Schrift
WriteShort (Datei,ZSX)
WriteShort (Datei,ZSY)
Next
CloseFile Datei
End Function[/code:1:a9dabb9a63]

[code:1:a9dabb9a63]
; Programm Zeichnen
; von Garfield Winfried Rothenberg 2003

Graphics 800,400
SetBuffer BackBuffer()

Offset_X = 10 ; OFFSET
Offset_Y = 100

Type Schrift
Field x
Field y

End Type
Datei = ReadFile("Schrift.szs")
Tempo = ReadShort(Datei)
Dicke = ReadShort(Datei)
cr = ReadShort(Datei)
cg = ReadShort(Datei)
cb = ReadShort(Datei)

While Not Eof(Datei)
ZS.Schrift = New Schrift
ZSX = ReadShort(Datei)
ZSY = ReadShort(Datei)
Wend
CloseFile Datei
Cls

Color cr,cg,cb

For ZS.Schrift = Each Schrift

Oval (ZSX+Offset_X,ZSY+Offset_Y,Dicke,Dicke,1)
Delay Tempo
Flip
Next


WaitKey()
End
[/code:1:a9dabb9a63]



Suche:
(unterstützt mySQL Wildcards ala %)
Titel:
Text:
Autor: