Option Explicit
 
Dim Sz As Integer 'Schleifenzähler
Dim pXRichtung As Integer
Dim pYRichtung As Integer
 
Dim UcWidth As Integer
Dim UcHeight As Integer
 
Const Raster = 32
Const Kante = 32
 
Private Sub UserControl_Initialize()
picChip.ScaleMode = 3 'Fangraster
UserControl.lblkoordinaten.Caption = "B 2"
If pXRichtung < 3 Then
    pXRichtung = 3
    pYRichtung = 3
End If
End Sub
 
Sub picchip_mousedown(Button As Integer, Schift As Integer, X As Single, Y As _
  Single)
Dim PosX As Integer
Dim PosY As Integer
Dim Result As String
 
PosX = ((X - (X Mod Raster)) / 32) + 1
PosY = ((Y - (Y Mod Raster)) / 32) + 1
lblkoordinaten.Caption = (Chr$(PosX + 64) & " " & PosY)
End Sub
 
Private Sub picChip_MouseMove(Button As Integer, Shift As Integer, X As Single, _
  Y As Single)
 
With shpChip
    .Top = Y - (Y Mod Raster)
    .Left = X - (X Mod Raster)
End With
 
With LineV1
    .X1 = shpChip.Left + (240 Mod Raster)
    .X2 = shpChip.Left + (240 Mod Raster)
    .Y1 = Y - (Y Mod Raster)
End With
 
With LineV2
    .X2 = shpChip.Left + (240 Mod Raster)
    .Y2 = (shpChip.Top + shpChip.Height) + (0 Mod Raster)
    .X1 = shpChip.Left + (240 Mod Raster)
End With
 
With LineH1
    .Y2 = shpChip.Top + (240 Mod Raster)
    .Y1 = shpChip.Top + (240 Mod Raster)
    .X1 = shpChip.Left + (0 Mod Raster)
End With
 
With LineH2
    .Y2 = shpChip.Top + (240 Mod Raster)
    .Y1 = .Y2
    .X1 = shpChip.Left + shpChip.Width + (0 Mod Raster)
    End With
End Sub
 
 
Private Sub XZeichnen()
'Nach Rechts
'erstmal alles auf Standard
For Sz = 2 To LineV.UBound
    Unload LineV(Sz)
Next Sz
 
'nun die benötigte anzahl an Linien erstellen und Positionieren
For Sz = 2 To pXRichtung
    Load LineV(Sz): LineV(Sz).Visible = True
    LineV(Sz).X1 = LineV(Sz - 1).X1 + Kante
    LineV(Sz).X2 = LineV(Sz - 1).X2 + Kante
Next Sz
 
'jetzt noch die Horizontalen Linien auf die neue Länge anpassen
For Sz = 0 To LineH.UBound
    LineH(Sz).X2 = pXRichtung * Kante
Next Sz
 
'die Restlichen Elemente auf die Größe der Rasters einstellen
picChip.Width = pXRichtung * Kante * 15
lblkoordinaten.Left = picChip.Left + picChip.Width + 200
UcWidth = lblkoordinaten.Left + lblkoordinaten.Width + 200
Width = UcWidth
End Sub
 
Private Sub YZeichnen()
'Nach Unten
'erstmal alles auf Standard
For Sz = 2 To LineH.UBound
    Unload LineH(Sz)
Next Sz
 
'nun die benötigte anzahl an Linien erstellen und Positionieren
For Sz = 2 To pYRichtung
    Load LineH(Sz): LineH(Sz).Visible = True
    LineH(Sz).Y1 = LineH(Sz - 1).Y1 + Kante
    LineH(Sz).Y2 = LineH(Sz - 1).Y2 + Kante
Next Sz
 
'jetzt noch die Horizontalen Linien auf die neue Länge anpassen
For Sz = 0 To LineV.UBound
    LineV(Sz).Y2 = pYRichtung * Kante
Next Sz
 
'die Restlichen Elemente auf die Größe der Rasters einstellen
picChip.Height = pYRichtung * Kante * 15
UcHeight = picChip.Top + picChip.Height + 200
Height = UcHeight
End Sub
 
Public Property Get XRichtung() As Integer
XRichtung = pXRichtung
End Property
 
Public Property Let XRichtung(ByVal XRichtung As Integer)
pXRichtung = XRichtung
PropertyChanged "XRichtung"
Call XZeichnen
End Property
 
Public Property Get YRichtung() As Integer
YRichtung = pYRichtung
End Property
 
Public Property Let YRichtung(ByVal YRichtung As Integer)
pYRichtung = YRichtung
PropertyChanged "YRichtung"
Call YZeichnen
End Property
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
pXRichtung = PropBag.ReadProperty("pXRichtung", pXRichtung)
pYRichtung = PropBag.ReadProperty("pYRichtung", pYRichtung)
End Sub
 
Private Sub UserControl_Resize()
'sorgt dafür das der Benutzer die Größe des UserControls nicht willkürlich 
' ändern kann
If Width <> UcWidth Then Width = UcWidth
If Height <> UcHeight Then Height = UcHeight
End Sub
 
Private Sub UserControl_Show()
Call XZeichnen
Call YZeichnen
End Sub
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "XRichtung", pXRichtung
PropBag.WriteProperty "YRichtung", pYRichtung
End Sub