allgemein für PureBasic-Anwenungen und Spiele.
http://www.youtube.com/watch?v=d7eGypGOlOc
Kann Kreise, Linien, Karos erkennen.
Rechtecke noch nicht. Hatte zwei Jahre nicht mehr dran gearbeitet,
deshalb stelle ich es jetzt für alle zur Verfügung, vielleicht kann
jemand das gebrauchen.
StrokeIT, gibt es wohl auch als SDK zum Einbinden.
Ob es jetzt einfacher ist, irgendwie einen Wrapper für StrokeIT zu
schreiben oder meinen Anfang etwas zu erweitern. ... keine Ahnung.
Einfach mal ausprobieren und genießen
Code: Alles auswählen
; 2007-06-14 - Hand Writing Recognition
; Folker Linstedt
EnableExplicit
Procedure GetMousePoints(GadID.l,Window.l,*xy.POINT)
*xy\x=-1
*xy\y=-1
*xy\x=WindowMouseX(Window)-GadgetX(GadID)
*xy\y=WindowMouseY(Window)-GadgetY(GadID)
EndProcedure
Procedure.b MouseOverGadget(GadID.l, Window.l)
Static result.b
Static MP.POINT
result = 0
GetMousePoints(GadID, Window, @MP)
If (MP\x=>0) And (MP\x <=GadgetWidth(GadID)): result+1: EndIf ; Wenn Resultat = 1, dann X-Bereich
If (MP\y>=0) And (MP\y <=GadgetHeight(GadID)): result+2: EndIf ; wenn Resultat = 2, dann y-Bereich
; wenn Resultat = 3, befindet sich die Mouse im Feld
ProcedureReturn result
EndProcedure
Procedure.b MouseWindowButton()
Static result
If GetAsyncKeyState_(#VK_LBUTTON)
result=1
ElseIf GetAsyncKeyState_(#VK_RBUTTON)
result=2
ElseIf GetAsyncKeyState_(#VK_MBUTTON)
result=3
Else
result=0
EndIf
ProcedureReturn result
EndProcedure
;/ ********************** Zeichenfunktionen ********************
Procedure.f GSin(winkel.f)
; Eingabe: Winkel ( 0 - 360 )
; Ausgabe: Sinus vom Winkel
ProcedureReturn Sin(winkel*(2*3.14159265/360))
EndProcedure
Procedure.f GCos(winkel.f)
; Eingabe: Winkel ( 0 - 360 )
; Ausgabe: Cosinus vom Winkel
ProcedureReturn Cos(winkel*(2*3.14159265/360))
EndProcedure
Procedure LineArc (x1.l, y1.l, grad.f,L.f,f.l)
grad=grad+90
LineXY(x1,y1,x1+GSin(grad)*L,y1+GCos(grad)*L, f)
EndProcedure
Procedure.l LineXYL(x1.l,y1.l,x2.l,y2.l,L.f,f.l=#White) ; Wenn Linie #TRUE dann ist sie min. so lang, dass sie den Punkt X2, Y2 durchdringt
Static vx.f
Static vy.f
vx=x2-x1
vy=y2-y1
L.f=Sqr(vx*vx+vy*vy)
EndProcedure
Procedure bezier(x1.l,y1,x2,y2,x3,y3,x4,y4,Color)
; German forum: http://www.purebasic.fr/german/archive/viewtopic.php?t=2515&highlight=
; Author: Rob (updated for PB4.00 by blbltheworm)
; Date: 09. October 2003
Static oldx.l : oldx = x1
Static oldy.l : oldy = y1
Static cx.f : cx = 3*(x2-x1)
Static bx.f : bx = 3*(x3-x2)-cx
Static ax.f : ax = x4-x1-cx-bx
Static cy.f : cy = 3*(y2-y1)
Static by.f : by = 3*(y3-y2)-cy
Static ay.f : ay = y4-y1-cy-by
Static i.f=0
Static x.l, y.l
While i.f < 1
i+0.05
x=((ax*i+bx)*i+cx)*i+x1
y=((ay*i+by)*i+cy)*i+y1
If i>0: LineXY(oldx,oldy,x,y,Color) : EndIf ; Länge ermitteln und addieren
oldx=x
oldy=y
Wend
EndProcedure
Procedure FL_Bezier(x1.l,y1.l,x2.l,y2.l,Rx1.l,Ry1.l,Rx2.l,Ry2.l,f.l)
bezier(x1,y1, x1+Rx1,y1+Ry1, x2+Rx2,y2+Ry2,x2,y2,F)
EndProcedure
Enumeration
#MainWin
#Eingabe
#Eingabe2
EndEnumeration
#Leer1 = #Eingabe +50
#Leer2 = #Eingabe2 +50
#Liste1A=#Eingabe+100
#Liste1B=#Eingabe+110
#Liste1C=#Eingabe+120
#Liste1D=#Eingabe+130
#Spin1 =#Eingabe+ 60
#Editor = #Eingabe+40
#EditorX = #Eingabe+30
#Editor2 = #Eingabe2+40
#Liste1E=#Eingabe+140
#Liste2A=#Eingabe2+100
#Liste2B=#Eingabe2+110
#Liste2C=#Eingabe2+120
#Liste2D=#Eingabe2+130
#Spin2 =#Eingabe2+ 60
Define Event.l
Define EventType.l
Define GadgetNr.l
Define PunktE1.POINT, PunktE2.POINT
Define StartTime, EndTime
NewList MausPunkte.POINT()
;Global NewList GadgetFarben()
Procedure Erstelle(Gadget.l,x.l,y.l,xl.l,yl.l,f.l=#Blue,f2.l=#White)
CreateImage(Gadget,xl,yl)
StartDrawing(ImageOutput(Gadget))
Box(0,0,xl,yl,f2)
StopDrawing()
ImageGadget(Gadget,x,y,xl,yl,ImageID(Gadget),#PB_Image_Border)
SetGadgetData(Gadget,f)
EndProcedure
Procedure.l Zeichnen(Gadget.l, GadgetN.l, Window.l, *PA.POINT,MWB.l);,*PA.POINT)
Static PN.POINT
Static result.l
If MouseOverGadget(Gadget,Window)=3 And MWB=1
result=1
GetMousePoints(Gadget, Window,@PN)
StartDrawing(ImageOutput(Gadget))
;/
If *PA\x<>-1
If Not ((*PA\x=PN\x And *PA\y=PN\y) )
LineXY(PN\x,PN\y,*PA\x,*PA\y,Random($FFFFF))
Circle(PN\x,PN\y,4,Random($FFFFF))
AddGadgetItem(Gadget+110,-1,Str(PN\x)+":"+Str(PN\y)+":")
SetGadgetState(Gadget+60,CountGadgetItems(Gadget+110))
EndIf
Else
Circle(PN\x,PN\y,3,GetGadgetData(Gadget))
; erster Klick
ClearGadgetItemList(Gadget+110)
AddGadgetItem(Gadget+100,-1,Str(PN\x)+":"+Str(PN\y)+":")
EndIf
StopDrawing()
SetGadgetState(Gadget, ImageID(Gadget))
;/
Else
result=0
PN\x=-1
; Ende
EndIf
*PA\x=PN\x
*PA\y=PN\y
ProcedureReturn result
EndProcedure
Procedure LeereMalfeld(Gadget.l,GadgetN.l,f.l,A.b=0)
If Gadget=GadgetN Or A
StartDrawing(ImageOutput(Gadget-50))
Box(0,0,GadgetWidth(Gadget-50),GadgetHeight(Gadget-50),f)
StopDrawing()
SetGadgetState(Gadget-50,ImageID(Gadget-50))
If Not A
ClearGadgetItemList(Gadget+50)
EndIf
EndIf
EndProcedure
;/ Haupt-Engine!!!
Procedure HWR_Engine(Gadget.l) ; Drawing
Static i.l, L.l, j.l, j2.l, Toll, lx.l
Static ma_x.l, mi_x.l, ma_y.l, mi_y.l, qx.l, qy.l
Static ax.l, ex.l, ay.l, ey.l, xl.f, yl.f,r.l,gl.f,rl.f, rotzugr.f, gelbzubl.f,l1.f,l2.f
Static Text$
Dim Popu.l(12,12) ; Population der Punkte in einem 12 x 12 Raster
Dim Pop2.l(1,13) ; Summenhäufigkeit in Zeilen und Spalten, an Pos 12 steht die Position des Maximums, 13 Pos. d. Min.
; Buchstaben lassen sich darstellen durch; ( ) | U O \ / -
; Ein fallschrummes U gibt es nicht. für 2 = U.unten /-
; Beispiele: R = |) D = |) V = \/ W = UU oder VV P = |D E = |--- A = /\- T = |- M = /\/\ Q = O\ 3 = )) S = () B = DD J = |U G = (-
; |\ R = |D\
; X = \/ L = |- + = |- F = |-- 7 = -/ Z = -/- = 7- 1 = /|
; große Buchstaben sind einfach, Zahlen etwas schwerer
; Die Grundformen müssen natürlich im Verhältnis zu einander betrachtet werden, damit P und D oder auch L und T sich unterscheiden lassen
Debug "Render"
L=GetGadgetState(Gadget+60) ; Wenn geklickt worden ist
If L>0 ;/ erstes IF
Dim XY.POINT(L)
For i=0 To L-1
XY(i)\x=Val(StringField(GetGadgetItemText(Gadget+110,i,0),1,":")) ; Liste B
XY(i)\y=Val(StringField(GetGadgetItemText(Gadget+110,i,0),2,":"))
Next
ma_x=0
mi_x=0
ma_y=0
mi_y=0
For i=0 To L-1
If XY(ma_x)\x<XY(i)\x
ma_x=i
EndIf
If XY(ma_y)\y<XY(i)\y
ma_y=i
EndIf
If XY(mi_x)\x>XY(i)\x
mi_x=i
EndIf
If XY(mi_y)\y>XY(i)\y
mi_y=i
EndIf
Next
xl=XY(ma_x)\x-XY(mi_x)\x
yl=XY(ma_y)\y-XY(mi_y)\y
StartDrawing(ImageOutput(Gadget))
Box(0,0,GadgetWidth(Gadget),GadgetHeight(Gadget),#White)
Box(XY(mi_x)\x ,XY(mi_y)\y ,xl,yl,RGB(240,240,255))
For j=0 To 3
LineXY(XY(mi_x)\x ,XY(mi_y)\y + yl/3*j, XY(ma_x)\x,XY(mi_y)\y + yl/3*j,#Blue)
LineXY(XY(mi_x)\x + xl/3*j ,XY(mi_y)\y, XY(mi_x)\x + xl/3*j, XY(ma_y)\y,#Blue)
Next
For j=0 To 2 ; Felder markieren, in denen Punkte sind! mit Anzahl evtl.
LineXY(XY(mi_x)\x + xl/3*j+xl/6 ,XY(mi_y)\y, XY(mi_x)\x + xl/3*j+ xl/6, XY(ma_y)\y,RGB(200,200,255))
LineXY(XY(mi_x)\x ,XY(mi_y)\y + yl/3*j +yl/6, XY(ma_x)\x,XY(mi_y)\y + yl/3*j + yl/6,RGB(200,200,255))
Next
;/ Auswertung in der Darstellung
gl=Sqr(xl*xl+yl*yl)
;/
If xl>yl
r=xl/50
Else
r=yl/50
EndIf
For i=0 To L-1
Circle(XY(i)\x,XY(i)\y,r,RGB(192,192,192)) ; Zeichnet eine Linie aus Punkten in hellgrau
Next
;LineXY(XY(ma_x)\x,XY(ma_y)\y,XY(mi_x)\x,XY(mi_y)\y,#Green) ; Wenn grüne und rote Linie ca. gleichlang sind, dann ist es eine Linie (oder ein L, Z, 2, 9)
LineXY(XY(0)\x,XY(0)\y,XY(L-1)\x,XY(L-1)\y,#Red) ; Wenn rote Linie sehr kurz ist und grüne sehr lang, ist es eine geschlossene Figur
; von links nach rechts
ax.l= XY(ma_x)\x
ex.l=XY(mi_x)\x
ay.l= XY(ma_y)\y
ey.l=XY(mi_y)\y
If XY(0)\y<XY(L-1)\y
Swap ay, ey ; von unten nach oben
EndIf
If XY(0)\x<XY(L-1)\x
Swap ax, ex ; von unten nach oben
EndIf
LineXY(ax,ay,ex,ey,#Green) ; Grüne Linie, im Idealfall verdeckt sie die rote Linie
;LineXY(XY(0)\x,XY(0)\y,XY(l-1)\x,XY(l-1)\y,#Red)
;AddGadgetItem(#Editor,-1,"Len GreenLine: "+Chr(10)+Str(Sqr((ex-ax)*(ex-ax)+(ey-ay)*(ey-ay))))
rl=Sqr( (XY(L-1)\x-XY(0)\x)*(XY(L-1)\x-XY(0)\x) + (XY(L-1)\y-XY(0)\y) * (XY(L-1)\y-XY(0)\y))
gelbzubl=Sqr( (ax-XY(0)\x)*(ax-XY(0)\x) + (ay-XY(0)\y) * (ay-XY(0)\y))
rotzugr=Sqr( (ex-XY(L-1)\x)*(ex-XY(L-1)\x) + (ey-XY(L-1)\y) * (ey-XY(L-1)\y))
l1=gelbzubl
l2=rotzugr
If gelbzubl>rotzugr
Swap l1, l2
EndIf
Circle(ax,ay,9,#Blue) ; Anfang Ausmaß
Circle(XY(0)\x,XY(0)\y,6,#Red)
Circle(XY(0)\x,XY(0)\y,4,#Yellow) ; Anfang Zeichnung
Circle(ex,ey,8,#Green) ; Ende Ausmaß
Circle(XY(L-1)\x,XY(L-1)\y,4,#Red) ; Ende Zeichnung
If CountGadgetItems(#Editor)>35
ClearGadgetItemList(#Editor)
ClearGadgetItemList(#Editor2)
EndIf
AddGadgetItem(#Editor,0,"- - - - - - - - -")
AddGadgetItem(#Editor,0,"Len GreenLine:"+RSet(Str(gl),3))
AddGadgetItem(#Editor,0,"Len Red-Line:"+RSet(Str(rl),3))
AddGadgetItem(#Editor,0,"Len 1st Pos.:"+RSet(Str(l1),3))
AddGadgetItem(#Editor,0,"Len last Pos.:"+RSet(Str(l2),3))
AddGadgetItem(#Editor2,0,"- - - - - - - - -")
AddGadgetItem(#Editor2,0,"% GreenLine :"+RSet(Str(100),3))
AddGadgetItem(#Editor2,0,"% Red-Line :"+RSet(Str(rl/gl*100),3))
AddGadgetItem(#Editor2,0,"% 1st Pos. :"+RSet(Str(l1/gl*100),3))
AddGadgetItem(#Editor2,0,"% last Pos. :"+RSet(Str(l2/gl*100),3))
If xl<20
DrawText(XY(mi_x)\x-20,XY(ma_y)\y,Str(yl),0,RGB(255,128,0))
Else
DrawText(XY(mi_x)\x,XY(ma_y)\y,Str(yl),0,RGB(255,128,0))
EndIf
If yl>13
DrawText(XY(ma_x)\x,XY(mi_y)\y,Str(xl),0,RGB(255,128,0))
Else
DrawText(XY(ma_x)\x,XY(mi_y)\y-13,Str(xl),0,RGB(255,128,0))
EndIf
DrawText(XY(ma_x)\x,XY(ma_y)\y,StrF(xl/yl,2),0,RGB(128,255,0))
DrawText(XY(mi_x)\x-20,XY(mi_y)\y-20,StrF(gl,2),0,RGB(0,128,255))
StopDrawing()
SetGadgetState(Gadget,ImageID(Gadget))
;/ Population ermitteln, Darstellung prozentual an der gesamten Menge an Punkten, wer langsam zeichnet, macht mehr Punkte
For j=0 To 11
For j2=0 To 11
Popu(j,j2)=0
Next
Next
r=0
If xl/12> 0 And yl/12>0 ;/ Zweites IF
For i=0 To L-1
qx=Round((XY(i)\x-XY(mi_x)\x)/(xl/12),0)
qy=Round((XY(i)\y-XY(mi_y)\y)/(yl/12),0)
If qy>=12
qy=11
EndIf
If qx>=12
qx=11
EndIf
Popu(qx,qy)+1 ; maximale Population
If Popu(qx,qy)>r
r=Popu(qx,qy)
EndIf
Next
EndIf ;/ Zweites EndIF , hier neu eingefügt
i=0
For j=0 To 12
For j2=0 To 12
If Popu(j,j2)>0
SetGadgetItemColor(#Liste1E,j2,#PB_Gadget_BackColor,RGB((L/r)*Popu(j,j2)*(255/L),255-(L/r)*Popu(j,j2)*(255/L),(L/r)*Popu(j,j2)*(255/L)),j)
Else
SetGadgetItemColor(#Liste1E,j2,#PB_Gadget_BackColor,RGB(240,255,240),j)
EndIf
If j2>11 Or j>11
SetGadgetItemColor(#Liste1E,j2,#PB_Gadget_BackColor,RGB(255,230,255),j)
EndIf
i+Popu(j,j2)
Next
Next
For j=0 To 11
For j2=0 To 11
SetGadgetItemText(#Liste1E,j,"",j2)
If Popu(j,j2)>0
Pop2(0, j)+1
EndIf
If Popu(j,j2)>0
Pop2(1,j2)+1
EndIf
Next
Next
For j=0 To 11
SetGadgetItemText(#Liste1E,12,Str(Pop2(0,j)),j)
;/ Max
If Pop2(0,Pop2(0,12))< Pop2(0,j)
Pop2(0,12)=j
EndIf
;/ Min
If Pop2(0,Pop2(0,13))> Pop2(0,j)
Pop2(0,13)=j
EndIf
SetGadgetItemText(#Liste1E,j,Str(Pop2(1,j)),12)
;/ Max
If Pop2(1,Pop2(1,12))< Pop2(1,j)
Pop2(1,12)=j
EndIf
;/ Min
If Pop2(1,Pop2(1,13))> Pop2(1,j)
Pop2(1,13)=j
EndIf
Next
SetGadgetItemColor(#Liste1E,Pop2(1,12),#PB_Gadget_BackColor,#Red,Pop2(0,12))
SetGadgetItemColor(#Liste1E,Pop2(1,12),#PB_Gadget_FrontColor,#White,Pop2(0,12))
SetGadgetItemText(#Liste1E,Pop2(1,12),"+",Pop2(0,12))
SetGadgetItemColor(#Liste1E,Pop2(1,13),#PB_Gadget_BackColor,#Blue,Pop2(0,13))
SetGadgetItemColor(#Liste1E,Pop2(1,13),#PB_Gadget_FrontColor,#White,Pop2(0,13))
SetGadgetItemText(#Liste1E,Pop2(1,13),"_",Pop2(0,13))
Text$="?"
If l1/gl*100 > rl/gl*100 ; keine Linie, eine geschlossene Figur
If rl/gl*100<18 ; Karo oder Kreis
If Pop2(0,12) = 0 Or Pop2(0,12) = 11 ; Überprüft, [+] in einer Ecke liegt
Text$="Kreis" ; Ecken dürfen keine Punkte enthalten, Alle vier Seiten müssen min. 4 Punkte enthalten
; schräge Halbkreis ; manchmal sind auch Karos Kreise
Else
Text$="Karo"
; Dreicke
EndIf
EndIf
;/
Else
Toll=6
If xl/yl<0.25
Text$="Senkrechte"
ElseIf xl/yl>2
Text$="Waagerechte"
Else
Toll=3
EndIf
; Tolleranz Probleme bei Linien in horizontaler bzw. vertikaler Lage
If l2/gl*100<Toll And l1/gl*100=0 And rl/gl*100=100 ; sehr wahrscheinlich eine Linie, mit Tolleranz
i=0
lx=0
For j=0 To 11
If Pop2(0,j)=3 ; 3 toleranzwert
i+1
EndIf
If Pop2(0,j)>3
L+1
EndIf
If Pop2(1,j)=3 ; 3 toleranzwert
i+1
EndIf
If Pop2(1,j)>3
lx+1
EndIf
Next
If i<2 And lx=0
Text$="Linie"
Else
Text$="Bogen" ; gewölbte Linie ; manchmal sind auch echte Linien Bögen???
EndIf
Else
If Text$="?"
Text$="unbekannt" ; auch besondere gewölbte Linien und Bögen
EndIf
EndIf
;/
EndIf
AddGadgetItem(#EditorX,0,Text$)
EndIf ;/ Erstes EndIF
EndProcedure
;/ ********************************************************************************
OpenPreferences("FLMAUSiX.ini")
Define WinPosX_MainWin.l=ReadPreferenceLong("WINDOW_XPOS_MAIN",50);
Define WinPosY_MainWin.l=ReadPreferenceLong("WINDOW_YPOS_MAIN",50);
ClosePreferences()
OpenWindow(#MainWin,WinPosX_MainWin,WinPosY_MainWin, 790,550,":: FL :: MAUSiX")
CreateGadgetList(WindowID(#MainWin))
Erstelle(#Eingabe,5,10,300,300)
PunktE1\x=-1
ButtonGadget(#Leer1, 20,320,50,20,"Leeren")
ListIconGadget(#Liste1A, 10,350,100,180,"Punkte",80)
ListViewGadget(#Liste1B,115,330,100,150)
SpinGadget(#Spin1,115,490,100,25,0,1000,#PB_Spin_Numeric|#PB_Spin_ReadOnly)
ListIconGadget(#Liste1E,310,10,160,210,"",12,#PB_ListIcon_GridLines)
Define i.l
For i=0 To 11
AddGadgetColumn(#Liste1E,i+1,"",12)
AddGadgetItem(#Liste1E,-1,"")
SetGadgetItemColor(#Liste1E,i,#PB_Gadget_BackColor,RGB(128,20*i,255-10*i))
Next
AddGadgetItem(#Liste1E,-1,"")
ListViewGadget(#Liste1C,220,320,90,100)
ListViewGadget(#Liste1D,220,430,90,100)
LoadFont(1,"Courier",5)
SetGadgetFont(#PB_Default,FontID(1))
EditorGadget(#Editor ,480,10,150,500)
EditorGadget(#Editor2,640,10,150,500)
EditorGadget(#EditorX,310,230,160,300)
StartDrawing(ImageOutput(#Eingabe))
;Box(20,10, 100,100,RGB(196,196,255))
;LineXY(20,10, 220,290,#Red)
;FL_Bezier(20,10, 220,290,400,0,-400,0,0)
;LineArc (100, 100, 45,50,#Red)
;LineArc (100, 100, 360,50,#Red)
;LineArc (100, 100, 90,50,#Red)
StopDrawing()
SetGadgetState(#Eingabe,ImageID(#Eingabe))
Define f.l
Define m.l
Define Ma.l
Repeat
Event= WaitWindowEvent()
If Event=#PB_Event_Gadget
GadgetNr=EventGadget()
Debug GadgetNr
LeereMalfeld(#Leer1,GadgetNr, #White)
LeereMalfeld(#Leer2,GadgetNr, #Yellow)
EndIf
m= MouseWindowButton()
EventType=EventType()
If EventType<>14002 ; bewegung der Maus
If Zeichnen(#Eingabe,GadgetNr,#MainWin, @PunktE1,m) ;Or Zeichnen(#Eingabe2,GadgetNr,#MainWin, @PunktE2,M)
Ma=1
EndIf
EndIf
If m<>1 And Ma; Maus wurde losgelassen
HWR_Engine(#Eingabe)
Ma=0
EndIf
GadgetNr=-1
Until Event=#PB_Event_CloseWindow Or GetAsyncKeyState_(#VK_ESCAPE)
CreatePreferences("FLMAUSiX.ini")
WritePreferenceLong("WINDOW_XPOS_MAIN",WindowX(#MainWin))
WritePreferenceLong("WINDOW_YPOS_MAIN",WindowY(#MainWin))
ClosePreferences()
CloseWindow(#MainWin)
