Mit Maus Linie auswählen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Kekskiller
Beiträge: 752
Registriert: 14.09.2004 21:39
Kontaktdaten:
Kontaktdaten von Kekskiller

Mit Maus Linie auswählen

Beitrag von Kekskiller »

In meinem Editor brauchte ich so eine Funktion. Man gibt zwei Punkte an, die eine Linie darstellen, eine Prüfkoordinate (sozusagen die Maus) und den Abstand, den der Punkt maximal zur Linie haben darf. Es im Rechteck um die beiden Punkte herum geprüft und um die Linie herum. Probiert einfach das untere Beispielprogramm aus.

Code: Alles auswählen

Procedure LineSelection(x1.l,y1.l, x2.l,y2.l, mx.l,my.l, maxdegree.l)
  
  Protected w.l, h.l
  Protected sx.d, sy.d
  Protected cy.l ,dx.l
  Protected a.l,b.l
  
  If x1 <= x2 And y1 <= y2
    
    If mx < (x1 - maxdegree) Or my < (y1 - maxdegree)   Or   mx > (x2 + maxdegree) Or my > (y2 + maxdegree)
      ProcedureReturn 0
    EndIf
    
    mx - x1
    my - y1
    
    w = x2 - x1
    h = y2 - y1
    
    sx = w / h
    sy = h / w
    
    dx = sx * my
    cy = sy * mx
    
  ElseIf x2 <= x1 And y2 <= y1
    
    If mx > (x1 + maxdegree) Or my > (y1 + maxdegree)   Or   mx < (x2 - maxdegree) Or my < (y2 - maxdegree) 
      ProcedureReturn 0
    EndIf
    
    mx - x2
    my - y2
    
    w = x1 - x2
    h = y1 - y2
    
    sx = w / h
    sy = h / w
    
    dx = sx * my
    cy = sy * mx
    
  ElseIf x2 <= x1 And y1 <= y2
    
    If mx > (x1 + maxdegree) Or my < (y1 - maxdegree)   Or   mx < (x2 - maxdegree) Or my > (y2 + maxdegree)
      ProcedureReturn 0
    EndIf
    
    mx - x2
    my - y1
    
    w = x1 - x2
    h = y2 - y1
    
    sx = w / h
    sy = h / w
    
    dx = w - sx * my
    cy = h - sy * mx
    
  ElseIf x1 <= x2 And y2 <= y1
    
    If mx < (x1 - maxdegree) Or my > (y1 + maxdegree)   Or   mx > (x2 + maxdegree) Or my < (y2 - maxdegree)
      ProcedureReturn 0
    EndIf
    
    mx - x1
    my - y2
    
    w = x2 - x1
    h = y1 - y2
    
    sx = w / h
    sy = h / w
    
    dx = w - sx * my
    cy = h - sy * mx
    
  EndIf
  
  a = dx - mx
  b = cy - my
  
  If (a <= maxdegree And a >= -maxdegree) Or (b <= maxdegree And b >= -maxdegree)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
  
EndProcedure
Die Prozedur habe ich bei dem folgenden Beispiel etwas angepasst, nehmt besser die obere. Bedienung: Maus in den Bereich der Linie bewegen und Nachricht im Fenstertitel beobachten. Wenn sch die Maus außerhalb des Fensters befindet, wird eine neue, zufällige Linie erzeugt:

Code: Alles auswählen

Macro dq
  "
EndMacro

Macro _(var)
  Debug dq var = dq + Str(var)
EndMacro

Procedure LineSelection(x1.l,y1.l, x2.l,y2.l, mx.l,my.l, maxdegree.l)
  
  
  Protected w.l, h.l ;höhe und breite
  Protected sx.d, sy.d ;schrittgröße des linie
  Protected cy.l ,dx.l ;die schnittstellen-ebenen
  Protected a.l,b.l
  
  
  ;(hier sind berechnungen in 1ne if-konstruktion zusammengefasst, damit wir nicht noch mehr zeitraubende ifs brauchen)
  
  ;je nachdem, wo die punkte gelegen sind, müssen breite, höhe und die schnittstellen-ebenen anders berechnet werden
  
  
  DrawingMode(#PB_2DDrawing_Outlined)
  Circle(x1,y1, 10, $FFFFFF)
  Circle(x2,y2, 10, $FFFF00)
  LineXY(x1,y1, x2,y2, $0000FF)
  
  
  If x1 <= x2 And y1 <= y2
    
    Debug "1 ."
    Debug ". 2"
    
    ;prüfrechteck abfangen
    ;(hier wird maxdegree miteinbezogen, da man dadurch a) nicht die ursprünglichen punkte verfälscht und b) auch gerade linien mit gleichen achsen miteinbezieht, damit wird so auch eine auswahl um den ursprungspunkt herum haben)
    
    If mx < (x1 - maxdegree) Or my < (y1 - maxdegree)   Or   mx > (x2 + maxdegree) Or my > (y2 + maxdegree)
      ProcedureReturn 0
    EndIf
    
    ;maus clippen
    
    mx - x1
    my - y1
    
    ;breite und höhe errechnen
    
    w = x2 - x1
    h = y2 - y1
    
    ;schrittgröße
    
    sx = w / h
    sy = h / w
    
    ;schnittstellen-ebene
    
    dx = sx * my
    cy = sy * mx
    
    ;prüfrahmen
    
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(x1,y1, w,h, $FF0000)
    Box(x1-maxdegree, y1-maxdegree, w+maxdegree*2, h+maxdegree*2, $FF0000)
    
    
  ElseIf x2 <= x1 And y2 <= y1
    
    Debug "2 ."
    Debug ". 1"
    
    If mx > (x1 + maxdegree) Or my > (y1 + maxdegree)   Or   mx < (x2 - maxdegree) Or my < (y2 - maxdegree) 
      ProcedureReturn 0
    EndIf
    
    mx - x2
    my - y2
    
    w = x1 - x2
    h = y1 - y2
    
    ;schrittgröße
    
    sx = w / h
    sy = h / w
    
    ;schnittstellen-ebene
    
    dx = sx * my
    cy = sy * mx
    
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(x2,y2, w,h, $FF0000)
    Box(x2-maxdegree, y2-maxdegree, w+maxdegree*2, h+maxdegree*2, $FF0000)
    
    
  ElseIf x2 <= x1 And y1 <= y2
    
    Debug ". 1"
    Debug "2 ."
    
    If mx > (x1 + maxdegree) Or my < (y1 - maxdegree)   Or   mx < (x2 - maxdegree) Or my > (y2 + maxdegree)
      ProcedureReturn 0
    EndIf
    
    mx - x2
    my - y1
    
    w = x1 - x2
    h = y2 - y1
    
    ;schrittgröße
    
    sx = w / h
    sy = h / w
    
    ;schnittstellen-ebene
    
    dx = w - sx * my
    cy = h - sy * mx
    
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(x2,y1, w,h, $FF0000)
    Box(x2-maxdegree, y1-maxdegree, w+maxdegree*2, h+maxdegree*2, $FF0000)
    
    
  ElseIf x1 <= x2 And y2 <= y1
    
    Debug ". 2"
    Debug "1 ."
    
    If mx < (x1 - maxdegree) Or my > (y1 + maxdegree)   Or   mx > (x2 + maxdegree) Or my < (y2 - maxdegree)
      ProcedureReturn 0
    EndIf
    
    mx - x1
    my - y2
    
    w = x2 - x1
    h = y1 - y2
    
    ;schrittgröße
    
    sx = w / h
    sy = h / w
    
    ;schnittstellen-ebene
    
    dx = w - sx * my
    cy = h - sy * mx
    
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(x1,y2, w,h, $FF0000)
    Box(x1-maxdegree, y2-maxdegree, w+maxdegree*2, h+maxdegree*2, $FF0000)
    
    
  EndIf
  
  
  ; ;schrittgröße
  ; 
  ; sx = w / h
  ; sy = h / w
  ; 
  ; ;schnittstellen-ebene
  ; 
  ; dx = w - sx * my
  ; cy = h - sy * mx
  
  
  Box(x1 - maxdegree, y1 - maxdegree, maxdegree*2, maxdegree*2, $FFBBBB)
  Box(x2 - maxdegree, y2 - maxdegree, maxdegree*2, maxdegree*2, $FFBBBB)
  
  
  ;entfernung zu den schnittstellen-ebenen errechnen
  a = dx - mx
  b = cy - my
  
  
  If x1 <= x2 And y1 <= y2
    
    Debug "1 ."
    Debug ". 2"
    
    Line(x1+mx,y1+my, a,0, $898989)
    Line(x1+mx,y1+my, 0,b, $898989)
    
    Circle(x1+mx,y1+my, 5, $00FFFF)
    Plot(  x1+mx,y1+my, $00FFFF)
    
  ElseIf x2 <= x1 And y2 <= y1
    
    Debug "2 ."
    Debug ". 1"
    
    Line(x2+mx,y2+my, a,0, $898989)
    Line(x2+mx,y2+my, 0,b, $898989)
    
    Circle(x2+mx,y2+my, 5, $00FFFF)
    Plot(  x2+mx,y2+my, $00FFFF)
    
  ElseIf x2 <= x1 And y1 <= y2
    
    Debug ". 1"
    Debug "2 ."
    
    Line(x2+mx,y1+my, a,0, $898989)
    Line(x2+mx,y1+my, 0,b, $898989)
    
    Circle(x2+mx,y1+my, 5, $00FFFF)
    Plot(  x2+mx,y1+my, $00FFFF)
    
  ElseIf x1 <= x2 And y2 <= y1
    
    Debug ". 2"
    Debug "1 ."
    
    Line(x1+mx,y2+my, a,0, $898989)
    Line(x1+mx,y2+my, 0,b, $898989)
    
    Circle(x1+mx,y2+my, 5, $00FFFF)
    Plot(  x1+mx,y2+my, $00FFFF)
    
  EndIf
  
  
  ;wenn die abstände des prüfrechtecks nicht zu groß und nicht zu klein sind, dann 1 zurückgeben (linie wurde von punkt ausgewählt)
  
  If (a <= maxdegree And a >= -maxdegree) Or (b <= maxdegree And b >= -maxdegree)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
  
EndProcedure


OpenWindow(0, 0,0, 320,240, "line selection text", #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_TitleBar)


Global punkt1.POINT
Global punkt2.POINT


punkt1\x = Random(WindowWidth(0))
punkt1\y = Random(WindowHeight(0))
punkt2\x = Random(WindowWidth(0))
punkt2\y = Random(WindowHeight(0))


Repeat
  StartDrawing(WindowOutput(0))
    Box(0,0, 320,240, 0)
    If WindowMouseX(0) <> -1
      LineXY(punkt1\x,punkt1\y, punkt2\x,punkt2\y, $00FF00)
      Plot(WindowMouseX(0),WindowMouseY(0), $FFFFFF)
      If LineSelection(punkt1\x,punkt1\y, punkt2\x,punkt2\y, WindowMouseX(0),WindowMouseY(0), 20)
        SetWindowTitle(0, "line selected")
      Else
        SetWindowTitle(0, "")
      EndIf
    Else
      punkt1\x = Random(WindowWidth(0))
      punkt1\y = Random(WindowHeight(0))
      punkt2\x = Random(WindowWidth(0))
      punkt2\y = Random(WindowHeight(0))
    EndIf
  StopDrawing()
  Delay(50)
Until WindowEvent() = #PB_Event_CloseWindow
(Hab den ganzen Tag dafür gebraucht, hmpf...)
Nach oben
Benutzeravatar
FGK
Beiträge: 249
Registriert: 09.01.2005 14:02
Computerausstattung: i5-4430 CPU / 8GB RAM
GeForce GT630
Windows 10 Home / 64-bit
Wohnort: Augsburg

Beitrag von FGK »

@Kekskiller

Ich finde deinen Code nicht schlecht aber was hältst du von dieser
viel kürzerern und schnuckligeren Methode? (Ohne deine Anstrengungen
zu schmälern natürlich!) Ich weis daß die Routine für Floats ausgelegt ist
aber ich war zu faul dein Beispielprogramm zum zeichnen noch aufzubohren.
Also seht es mir nach. Die Konstante #Max_Distance steuert
die Empfindlichkeit/Genauigkeit.

Gruß FGK

Code: Alles auswählen

#Max_Distance = 5

;Calculate the distance between the point And the segment.
Procedure.f DistToSegment(px.f,py.f,x1.f,y1.f,x2.f,y2.f)
  Protected dx.f
  Protected dy.f
  Protected t.f
  dx = x2 - x1
  dy = y2 - y1
  If dx = 0 And dy = 0 
    ; It's a point Not a line segment.
    dx = px - x1
    dy = py - y1
    ProcedureReturn Sqr(dx * dx + dy * dy)
  EndIf
  t = (px + py - x1 - y1) / (dx + dy)
  If t < 0 
    dx = px - x1
    dy = py - y1
  ElseIf t > 1 
    dx = px - x2
    dy = py - y2
  Else
    x2 = x1 + t * dx
    y2 = y1 + t * dy
    dx = px - x2
    dy = py - y2
  EndIf
  ProcedureReturn Sqr(dx * dx + dy * dy)
EndProcedure

OpenWindow(0, 0,0, 320,240, "line selection text", #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_TitleBar) 


Global punkt1.POINT 
Global punkt2.POINT 


punkt1\x = Random(WindowWidth(0)) 
punkt1\y = Random(WindowHeight(0)) 
punkt2\x = Random(WindowWidth(0)) 
punkt2\y = Random(WindowHeight(0)) 


Repeat 
  StartDrawing(WindowOutput(0)) 
  Box(0,0, 320,240, 0) 
  
  If WindowMouseX(0) <> -1 
    LineXY(punkt1\x,punkt1\y, punkt2\x,punkt2\y, $00FF00) 
    Plot(WindowMouseX(0),WindowMouseY(0), $FFFFFF) 
    If DistToSegment(WindowMouseX(0),WindowMouseY(0),punkt1\x,punkt1\y,punkt2\x,punkt2\y)<#Max_Distance
     SetWindowTitle(0, "line selected") 
    Else 
      SetWindowTitle(0, "") 
    EndIf 
  Else 
    punkt1\x = Random(WindowWidth(0)) 
    punkt1\y = Random(WindowHeight(0)) 
    punkt2\x = Random(WindowWidth(0)) 
    punkt2\y = Random(WindowHeight(0)) 
  EndIf 
  DrawingMode(#PB_2DDrawing_Outlined) 
  Circle(punkt1\x,punkt1\y, 10, $FFFFFF) 
  Circle(punkt2\x,punkt2\y, 10, $FFFF00) 
  LineXY(punkt1\x,punkt1\y,punkt2\x,punkt2\y, $0000FF) 
  StopDrawing() 
  Delay(50) 
Until WindowEvent() = #PB_Event_CloseWindow
Nach oben
Kekskiller
Beiträge: 752
Registriert: 14.09.2004 21:39
Kontaktdaten:
Kontaktdaten von Kekskiller

Beitrag von Kekskiller »

Wow. Deine Methode ist mathematisch gesehen viel interessanter als meine. Leider bin ich in Mathe nicht so fit, um mir die genaue Funktionsweise aus den Haaren zu ziehen. Schnuckeliger Code. Aber mich sträubt der Einsatz von Wurzel- und Potenzfunktionen immer, daher bevorzuge ich lieber meine Variante :mrgreen: .
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“