jag har gjort ett program där man lägger ut massa linjer(line) i olika lutningar. om jag vill t ex kunna höger klicka på en eller få den attändra färg är man håller musen över hur gör man det? Tänkte fört ha bilder bakom men dom går ju inte att luta i vissa vinklar och jag vill bara att man ska klicka rakt på den eller precis utanför.

någon som vet om detta går på något sätt? eller om ja ska skrota hela projektet?

Hej.

Har inte tillgång till något exempel,
men jag tror att du får använda tex MouseMove eventet på
ditt formulär och sen kolla om det "krockar" med någon linje.

Lycka till
/Uffe

ok de e iof lite jobbigt för man måste ju gå igenom varje pixel...
aja måste börja =)

danke sjön iaf

Du behöver inte alls kolla varje pixel.
Det är bara att använda lite formler:

k=(y2-y1)/(x2-x1)
m=y1-k*x1


1. Kolla om musens x-värde < min(x1,x2) eller om musens x > max(x1,x2)
2. Kolla om musens y-värde < min(y1,y2) eller om musens y-värde > max(y1,y2)
Om 1 eller 2 var sant så var inte musen i närheten.
3. Ta x-värdet för musen och sätt in i formeln y=kx+m
om det y-värde du får fram överrensstämmer med musens y-värde så är musen på linjen

Om du vill kunna klicka i närheten lägger du bara till en "minsta avstånds"-variabel.

/Niklas Jansson

ok fattade jag nästan....

On Error Resume Next

Dim X1 As Long
Dim X2 As Long
Dim Y1 As Long
Dim Y2 As Long
Dim K As Long
Dim M As Long
Dim siMon

For i = 1 To Form1.Line1.UBound

X1 = Form1.Line1(i).X1
X2 = Form1.Line1(i).X2
Y1 = Form1.Line1(i).Y1
Y2 = Form1.Line1(i).Y2

K = (Y2 - Y1) / (X2 - X1)
M = Y1 - K * Line1(i).X1


If X < Min(X1, X2) Or X > Max(X1, X2) Then
End If
If Y < Min(Y1, Y2) Or Y > Max(Y1, Y2) Then
End If


If Y = KX + M Then
MsgBox " tjoohooo"
End If

Avbryt:
Next i


End Function

så ser min funktion ut den ligger i form1 där alla linjerna ligger men det funkar inte

Fel: "sub or funktion not defined" varför? den markera ordet MIN!!! ja fattar nada

Hej
Min och Max är ju två st tvådimensionella arrayer.
Hur och var har du deklarerat dem.Vad heter Funktionen ?

undrar
Sven

ja trodeatt ja fick me allt men här kommer hela funktionen:

Private Function KlickarPaLinjer()
On Error Resume Next

Dim X1 As Long
Dim X2 As Long
Dim Y1 As Long
Dim Y2 As Long
Dim K As Long
Dim M As Long
Dim siMon

For i = 1 To Form1.Line1.UBound

X1 = Form1.Line1(i).X1
X2 = Form1.Line1(i).X2
Y1 = Form1.Line1(i).Y1
Y2 = Form1.Line1(i).Y2

K = (Y2 - Y1) / (X2 - X1)
M = Y1 - K * Line1(i).X1



If Y = KX + M Then
MsgBox " tjoohooo"
End If

Avbryt:
Next i

End Function

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
KlickarPaLinjer
end sub

jag har ingen speciel funktion för min och max!..

mvh simon

Hej
Eftersom du inte returnera något värde så skall du ändra till.

Private Sub KlickarPaLinjer()

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call KlickarPaLinjer
end sub

Det kommer att bli konstiga effekter men det är en annan sak
Tex den här raden begriper jag inte "rappakalja"
For i = 1 To Form1.Line1.UBound mm.mm.
Var har du hittat koden ? mycket är helt fel ?
mvh
Sven

for i raden är för att jag har flera linjer än en....
det kan finnas många linjer

ska man göra på nått annat sätt?!..

min sistaformel y = kx + m

jag har inte sattin nått värde i kx! vadskulle det vara där fattade noll...

här har du din kod...=)

den är inte helt bugg fri..men den är ju så som du vill ha den..om jag fattat rätt:
OBS: gjort en ny version...gammla koden kastade jag..nu funkar den för både neråt och en rak linje...:

Dim X1 As Long
Dim X2 As Long
Dim Y1 As Long
Dim Y2 As Long
Dim K As Long
Dim M As Long
Dim siMon

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
X1 = Form1.Line1.X1
X2 = Form1.Line1.X2
Y1 = Form1.Line1.Y1
Y2 = Form1.Line1.Y2

'rak linje:
K = (Y2 - Y1) / (X2 - X1)
M = Y1 - K * Line1.X1
'rak neråt:
j = (X2 - X1) / (Y2 - Y1)
n = X2 - j * Line1.Y1



If Y = KX + M Then
Line1.BorderColor = vbRed
Else
Line1.BorderColor = vbBlack
End If

If X = jX + n Then
Line1.BorderColor = vbRed
Else
Line1.BorderColor = vbBlack
End If
End Sub




hoppas du blir nöjd...
MVH
/bj

danke sjön men varför går det inte på snea?

aja ska testa lite

tack så mycket =)

Min lösning:
http://www.pellesoft.nu/login/upload/t_view4.asp?tid=198

danke sjön niklas funkar prima

men tack till bj som har slitit så hårt.... =)

Vill du ha förklaring på hur den fungerar, så fråga på bara. Det är inte allt för avancerat, men jag har gjort alla förenklingar innan.

/Niklas Jansson