Guest User

Untitled

a guest
Sep 19th, 2020
29
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.     Private Function GetQuadrant(ByVal t1 As Tuple(Of Double, Double, Double, Double),
  2.                                  ByVal t2 As Tuple(Of Double, Double, Double, Double)) As _
  3.                                  Tuple(Of Double, Double, Double, Double)
  4.  
  5.         Dim pixelMove As Integer = 1 'Um wieviel Pixel das Bilderweitert wird.
  6.         Dim prec As Double = 0.00000000005 'Genauigkeit
  7.  
  8.         'Zuerst rechnen wir den xmin,xmax Step aus
  9.         Dim curXmin As Double = t2.Item1
  10.         Dim curXmax As Double = t2.Item2
  11.         Dim curXminDiff As Double = GetAbsolute(t1.Item1, t2.Item1) / Bildgröße.Width
  12.         Dim curXmaxDiff As Double = GetAbsolute(t1.Item2, t2.Item2) / Bildgröße.Width
  13.         Dim curXminStep As Double
  14.         Dim curXmaxStep As Double
  15.         Dim count As Integer
  16.         Do While True
  17.             curXminStep += (curXminDiff * pixelMove)
  18.             curXmaxStep += (curXmaxDiff * pixelMove)
  19.             If curXmin < t1.Item1 Then curXmin += curXminDiff
  20.             If curXmin > t1.Item1 Then curXmin -= curXminDiff
  21.             If curXmax < t1.Item2 Then curXmax += curXmaxDiff
  22.             If curXmax > t1.Item2 Then curXmax -= curXmaxDiff
  23.             curXmaxDiff = GetAbsolute(t1.Item2, curXmax) / Bildgröße.Width
  24.             curXminDiff = GetAbsolute(t1.Item1, curXmin) / Bildgröße.Width
  25.             If GetAbsolute(curXmin, t2.Item1) > GetAbsolute(t1.Item1, t2.Item1) - prec Or
  26.                 GetAbsolute(curXmax, t2.Item2) > GetAbsolute(t1.Item2, t2.Item2) - prec Then
  27.                 Exit Do
  28.             End If
  29.             count += 1
  30.         Loop
  31.         curXmaxStep /= Bildgröße.Width
  32.         curXminStep /= Bildgröße.Width
  33.  
  34.         Dim curYmin As Double = t2.Item3
  35.         Dim curYmax As Double = t2.Item4
  36.         Dim curYminDiff As Double = GetAbsolute(t1.Item3, t2.Item3) / Bildgröße.Height
  37.         Dim curYmaxDiff As Double = GetAbsolute(t1.Item4, t2.Item4) / Bildgröße.Height
  38.         Dim curYminStep As Double = 0
  39.         Dim curYmaxStep As Double = 0
  40.         Dim pxly As Integer = 0
  41.  
  42.         Do While True
  43.             curYminStep += (curYminDiff * pixelMove)
  44.             curYmaxStep += (curYmaxDiff * pixelMove)
  45.             If curYmin < t1.Item3 Then curYmin += curYminDiff
  46.             If curYmin > t1.Item3 Then curYmin -= curYminDiff
  47.             If curYmax < t1.Item4 Then curYmax += curYmaxDiff
  48.             If curYmax > t1.Item4 Then curYmax -= curYmaxDiff
  49.             curYminDiff = GetAbsolute(t1.Item3, curYmin) / Bildgröße.Height
  50.             curYmaxDiff = GetAbsolute(t1.Item4, curYmax) / Bildgröße.Height
  51.             If GetAbsolute(curYmin, t2.Item3) > GetAbsolute(t1.Item3, t2.Item3) - prec Or
  52.                     GetAbsolute(curYmax, t2.Item4) > GetAbsolute(t1.Item4, t2.Item4) - prec Then
  53.                 Exit Do
  54.             End If
  55.             count += 1
  56.         Loop
  57.         curYmaxStep /= Bildgröße.Height 'Wieder auf einzelne Steps anpassen
  58.         curYminStep /= Bildgröße.Height
  59.         Return New Tuple(Of Double, Double, Double, Double)(curXminStep, curXmaxStep, curYminStep, curYmaxStep)
  60.     End Function
RAW Paste Data