Ziemlich umfangreiche Anforderung.
Hier nur ein einfaches Beispiel.
Public Class frmMoveControls
Private Class cmp
Implements ICloneable
Public _bmp As Bitmap
Public _typ As String
Public _col As Color
Public _location As New Point
Public Sub New(bmp As Bitmap, typ As String)
_bmp = bmp : _typ = typ
_col = Color.Red
End Sub
Public Function Clone() As Object Implements ICloneable.Clone
Return MemberwiseClone()
End Function
End Class
Dim rasterheight As Integer = 50
Dim markercolor As Color = Color.Green
Dim cmps As New List(Of cmp) 'Komponenten
Dim cmps_inst As New List(Of cmp) 'Installierte Komponenten
Dim WithEvents compo_list As New PictureBox With
{.Parent = Me, .Width = 200, .Height = 600, .Left = 220}
'Schaltkasten für installierte Komponenten
Dim WithEvents compo_box As New PictureBox With
{.Parent = Me, .Width = 200, .Height = 600}
Private Sub frmMovePics_Load(sender As Object,
e As EventArgs) Handles MyBase.Load
Me.Size = New Size(600, 700)
For i As Integer = 0 To 5
Dim cmp As New cmp(New Bitmap(150, rasterheight), "C_" & i.ToString)
cmps.Add(cmp)
cmp._location = New Point(10, i * (rasterheight + 10))
Next i
End Sub
Private Sub pbox_Paint(sender As Object,
e As PaintEventArgs) Handles compo_list.Paint, compo_box.Paint
Dim lst As List(Of cmp)
lst = cmps_inst
If DirectCast(sender, PictureBox) Is compo_list Then lst = cmps
PaintCmpList(lst, e.Graphics)
End Sub
Private Sub PaintCmpList(clist As List(Of cmp), gr As Graphics)
gr.Clear(Color.White)
For i As Integer = 0 To clist.Count - 1
Using br As New SolidBrush(clist(i)._col),
pn As New Drawing.Pen(br, 2),
f As New Font("Arial", 10)
gr.DrawRectangle _
(pn, New Rectangle(clist(i)._location, clist(i)._bmp.Size))
Dim pt As Point = clist(i)._location
pt.Offset(20, 20)
gr.DrawString(clist(i)._typ, f, br, pt)
End Using
Next i
End Sub
Private Sub compo_list_MouseDown(sender As Object,
e As MouseEventArgs) Handles compo_list.MouseDown
For i As Integer = 0 To cmps.Count - 1
Dim cr As New Rectangle(cmps(i)._location, cmps(i)._bmp.Size)
If cr.Contains(New Point(e.X, e.Y)) Then
'Wahl einer zu installierenden Komponente
cmps(i)._col = markercolor
cmps_inst.Add(DirectCast(cmps(i).Clone, cmp))
Cursor = Cursors.Cross
Else
cmps(i)._col = Color.Red
End If
Next i
PaintCmpList(cmps, compo_list.CreateGraphics)
End Sub
Private Sub compo_box_MouseMove(sender As Object,
e As MouseEventArgs) Handles compo_box.MouseMove
If CheckMarker() >= 0 Then
If CheckTarget(New Point(e.X, e.Y)) Then
Cursor = Cursors.Cross
Else
Cursor = Cursors.No
End If
Else
Cursor = Cursors.Default
End If
End Sub
Private Function CheckTarget(mouseposition As Point) As Boolean
For i As Integer = 0 To cmps_inst.Count - 1
Dim cr As New Rectangle(cmps_inst(i)._location, cmps_inst( _
i)._bmp.Size)
cr.Inflate(5, 5)
If Not cmps_inst(i)._col = markercolor AndAlso
(Cursor <> Cursors.Default And cr.Contains(mouseposition)) Then
Return False
End If
Next i
Return True
End Function
Private Function CheckMarker() As Integer
For i As Integer = 0 To cmps.Count - 1
If cmps(i)._col = markercolor Then Return i
Next i
Return -1
End Function Rest im zweiten Teil |