Hallo Boyle,
es geht auch mit einer Picturebox, wenn es nur horizontale und
vertikale Linien gibt:
'Benötigt werden: 1 x Label, 1 x PictureBox, 1 x Line-Control
Option Explicit
Private LIx&, XPos%, YPos%, BeR%, LN%(), LFarb&()
Private Sub Form_Load()
Dim i%, N%, Farbe&, P1%, P2%, P3%, P4%
BeR = 3 'Größe Anfassbereich
Me.ScaleMode = 3
Me.WindowState = 2
Line1.Visible = False
Set Line1.Container = Picture1
With Picture1
.BackColor = 0
.Move 10, 10, 400, 304
.ScaleMode = 3
.AutoRedraw = True
.Cls
Label1.Move .Left + .Width, .Top
N = 0
For i = 30 To .ScaleWidth - 30 Step 30
P1 = i: P2 = 30: P3 = i: P4 = .ScaleHeight - 30
Farbe = vbRed 'beliebig
GoSub Setze
Next i
For i = 30 To .ScaleHeight - 30 Step 30
P1 = 30: P2 = i: P3 = .ScaleWidth - 30: P4 = i
Farbe = vbBlue 'beliebig
GoSub Setze
Next i
End With
LIx = -1
Exit Sub
Setze:
ReDim Preserve LN(3, N), LFarb(N)
LN(0, N) = P1
LN(1, N) = P2
LN(2, N) = P3
LN(3, N) = P4
LFarb(N) = Farbe
Picture1.Line (P1, P2)-(P3, P4), Farbe
N = N + 1
Return
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As _
Single, Y As Single)
Dim i%
XPos = X
YPos = Y
If LIx <> -1 Then
Picture1.Cls
For i = 0 To UBound(LN, 2)
If i <> LIx Then
Picture1.Line (LN(0, i), LN(1, i))-(LN(2, i), LN(3, i)), LFarb(i)
End If
Next i
With Line1
.X1 = LN(0, LIx)
.Y1 = LN(1, LIx)
.X2 = LN(2, LIx)
.Y2 = LN(3, LIx)
.BorderColor = LFarb(LIx)
.ZOrder
.Visible = True
End With
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As _
Single, Y As Single)
Dim i%
If Button = vbLeftButton And LIx <> -1 Then
With Line1
If .X1 = .X2 Then
.X1 = LN(0, LIx) - XPos + X
.X2 = .X1
Else
.Y1 = LN(1, LIx) - YPos + Y
.Y2 = .Y1
End If
End With
ElseIf Button = 0 Then
LIx = -1
For i = 0 To UBound(LN, 2)
If LN(0, i) = LN(2, i) Then
If Abs(LN(0, i) - X) < BeR Then
LIx = i
Exit For
End If
Else
If Abs(LN(1, i) - Y) < BeR Then
LIx = i
Exit For
End If
End If
Next i
If LIx = -1 Then
Label1.Caption = "leer"
Else
Label1.Caption = "Linie " & LIx
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, _
Y As Single)
Dim i%
If LIx <> -1 Then
With Line1
.Visible = False
LN(0, LIx) = .X1
LN(1, LIx) = .Y1
LN(2, LIx) = .X2
LN(3, LIx) = .Y2
Picture1.Line (.X1, .Y1)-(.X2, .Y2), .BorderColor
End With
End If
End Sub Gruß
Zardoz |