PureBoard

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)