Для начала создадим новый проект ActiveX DLL

Затем добавим в проект модуль класса и зададим ему имя Button

В этот класс добавим следующий код:

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Button
X As Integer
Y As Integer
Vid As Integer
Icon As PictureBox
Text As String
TextCurrentX As Long
End Type
Dim P As POINTAPI
Dim Temp, Temp2, U, R As Integer
Dim B() As Button, H, L
Dim Object1 As Form
Dim But1 As PictureBox
Private Function Cur() As POINTAPI
GetCursorPos P
Cur.X = P.X - Object1.Left / 15 - 4
Cur.Y = P.Y - Object1.Top / 15 - 30
End Function
Private Function Draw(Button As Button)
If Button.Vid = 1 Then Object1.PaintPicture But1, Button.X, Button.Y, , , 0, , 80, 55
If Button.Vid = 2 Then Object1.PaintPicture But1, Button.X, Button.Y, , , 80, , 80, 55
If Button.Vid = 3 Then Object1.PaintPicture But1, Button.X, Button.Y, , , 0, 55, 80, 55
If Button.Vid = 4 Then Object1.PaintPicture But1, Button.X, Button.Y, , , 80, 55, 80, 55
If Button.Vid = 5 Then Object1.PaintPicture But1, Button.X, Button.Y, , , 160, , 80, 55
If Button.Vid = 5 Then Object1.PaintPicture Button.Icon, Button.X + 25, Button.Y + 5 Else Object1.PaintPicture Button.Icon, Button.X + 24, Button.Y + 4
If Button.Vid = 5 Then
Object1.CurrentX = Button.X + Button.TextCurrentX + 1
Object1.CurrentY = Button.Y + 37
Else
Object1.CurrentX = Button.X + Button.TextCurrentX
Object1.CurrentY = Button.Y + 36
End If
Object1.Print Button.Text
End Function
Public Function MouseDown()
If Temp <> 0 Then
R = 1
Temp2 = Temp
End If
End Function
Public Function MouseUp()
If R = 1 Then
R = 0
If Temp = Temp2 Then B(L).Vid = 3: L = Temp2
End If
End Function
Public Function Timer_but(Object As Object, But As Object)
Set Object1 = Object
Set But1 = But
If R <> 1 Then
If Temp = L Then B(Temp).Vid = 1 Else B(Temp).Vid = 3
End If
For I = 1 To UBound(B)
If Cur.X >= B(I).X And Cur.X <= 80 + B(I).X And Cur.Y >= B(I).Y And Cur.Y <= 55 + B(I).Y Then Temp = I Else U = U + 1
Next
If U = UBound(B) Then Temp = 0
U = 0
If R <> 1 Then
If Temp = L Then B(Temp).Vid = 4 Else B(Temp).Vid = 2
End If
Label1 = Temp
If R = 1 And Temp = 0 And Temp2 <> L Then B(Temp2).Vid = 2
If R = 1 And Temp = Temp2 Then If Temp = L Then B(Temp).Vid = 4 Else B(Temp).Vid = 5
If R = 0 And Temp <> Temp2 And Temp2 <> L Then B(Temp2).Vid = 3: Temp2 = 0
For J = 1 To UBound(B)
Draw B(J)
Next
End Function
Public Property Get Nazhata() As Variant
Nazhata = L
End Property
Public Function Shtuk(Sht)
L = 1
ReDim B(Sht)
End Function
Public Function CreateBut(X, Y, Icon As Object, Text As String, TextCurrentX As Long)
H = H + 1
If H = 1 Then B(H).X = X: B(H).Y = Y: B(H).Vid = 1 Else: B(H).X = X: B(H).Y = Y: B(H).Vid = 3
Set B(H).Icon = Icon
B(H).Text = Text
B(H).TextCurrentX = TextCurrentX
End Function