View Full Version : [VB6] disegnare linee col mouse
Ciao a tutti :D
ho sfogliato tutto il Web senza trovare nulla. :O
Quello che vorrei fare e mi serve molto, in sintesi è questo:
tracciare col mouse una linea dritta su una PictureBox.
Cliccando col tasto Sx del mouse su un punto qualunque della PictureBox e trascinandolo, dovrebbe apparirmi una linea che segue il movimento del mouse in ogni spostamento fino a quando viene rilasciato il tasto e la riga si fissa.
Ancora meglio se la linea inizia al primo click e anche rilasciando il tasto segue i movimenti fino al secondo click dove a quel punto si fissa.
In pratica e quasi come avviene in PhotoFiltre quando si usa la funzione "Poligono", però in quel caso occorre premere "Alt" per staccarla, chi conosce PhotoFiltre sa cosa intendo :)
Grazie a tutti per gli eventuali interventi molto molto graditi :D
Quello che vorrei fare e mi serve molto, in sintesi è questo:
tracciare col mouse una linea dritta su una PictureBox.
Cliccando col tasto Sx del mouse su un punto qualunque della PictureBox e trascinandolo, dovrebbe apparirmi una linea che segue il movimento del mouse in ogni spostamento fino a quando viene rilasciato il tasto e la riga si fissa.
Ancora meglio se la linea inizia al primo click e anche rilasciando il tasto segue i movimenti fino al secondo click dove a quel punto si fissa.
Nulla di impossibile. ;)
Io l'ho risolto così :
Private puntoInizio As Boolean
Private startX As Single
Private startY As Single
Private Sub Picture1_Click()
If puntoInizio = False Then
Picture1.MousePointer = 2
puntoInizio = True
Else
Picture1.MousePointer = 1
puntoInizio = False
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If puntoInizio = False Then
startX = X
startY = Y
Else
Picture1.Refresh
Picture1.Line (X, Y)-(startX, startY), vbBlack
End If
End Sub
Picture1 è la PictureBox.
In questo caso al tracciamento di una nuova linea la Pb viene resettata in modo che solo l'ultima linea resti visibile. ;)
Non ci posso credere........ ::eek:
Marco se tu fossi qui ti offrirei un calice di champagne :D
Invece accontentati di questo modesto grazie:
For n = 1 to 10000
Play (n) "Grazie" :)
Next n
Domani provo ad inserirlo nel contesto del codice.
Ancora grazie :D
Allora Marco...ho inserito il tuo codice nel contesto del programma e funziona come desideravo.
Ho riscontrato un... chiamiamolo difetto ? :O
Clicco sul grafico creato con PictureBox per iniziare la linea e il grafico mi sparisce da sotto i piedi, la linea la posso concludere comunque, però alla cieca.
Cliccando sul CmdButton, il grafico si ridisegna e posso vedere sia il grafico che la linea appena creata.
Ti domando gentilmente se fosse possibile disegnare la linea senza cancellare il grafico perchè come puoi immaginare, disegnare delle linee a casaccio senza il supporto del grafico non ha senso :D
Mi pare doveroso dire che mi rivolgo a te perchè sei l'autore del codice ma è
ovvio che nessuno è escluso http://immagini.p2pforum.it/out.php/i95103_Nonno.gif
:help:
Grazie :)
Clicco sul grafico creato con PictureBox per iniziare la linea e il grafico mi sparisce da sotto i piedi, la linea la posso concludere comunque, però alla cieca.
Cliccando sul CmdButton, il grafico si ridisegna e posso vedere sia il grafico che la linea appena creata.
Ti domando gentilmente se fosse possibile disegnare la linea senza cancellare il grafico perchè come puoi immaginare, disegnare delle linee a casaccio senza il supporto del grafico non ha senso :D
Questo grafico cos'è ? E' un file immagine che viene caricato nella PictureBox o un insieme di linee disegnate allo stesso modo sul componente ?
In ogni caso dovrebbe bastare l'inserimento di un'istruzione di "refresh" del grafico tra le due linee di codice :
Picture1.Refresh
Picture1.Line (X, Y)-(startX, startY), vbBlack
Non sapendo cosa contiene la PictureBox al momento del tracciamento delle linee non posso essere più preciso. ;)
Ciao Marco,
il grafico viene disegnato con Line in base alla lettura di numeri da un'Array, es: Picture1.Line (X1, Y1) - (X, Y)
Ti posto un'immagine così ti rendi conto:
L'immagine l'ho rimpicciolita per evitare la miniatura.
http://img268.imageshack.us/img268/3307/immagineqhf.png (http://img268.imageshack.us/i/immagineqhf.png/)
Ora proverò ad inserire un Refresh e vediamo se funzia, intanto grazie per la pazienza e la disponibilità. :)
Perfetto. Allora la soluzione è semplice, basterà refreshare l'array delle linee tracciate a mano, assieme a quelle del grafico ( 2 array separati ).
Hai già un array che contiene le coordinate di tutti i punti del grafico. In più, se vuoi poter tracciare più linee, ti basterà avere un secondo array per le linee tracciate a mano.
Picture1.Refresh serve allo scopo di pulire la PictureBox durante lo spostamento del mouse, il che evita il disegno di tutte le linee "intermedie". Basta che, nel mio esempio precedente, dove trovi :
Picture1.Refresh
Picture1.Line (X, Y)-(startX, startY), vbBlack
tu provi a rimuovere o commentare Picture1.Refresh, per renderti conto di cosa intendo. ;)
In breve, la mia soluzione :
Private puntoInizio As Boolean
Private startX As Single
Private startY As Single
Private endX As Single
Private endY As Single
Private Type lineaMouse
x1 As Single
y1 As Single
x2 As Single
y2 As Single
End Type
Private arrayLineeMouse() As lineaMouse
Private Sub Form_Load()
ReDim Preserve arrayLineeMouse(0)
End Sub
Private Sub Picture1_Click()
If puntoInizio = False Then
Picture1.MousePointer = 2
puntoInizio = True
Else
Picture1.MousePointer = 1
puntoInizio = False
ReDim Preserve arrayLineeMouse(UBound(arrayLineeMouse) + 1)
Dim l As lineaMouse
l.x1 = endX
l.y1 = endY
l.x2 = startX
l.y2 = startY
arrayLineeMouse(UBound(arrayLineeMouse)) = l
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If puntoInizio = False Then
startX = X
startY = Y
Else
'refresh PictureBox
Picture1.Refresh
'refresh array grafico
'...
'refresh array linee
Dim i As Integer
For i = 0 To UBound(arrayLineeMouse)
With arrayLineeMouse(i)
Picture1.Line (.x1, .y1)-(.x2, .y2), vbBlack
End With
Next i
'nuova linea (disegno temporaneo)
Picture1.Line (X, Y)-(startX, startY), vbBlack
endX = X
endY = Y
End If
End Sub
;)
Ciao Marco, (che pazienza che hai) :)
avevo già provato a commentare il Refresh dove dici tu e in effetti il grafico sotto la linea del mouse rimane, però appena mi muovo a destra o a sinistra la linea perde la pulizia, nel senso che scrive anche gli spostamenti del mouse non voluti, ma lo sai già :D
Può essere utile ma non mi serve tracciare diverse linee, mi interessa solo che quando traccio una linea il grafico sia sempre visibile.
Una domanda...
il codice seguente è meglio inserirlo in Modulo1 o lasciarlo in "Generale" del Form1 ?
Private puntoInizio As Boolean
Private startX As Single
Private startY As Single
Private endX As Single
Private endY As Single
Private Type lineaMouse
x1 As Single
y1 As Single
x2 As Single
y2 As Single
End Type
Private arrayLineeMouse() As lineaMouse
Ora proverò a verificare bene il tutto e ti farò sapere.
Intando grazie e buona domenica :D
"Pazienza" ? :D
Più che altro mi ci diverto :) . Cmq ci avrò messo sì e no 5 minuti...
Per il codice :
Private puntoInizio As Boolean
Private startX As Single
Private startY As Single
Private endX As Single
Private endY As Single
Private arrayLineeMouse() As lineaMouse
Hanno senso solo se associate al PictureBox in quella specifica Form, perciò non le metterei proprio Public in un modulo.
Private Type lineaMouse
x1 As Single
y1 As Single
x2 As Single
y2 As Single
End Type
Questo invece potrebbe stare Public in un modulo, rendendolo utilizzabile da qualsiasi punto dell'applicazione... ;)
5 minuti ?????????? :eek:
a me ci vogliono almeno 3 giorni :D
come avevo scritto nel post più sopra, di FrmGrafic e relativi Picture ce ne sono diversi quindi, ho dovuto metterli tutti in Public così:
Public StartX(6) As Single
Public StartY(6) As Single
Public EndX(6) As Single
Public EndY(6) As Single
stessa cosa per il resto :)
Per ciò che riguarda il Refresh array grafico non posso farlo per il semplice motivo che non c'è un'array che memorizza le coordinate, (forse dovrei aggiungerlo ?)
Il grafico viene elaborato in questo modo.
Tralascio le inizializzazioni variabili a mio avviso superflue.
Private Sub CmdAvvia1_Click()
Contatore = 0
picGrafico1.DrawWidth = 1
PrimoCiclo = True
MargineSX = 300
MargineDX = 150
NumeroElementi = UBound(Col1) - LBound(Col1)
Lunghezza = picGrafico1.Width - MargineSX
Altezza = picGrafico1.Height - MargineDX
Do
DoEvents
Contatore = Contatore + 1
Col1(Contatore) = Mid(Col1(Contatore), 1, 2)
If PrimoCiclo = True Then
Massimo = Col1(Contatore)
Minimo = Massimo
PrimoCiclo = False
Else
If Col1(Contatore) > Massimo Then
Massimo = Col1(Contatore)
End If
End If
If Col1(Contatore) < Minimo Then
Minimo = Col1(Contatore)
End If
Loop Until Contatore = UBound(Col1)
Contatore = 0
PrimoCiclo = True
If Minimo < 0 Then
Zero = Abs(Minimo) + 1
Else
Zero = 0
End If
CellaY = Int(Altezza / (NumeroElementi + 1))
CellaX = Int(Lunghezza / ((Massimo - Minimo) + 1))
' Traccia linea della metà
If Minimo < Massimo Then
Meta(1) = ((Massimo - Minimo) / 2) * 100
Else
End If
' Linea verticale rossa - centro
picGrafico1.Line (((CellaX * Zero) + 3000), 0)-(((CellaX * Zero) + 3000), Altezza), vbRed
' Linea verticale verde - centro relativo
picGrafico1.Line (((CellaX * Zero) + Meta(1)), 0)-(((CellaX * Zero) + Meta(1)), Altezza), vbGreen
Do
DoEvents
Contatore = Contatore + 1
X = (CellaX * (Col1(Contatore) + Zero)) - MargineDX
Y = (CellaY * Contatore) - MargineDX
picGrafico1.PSet (X, Y), vbYellow 'stesso colore background
picGrafico1.ForeColor = vbWhite
picGrafico1.Print " " & Col1(Contatore);
picGrafico1.ForeColor = vbCyan
If PrimoCiclo = True Then
picGrafico1.Line (X, Y)-(X, Y)
PrimoCiclo = False
Else
picGrafico1.Line (OldX + 30, OldY)-(X + 30, Y)
End If
OldX = X
OldY = Y
Loop Until Contatore = UBound(Col1)
LblMin1.Caption = "Minimo = " & Minimo
LblMax1.Caption = "Massimo = " & Massimo
End Sub
e qui segue il tuo codice
che disegna le linee ma sparisce il grafico.
Per il momento ho ovviato con Word ma è un lavoraccio, devo rilevarmi a mano le coordinate dei vari grafici e spostarmi su Word per tracciare le linee di congiunzione :mad:
Ciao Marco e grazie (tieni il conto dei minuti impegnati che poi ti invio un'assegno) :D :D
Sono difficoltà classiche, che insorgono quando non si è lavorato bene sulla separazione tra popolamento-grafico e disegno-grafico, che sono due cose ben diverse.
Da quel che vedo nel tuo codice non c'è una distinzione netta tra l'origine dei dati del grafico e il relativo disegno dello stesso, il che è un male. Arrivato ormai al punto di aver già scritto tutto ti risulterà difficile implementare il mio esempio.
Quello che posso consigliare è di riscrivere da zero la logica di generazione del grafico, facendo attenzione a separare senza mezzi termini il codice che popola il grafico ( inteso come insieme di punti, e quindi ad es. un array, oppure insieme di linee, usando un Public Type come il mio precedente... ), dal codice che lo disegna sulla PictureBox... Questo almeno è ciò che farei io fin dall'inizio, in fase di progettazione di una Form-Grafico :
1. Recupero dei dati in ingresso.
2. Individuazione dei dati utili per il grafico > inserimento nell'insieme-dati-grafico ( array ecc... )
3. Disegno dell'insieme-dati-grafico.
Secondo me sono 3 cose da tenere ben separate. ;)
Ciao Marco,
Hai perfettamente ragione, il guaio è che si comincia in un modo e poi sorgono altre idee, prima di scrivere bisognerebbe avere in mente cosa si vuole ottenere in uscita :cool:
Ad ogni modo, i dati in origine (leggi numeri) vengono prelevati da un File con questo codice e poi indirizzati alle varie Form che contengono il codice postato prima:
Tralascio le ovvie dichiarazioni:
K = 0
If Dir(App.Path & "\DatiGraf") <> "" Then
Open (App.Path & "\DatiGraf") For Input As #1
Do While Not EOF(1)
Line Input #1, Textline
ColSing = Textline
SeiNumeri = Mid(ColSing, 1, 12)
K = K + 1
Col1(K) = Mid(Num1, 1, 2)
Col2(K) = Mid(Num2, 3, 2)
Col3(K) = Mid(Num3, 5, 2)
Col4(K) = Mid(Num4, 7, 2)
Col5(K) = Mid(Num5, 9, 2)
Col6(K) = Mid(Num6, 11, 2)
NCifre(K) = UnNumero
Loop
Close #1
Else
End If
Riscriverlo da capo ? nonò mi ci sto perdendo gli occhi, al limite lo uso così com'è, ho fatto solo delle aggiunte e non saranno le ultime :D :D
Ciao, ti sono proprio grato per la tua disponibilità ed il tuo prezioso aiuto :)
Kralizek
11-08-2009, 08:30
a maggior ragione se pensi di fare delle aggiunte anche dopo, ti consiglio di seguire il consiglio di MarcoGG, ti verrá piú semplice estendere il progetto :)
Ringraziamenti a tutti, se avrò ancora bisogno di qualche consiglio sarò ancora qui a rompere, ora vedrò cosa mi sento di fare :D
:mc:
vBulletin® v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.