[VB6]Calcolare punti interni a rettangolo...

[oregon]

Originariamente inviato da Zlatan8.
Calcolare tutti i punti che vi sono all'interno del rettangolo...
Per esempio, parto da A, e mi sposto di una unità, quindi ammettiamo che A ha come coordinate 10,10 , io mi sposto di uno e vado a 9, e devo calcolare tutti punti che stanno dul 9, quindi sranno 9,19-9,9-9,8-9,7 etc, poi mi sposto e vado a 8, e ricalcolo tutti i punti...Non so se mi sono spiegato bene...

Ma questo calcolo a cosa e' finalizzato ? Devi disegnare il rettangolo ? A cosa servirebbe ?

E poi, da 10,10 ti sposti di una unità sull'asse X o Y ? Cosa vuol dire che vai a 9 ? E cosa sono 9,10-9,9 ? A parte il fatto che ci sono (infiniti) punti tra il primo e il secondo e vicini a quelli che hai raggiunto, ammesso che li calcoli, a cosa servono questi calcoli ? Che ci fai con i risultati ?

Finchè non chiarisci, non si puo' dare una risposta ...

[Zlatan8.]

Si scusa, ho modificato il messaggio perche avevo sbagliato e a scrivere...
Praticamente l'applicazione che sto creando è un piccolo CAD, e quei punti mi servono per vedere se ho selezionato una riga, o altre forme geometriche, tramite delle funzioni che ho già creato...

[oregon]

Originariamente inviato da Zlatan8.
Praticamente l'applicazione che sto creando è un piccolo CAD

Sì ... immaginavo, anche perchè ricordo che te lo avevo sconsigliato ...

quei punti mi servono per vedere se ho selezionato una riga, o altre forme geometriche, tramite delle funzioni che ho già creato...

Ma non capisco come ti possano servire ... mica li puoi "collezionare" tutti ...

Ammesso di averli, come faresti questo controllo di "selezione" ?

Se hai le coordinate di un punto (magari fornita dal puntatore del mouse) devi controllare con delle if se i valori di queste coordinate sono comprese tra quelle dei punti della diagonale, non devi confrontarli con tutti i punti del rettangolo!

[Zlatan8.]

Ti posto il codice, così si capisce meglio...
Dim oldX As Single, oldY As Single
'Array Linee
Dim arrX1(1000) As Long
Dim arrX2(1000) As Long
Dim arrY1(1000) As Long
Dim arrY2(1000) As Long
Dim iNumLinee As Integer
'Array Rettangoli
Dim arrRettX1(1000) As Single
Dim arrRettX2(1000) As Single
Dim arrRettY1(1000) As Single
Dim arrRettY2(1000) As Single
Dim iNumRettangoli As Integer
'Array Cerchi
Dim arrCerchioX1(1000) As Single
Dim arrCerchioX2(1000) As Single
Dim arrCerchioY1(1000) As Single
Dim arrCerchioY2(1000) As Single
Dim arrRaggio(1000) As Single
Dim iNumCerchi As Integer
Dim raggio As Single

Private Sub Command1_Click()
'Linea button
If Command1.Tag <> "linea" Then
Command1.Tag = "linea"
Command1.Caption = "LINEA"
Command2.Caption = "Rettangolo"
oldX = -1
oldY = -1
Else
Command1.Tag = ""
Command1.Caption = "Linea"
End If
End Sub

Private Sub Command2_Click()
'Rettangolo button
If Command1.Tag <> "rett" Then
Command1.Tag = "rett"
Command2.Caption = "RETTANGOLO"
Command1.Caption = "Linea"
oldX = -1
oldY = -1
Else
Command1.Tag = ""
Command2.Caption = "Rettangolo"
End If
End Sub

Private Sub Command3_Click()
If Command1.Tag = "" Then
Command1.Tag = "cerchio"
Command3.Caption = "CERCHIO"
oldX = -1
oldY = -1
Else
Command1.Tag = ""
Command3.Caption = "Cerchio"
End If
End Sub

Private Sub Form_Load()
oldX = -1
oldY = -1
Command1.Caption = "Linea"
Command2.Caption = "Rettangolo"
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then Exit Sub
'Attiva la funzione di disegno della linea
If Command1.Tag = "linea" Then
If oldX = -1 Then
oldX = X
oldY = Y
Picture2.PaintPicture Picture1.Image, 0, 0
'Aggiunge le coordinate della linea negli array delle linee
arrX1(iNumLinee) = oldX
arrX2(iNumLinee) = X
arrY1(iNumLinee) = oldY
arrY2(iNumLinee) = Y
iNumLinee = iNumLinee + 1
End If
oldX = X
oldY = Y
End If
'Attiva la funzione di disegno del rettangolo
If Command1.Tag = "rett" Then
If oldX = -1 Then
oldX = X
oldY = Y
Picture2.PaintPicture Picture1.Image, 0, 0
Else
'Aggiunge le coordinate del rettangolo negli array dei rettangoli
arrRettX1(iNumRettangoli) = oldX
arrRettX2(iNumRettangoli) = X
arrRettY1(iNumRettangoli) = oldY
arrRettY2(iNumRettangoli) = Y
iNumRettangoli = iNumRettangoli + 1
oldX = -1
End If
End If
'Attiva la funzione di disegno del cerchio
If Command1.Tag = "cerchio" Then
If oldX = -1 Then
oldX = X
oldY = Y
Picture2.PaintPicture Picture1.Image, 0, 0
Else
'Aggiunge le coordinate del rettangolo negli array dei rettangoli
arrCerchioX1(iNumCerchi) = oldX
arrCerchioX2(iNumCerchi) = X
arrCerchioY1(iNumCerchi) = oldY
arrCerchioY2(iNumCerchi) = Y
arrRaggio(iNumCerchi) = raggio
iNumCerchi = iNumCerchi + 1
oldX = -1
End If
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
raggio = Sqr((X - oldX) * (X - oldX) + (Y - oldY) * (Y - oldY))
'Disegna il rettangolo
If oldX = -1 Then Exit Sub
If Command1.Tag = "rett" Then
Picture1.PaintPicture Picture2.Image, 0, 0
Picture1.Line (oldX, oldY)-(X, Y), RGB(0, 0, 0), B
End If
'Disegna il cerchio
If oldX = -1 Then Exit Sub
If Command1.Tag = "cerchio" Then
Picture1.PaintPicture Picture2.Image, 0, 0
Picture1.Circle (oldX, oldY), raggio
End If
'Disegna il cerchio
If oldX = -1 Then Exit Sub
If Command1.Tag = "linea" Then
Picture1.PaintPicture Picture2.Image, 0, 0
Picture1.Line (oldX, oldY)-(X, Y), RGB(0, 0, 255)
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim exist As Integer, existRettangolo As Integer, existCerchio As Integer
'Annulla le operazioni di disegno
If Button = vbLeftButton Then Exit Sub
Command1.Tag = ""
Command1.Caption = "Linea"
'Verifica se si è selezionata una linea tramite la funzione CercaLinea
exist = CercaLinea(X, Y)
If exist >= 0 Then
Picture1.Line (arrX1(exist), arrY1(exist))-(arrX2(exist), arrY2(exist)), RGB(255, 0, 0)
MsgBox "Exist", vbCritical
End If
'Verifica se si è selezionato un rettangolo tramite la funzione CercaRettangolo
existRettangolo = CercaRettangolo(X, Y)
If existRettangolo >= 0 Then
'Picture1.PaintPicture Picture2.Image, 0, 0
Picture1.Line (arrRettX1(existRettangolo), arrRettY1(existRettangolo))-(arrRettX2(existRettangolo), arrRettY2(existRettangolo)), RGB(255, 0, 0), B
MsgBox "Exist Rettangolo", vbCritical
End If
'Verifica se si è selezionato un cerchio tramite la funzione CercaCerchio
existCerchio = CercaCerchio(X, Y)
If existCerchio >= 0 Then
Picture1.Circle (arrCerchioX1(existCerchio), arrCerchioY1(existCerchio)), arrRaggio(existCerchio), RGB(255, 0, 0)
MsgBox "ExistCerchio", vbCritical
End If
End Sub

Private Function CercaLinea(ByVal X As Single, ByVal Y As Single) As Integer
Dim j As Integer, x1 As Long, x2 As Long, y1 As Long, y2 As Long
Dim xcalc As Double, ycalc As Double
CercaLinea = -1
For j = 0 To iNumLinee - 1 ' tante quante sono le linee
y1 = arrY1(j): y2 = arrY2(j): x1 = arrX1(j): x2 = arrX2(j)
ycalc = (Y - y1) / (y2 - y1)
xcalc = (X - x1) / (x2 - x1)
Debug.Print xcalc, ycalc, Round(ycalc - xcalc, 1)
If Round(ycalc - xcalc, 1) = 0 Then
CercaLinea = j
End If
Next j
End Function

Private Function CercaRettangolo(ByVal X As Single, Y As Single) As Integer
Dim j As Integer, x1 As Long, x2 As Long, y1 As Long, y2 As Long
Dim xcalc As Double, ycalc As Double
CercaRettangolo = -1
For j = 0 To iNumRettangoli - 1 ' tanti quanti sono i rettangoli
y1 = arrRettY1(j): y2 = arrRettY2(j): x1 = arrRettX1(j): x2 = arrRettX2(j)
If (X = x1 Or X = x2) And (Y >= y1 And Y <= y2) Then
CercaRettangolo = j
Exit Function
End If
If (Y = y1 Or Y = y2) And (X >= x1 And X <= x2) Then
CercaRettangolo = j
Exit Function
End If
Next j
End Function

Private Function CercaCerchio(ByVal X As Single, Y As Single) As Integer
Dim j As Integer, x1 As Double, x2 As Double, y1 As Double, y2 As Double, r As Double
Dim xcalc As Double, ycalc As Double, diff As Double
CercaCerchio = -1
For j = 0 To iNumCerchi - 1 ' tanti quanti sono i cerchi
y1 = arrCerchioY1(j): y2 = arrCerchioY2(j): x1 = arrCerchioX1(j): x2 = arrCerchioX2(j): r = arrRaggio(j)
ycalc = (Y - y1) ^ 2
xcalc = (X - x1) ^ 2
diff = Abs(Round(Sqr(xcalc + ycalc), 1) - Round(r, 1))
Debug.Print Round(r, 1), Round(Sqr(xcalc + ycalc), 1), X, Y, diff
'Debug.Print Tan(X), Tan(Y), raggio, y1, x1
If diff >= 0 And diff <= 15 Then
CercaCerchio = j
End If
Next j
End Function

Praticamente ora cliccando nella picture box con il mouse, lui verifica se sono su una linea, o un rettangolo, o un cerchio...
Io vorrei ora fare una selezione un po' alla autocad, e quindi ho pensato che quando si clicca nella picture una prima volta, ti parte il rettangolo, con un secondo lo stoppi, e li ho pensato di calcolare tutti i punti, in modo da utilizzarli nelle funzioni di verifica della selezione delle varie forme...

[oregon]

Originariamente inviato da Zlatan8.
Ti posto il codice, così si capisce meglio...

Beh ... per modo di dire ... mica posso leggere e controllare tutto il codice che hai scritto in poco tempo ... comunque ...

Praticamente ora cliccando nella picture box con il mouse, lui verifica se sono su una linea, o un rettangolo, o un cerchio...
Io vorrei ora fare una selezione un po' alla autocad, e quindi ho pensato che quando si clicca nella picture una prima volta, ti parte il rettangolo, con un secondo lo stoppi, e li ho pensato di calcolare tutti i punti, in modo da utilizzarli nelle funzioni di verifica della selezione delle varie forme...

Ecco ... allora, secondo me, stai seguendo una strada sbagliata. Per memorizzare un "oggetto" disegnato, mica puoi memorizzarne tutti i punti ! Non ha senso ... Devi solo conservare in un'apposita struttura interna le coordinate della diagonale e il tipo di oggetto grafico.

Un CAD e' complesso ...

[Zlatan8.]

Infatti non memorizzo tutti i punti...
Delle linee, memorizzo nell'array delle linee il punto iniziale e quello finale, e cosi per i rettangoli...
Per i cerchi, memorizzo x,y del centro e il raggio...

[oregon]

Ok ... quindi trattare tutti i punti non ti serve ...