Public Type POINT
x As Long
y As Long
End Type
Public mon_point As POINT
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hrgn As Long, ByVal x As Long, ByVal y As Long) As Long
Public mon_polygone() As POINT
Public Const ALTERNATE = 1
Public Const WINDING = 2
Public Const BLACKBRUSH = 4
Public hrgn As Long
Public Function est_dedans(hrgn As Long, mon_point As POINT) As Boolean
If PtInRegion(hrgn, mon_point.x, mon_point.y) > 0 Then est_dedans = True
End Function
Private Sub CommandButton1_Click()
Dim nb_pointes As Long, hBrush As Long, ma_region As Long
' Nous allons ici définir notre polygone par
' le nombre de ses sommets et leurs coordonnées
nb_pointes = 5
ReDim mon_polygone(1 To nb_pointes) As POINT
mon_polygone(1).x = 452
mon_polygone(1).y = 358
mon_polygone(2).x = 60
mon_polygone(2).y = 27
mon_polygone(3).x = 110
mon_polygone(3).y = 300
mon_polygone(4).x = 257
mon_polygone(4).y = 60
mon_polygone(5).x = 18
mon_polygone(5).y = 180
' créons maintenant la région de ce polygone
ma_region = CreatePolygonRgn(mon_polygone(1), nb_pointes, WINDING)
'''''''''
'deux petits tests/exemples avec deux points
mon_point.x = 80: mon_point.y = 65
MsgBox "le point de coordonnées " & mon_point.x & "," & mon_point.y & " est-il dedans ? ===>> " & est_dedans(ma_region, mon_point)
mon_point.x = 63: mon_point.y = 141
MsgBox "le point de coordonnées " & mon_point.x & "," & mon_point.y & " est-il dedans ? ===>> " & est_dedans(ma_region, mon_point)
DeleteObject ma_region
End Sub
''' <summary>
''' Indique si un point se situe dans un polygone
''' </summary>
''' <param name="Polygon">Liste de points (enveloppe)</param>
''' <param name="P">Point a tester</param>
Public Shared Function InsidePolygon(ByRef Polygon As List(Of Vector2), ByRef P As Vector2) As Boolean
Dim i As Integer, xinters As Double, counter As Integer = 0
Dim p1 As Vector2, p2 As Vector2, n As Integer = Polygon.Count
p1 = Polygon(0)
For i = 1 To n
p2 = Polygon(i Mod n)
If P.Y > Min(p1.Y, p2.Y) Then
If P.Y <= Max(p1.Y, p2.Y) Then
If P.X <= Max(p1.X, p2.X) Then
If p1.Y <> p2.Y Then
xinters = (P.Y - p1.Y) * (p2.X - p1.X) / (p2.Y - p1.Y) + p1.X
If p1.X = p2.X OrElse P.X <= xinters Then
counter += 1
End If
End If
End If
End If
End If
p1 = p2
Next
Return (counter Mod 2 <> 0)
End Function
''' <summary>
''' Indique si les points A B et C sont disposé en sens Horaire (2D)
''' </summary>
''' <param name="A">Point[A]</param>
''' <param name="B">Point[B]</param>
''' <param name="C">Point[C]</param>
Public Shared Function SensHoraire2DFast(ByRef A As Vector2, ByRef B As Vector2, ByRef C As Vector2) As Boolean
Dim SignSurface As Double = A.X * (B.Y - C.Y) + B.X * (C.Y - A.Y) + C.X * (A.Y - B.Y)
Return (SignSurface < 0) 'Surface=0 => pts alignés
End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionVector2 étant juste une structure similaireau pied de la lettre, et je ne connais pas cette librairie.
If Math.Min(p1.Y, p2.Y) < P.Y <= Math.Max(p1.Y, p2.Y) Thenplutôt que
If P.Y > Min(p1.Y, p2.Y) Then If P.Y <= Max(p1.Y, p2.Y) Then.
se trouve à l'intérieur d'un polygone (coordonnées connues).
Non : je ne vois pas la télévision en code. Pour une simple raison : je ne la regarde pas du tout (MDR).
Allez, si tu aimes les images, je vais faire en sorte de mettre mon code en image/démo. Cela va être un peu plus dur du fait que ni Excel, ni VBA, n'offrent nativement pas de quoi dessiner, d'une part, et que, d'autre part, pour ce faire je ne vais pas échapper à des transpositions d'unité.
Mais je vais y arriver, tu vas voir ... (après ma partie de pêche, en espérant ne pas revenir encore bredouille ce soir...). Et cela te donnera probablement quelques idées supplémentaires (va savoir ..)
Private Type COORD
X As Long
Y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hrgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hrgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const ALTERNATE = 1
Const WINDING = 2
Const BLACKBRUSH = 4
Private monhwnd As Long, monhdc As Long, hrgn As Long, numcoords As Integer
Private poly() As COORD
Private Sub UserForm_Activate()
' aucun importance (juuste pour disposer plus agréablement |
Me.Width = 400 ' |
Me.Height = 200 ' |
Label1.Move 300, 50, 20, 20 ' |
Label1.Caption = "" ' |
Label1.BackColor = 0 ' |
'----------------------------------------------------------
'Pour dessiner sur le userform, j'ai besoin de son hdc
' pour avoir ce hdc, j'ai besoin du hwnd de ce userform
' et donc
monhwnd = FindWindow(vbNullString, Me.Caption)
monhdc = GetDC(monhwnd)
numcoords = 6
ReDim poly(1 To numcoords)
poly(1).X = 20
poly(1).Y = 30
poly(2).X = 60
poly(2).Y = 47
poly(3).X = 100
poly(3).Y = 50
poly(4).X = 150
poly(4).Y = 80
poly(5).X = 160
poly(5).Y = 40
poly(6).X = 170
poly(6).Y = 20
DoEvents
hrgn = CreatePolygonRgn(poly(1), numcoords, 1)
' voilà ce qui v a maintenant dessiner le polygone sur le userform
hBrush = GetStockObject(BLACKBRUSH)
Polygon monhdc, poly(1), numcoords '
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label1.BackColor = PtInRegion(hrgn, X * 1.333333, Y * 1.333333) * vbRed
End Sub
hBrush = GetStockObject(BLACKBRUSH)
Polygon monhdc, poly(1), numcoords
11 avril 2015 à 12:31
Je le teste lundi au bureau, manque la "lib gdi32" sur le petit mac de la maison...
Les coordonnées sont des coordonnées géographiques donc toutes avec la même références et la même unité.
Ce sont des centaines de coordonnées à tester afin de ne sélectionner que celles qui sont utile pour créer un MNT dans une liste de quelques milliers. Je fais le test dès lundi encore merci aux poissons que tu n'as pas croisé cette nuit ;)