Code: Alles auswählen
; Lage des Cursors in Bezug zu einer geschlossenen Kontur
;
; Autor : alter Mann
; Datum : 11.11.08
;
; Demo
;
Structure lPkt
X.l
Y.l
EndStructure
#LONG_MIN =(-2147483647 - 1) ; minimum (signed) long value
#LONG_MAX =2147483647 ; maximum (signed) long value
EnableExplicit
;##############################################################################
;Funkt.: Lage eine Punktes in Bezug auf eine geschlossene Kontur
;E.Par.: X,Y Punktkoordinate
; Anz Anzahl Punkte der Kontur
; Kontur(1).lPkt Feld mit Punkten der Punktfolge
; Abs Randgenauigkeit
;F.Code: -2 falsche Eingabe
; -1 Punkt liegt aussen
; 0 Punkt liegt auf Rand
; 1 Punkt liegt innen
;##############################################################################
Procedure.l PBGeo_PktInKontur (X.l, Y.l, Anz.l, Kontur.lPkt(1), Abs.l)
Protected Ret.l=0, A0.l, A1.l, A2.l, Vx.l, Vy.l, i.l
Protected Abs2.q=Abs, A3.q, A4.q, A.q, H.q, Vx1.q,Vy1.q,Vx2.q,Vy2.q
Abs2 = Abs2*Abs2 + 1
If Anz < 3 And Abs < 0
ProcedureReturn -2
EndIf
; Anfangspunkt auf gleicher Hoehe
A1 = Kontur(0)\X - X
A0 = A1
If A0 = 0
; suche Punkt auf anderer Hoehe
For i = Anz - 1 To 1 Step -1
A0 = Kontur(i)\X - X
If A0 <> 0
Break
EndIf
Next i
; alle Punkte auf gleicher Hoehe -> Punkt innerhalb ?
If A0 = 0
A1 = Kontur(0)\Y
A2 = A1
For i = 1 To Anz-1 Step 1
If Kontur(i)\Y < A1
A1 = Kontur(i)\Y
ElseIf Kontur(i)\Y > A2
A2 = Kontur(i)\Y
EndIf
If Y >= A1-Abs And Y <= A2+Abs
ProcedureReturn 0
EndIf
Next i
ProcedureReturn -1
EndIf
EndIf
For i=1 To Anz-1 Step 1
A2 = Kontur(i)\X - X
Vx = Kontur(i)\X - Kontur(i-1)\X
Vy = Kontur(i)\Y - Kontur(i-1)\Y
If A1 <> 0
A = A1
Else
A = A0
EndIf
If A * A2 < 0
H = A1 - A2
A3 = Kontur(i-1)\Y * H + A1 * Vy
A4 = Y * H
If (H >= 0 And A3 > A4) Or (H < 0 And A3 < A4 )
Ret = 1 - Ret
ElseIf A3 - Abs <= A4 And A3 + Abs >= A4
ProcedureReturn 0
EndIf
EndIf
If Vx <> 0 Or Vy <> 0
Vx1 = X - Kontur(i-1)\X
Vy1 = Y - Kontur(i-1)\Y
If Vx1 * Vx1 + Vy1 * Vy1 <= Abs2
ProcedureReturn 0
EndIf
Vx2 = X - Kontur(i)\X
Vy2 = Y - Kontur(i)\Y
A3 = Vx * Vy1 - Vy * Vx1
If A3 > #LONG_MIN And A3 < #LONG_MAX
If A3*A3 <= Abs2*(Vx*Vx+Vy*Vy) And Vx1*Vx + Vy1*Vy >= 0 And Vx2*Vx + Vy2*Vy <= 0
ProcedureReturn 0
EndIf
Else
Protected dA3.d = A3, dVx.d = Vx, dVy = Vy
If dA3*dA3 <= Abs2*(dVx*dVx+dVy*dVy) And Vx1*Vx + Vy1*Vy >= 0 And Vx2*Vx + Vy2*Vy <=0
ProcedureReturn 0
EndIf
EndIf
EndIf
A1 = A2
If A1 <> 0
A0 = A1
EndIf
Next i
ProcedureReturn Ret * 2 - 1
EndProcedure
#Image1 = 1
#Window = 2
#ImageGad = 3
#Button = 4
#Option1 = 5
#Option2 = 6
#Text = 7
#MaxX = 800
#MaxY = 600
#MaxAnz = 1000
Dim K.lPkt(#MaxAnz)
Define i.l,Px.l,Py.l,Abs.l
Define Anzahl.l = 0
Define Event.l
Define Aktion.l = #Option1
Define Input$
If CreateImage(#Image1,#MaxX,#MaxY) = 0
MessageRequester("Achtung!","Kann Image nicht erstellen")
End
EndIf
If OpenWindow(#Window,0,0,#MaxX+10,#MaxY+55,"Cursor in Kontur",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
If CreateGadgetList(WindowID(#Window))
ImageGadget (#ImageGad, 5,10, #MaxX,#MaxY,ImageID(#Image1))
ButtonGadget(#Button,5,#MaxY+20,100,25, "Schließen")
OptionGadget(#Option1,110,#MaxY+15,100,20,"Kontur eingeben")
OptionGadget(#Option2,110,#MaxY+35,100,20,"Lage des Cursors anzeigen")
TextGadget(#Text,250,#MaxY+30,200,30,"Lage : -")
EndIf
StartDrawing(ImageOutput(#Image1))
Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
StopDrawing()
SetGadgetState(#ImageGad,ImageID(#Image1))
SetGadgetState(#Option1,1)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #ImageGad
If Aktion = #Option1 And EventType() = #PB_EventType_LeftClick And Anzahl < #MaxAnz
K(Anzahl)\X = WindowMouseX(#Window) - GadgetX(#ImageGad)
K(Anzahl)\Y = WindowMouseY(#Window) - GadgetY(#ImageGad)
Anzahl + 1
StartDrawing(ImageOutput(#Image1))
Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
For i = 1 To Anzahl-1
LineXY(K(i-1)\X,K(i-1)\Y,K(i)\X,K(i)\Y,RGB(250,250,0))
Next
LineXY(K(i-1)\X,K(i-1)\Y,K(0)\X,K(0)\Y,RGB(250,250,0))
StopDrawing()
SetGadgetState(#ImageGad,ImageID(#Image1))
EndIf
Case #Button
Event = #PB_Event_CloseWindow
Case #Option1
If Aktion <> #Option1
Anzahl = 0
StartDrawing(ImageOutput(#Image1))
Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
StopDrawing()
SetGadgetState(#ImageGad,ImageID(#Image1))
Aktion = #Option1
SetGadgetText(#Text,"Lage: - ")
EndIf
Case #Option2
If Aktion <> #Option2
If Anzahl > 2
Aktion = #Option2
K(Anzahl)\X = K(0)\X
K(Anzahl)\Y = K(0)\Y
Anzahl + 1
Repeat
Input$ = InputRequester("Randbreite","Breite (in Pixeln) (>=0)","2")
Abs = Val(Input$)
Until Abs > 0
Else
MessageRequester("Achtung!","zu wenig Punkte")
SetGadgetState(#Option1,1)
SetGadgetText(#Text,"Lage: - ")
EndIf
EndIf
EndSelect
EndSelect
If Aktion = #Option2
Px = WindowMouseX(#WindoW) - GadgetX(#ImageGad)
Py = WindowMouseY(#WindoW) - GadgetY(#ImageGad)
i = PBGeo_PktInKontur(Px,Py,Anzahl,K(),Abs)
If i = -1
SetGadgetText(#Text,"Lage ("+Str(Px)+","+Str(Py)+"): außen")
ElseIf i = 0
SetGadgetText(#Text,"Lage ("+Str(Px)+","+Str(Py)+"): Rand")
Else
SetGadgetText(#Text,"Lage ("+Str(Px)+","+Str(Py)+"): innen")
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
CloseWindow(#Window)
