Dim cvet  'Декларация на променлива за цвят

Dim Obekt ' Декларация на променлива за динамичен обект

Private Sub Command1_Click()

Form1.BackColor = RGB(255, 0, 0)

End Sub

 

'Въвеждане на формата в динамичния обект при кликане фърху нея

Private Sub Form_Click()

   Set Obekt = Form1

End Sub

 

'Въвеждане на формата в динамичния обект при първоначално въвеждане на формата

Private Sub Form_Load()

   Set Obekt = Form1

End Sub

 

'Въвеждане на етикета Label1 в динамичния обект при кликане фърху него

Private Sub Label1_Click()

   Set Obekt = Label1

End Sub

 

'Въвеждане на етикета Label2 в динамичния обект при кликане фърху него

Private Sub Label2_Click()

   Set Obekt = Label2

End Sub

 

'Въвеждане на текстовото поле Text1 в динамичния обект при кликане фърху него

Private Sub Text1_Click()

   Set Obekt = Text1

End Sub

 

'Въвеждане на текстовото поле Text2 в динамичния обект при кликане фърху него

Private Sub Text2_Change()

   Set Obekt = Text2

End Sub

 

'Процедура за смяна на фона сработваща при кликане върху първото меню

Private Sub menu1_Click()

   On Error Resume Next ' Манипулатор за грешка

   CommonDialog1.ShowColor ' Показва формата за избор на цвят

   Obekt.BackColor = CommonDialog1.Color ' Смяна на цвета на фона на динамичния обект

   cvet = Hex(CommonDialog1.Color) ' Превръщане на избрания цвят в шестнайсетично число

   Pokazvane ' Визуализиране на избрания цвят в двете текстови полета

End Sub

 

Private Sub menu2_Click()

   On Error Resume Next ' Манипулатор за грешка

   CommonDialog1.ShowColor ' Показва формата за избор на цвят

   Obekt.ForeColor = CommonDialog1.Color ' Смяна на цвета на буквите на динамичния обект

   cvet = Hex(CommonDialog1.Color) ' Превръщане на избрания цвят в шестнайсетично число

   Pokazvane ' Визуализиране на избрания цвят в двете текстови полета

End Sub

 

Private Sub Pokazvane()

   'Ако избрания свят се състои от по малко от 6 символа му добавяме последователно отпред нули

   If Len(cvet) = 1 Then cvet = 0 & cvet

   If Len(cvet) = 2 Then cvet = 0 & cvet

   If Len(cvet) = 3 Then cvet = 0 & cvet

   If Len(cvet) = 4 Then cvet = 0 & cvet

   If Len(cvet) = 5 Then cvet = 0 & cvet

   'Тук вече имаме със сигурност 6 символа, но те са разместени по двойки и трябва да ги подредим

   chetiri = Left(cvet, 4) ' Това са четирите символа преброени отляво

  Posledni = Right(cvet, 2) ' Това са двата символа преоброени отдясно

   sredni = Right(chetiri, 2) ' Това са двата символа в средата

   Predni = Left(cvet, 2) ' Това са двата символа от ляво

   ' Тук преподреждаме 6-те символа като последните два символа стават първи

   cvet = Posledni & sredni & Predni

   'За HTML в Hex добавяме отпред символа #

   Text1.Text = "#" & cvet ' Показваме го в Text1

   'За RGB, чрез функцията HextoDec превръщаме шестнайсетичните числа в десетични

   Text2.Text = HextoDec((Posledni)) & "," & HextoDec((sredni)) & "," & HextoDec((Predni)) ' Показваме резултата в Text2

End Sub

 

'Функцията превръщаща шестнайсетично число в десетично

Public Function HextoDec(HexNum As String) As Long

 

For i = 1 To Len(HexNum)

  c = Asc(UCase(Mid(HexNum, i, 1)))

  Select Case c

  Case 65 To 70

    lngOut = lngOut + ((c - 55) * 16 ^ (Len(HexNum) - i))

  Case 48 To 57

    lngOut = lngOut + ((c - 48) * 16 ^ (Len(HexNum) - i))

  Case Else

  End Select

Next i

HextoDec = lngOut

 

End Function