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] |