'СОРС ЗА ФОРМАТА

'При въвеждане на формата

Private Sub Form_Load()

SkrivaneNaLentata Form1 ' Задействаме процедурата за скриване на лентата, която се намира в модула, указвайки за коя форма иде реч

NapraviProzrachna Form1, vbRed ' Задействаме процедурата за прозрачност относно всичко което е червено

End Sub

'Затваряне на формата

Private Sub Command2_Click()

Unload Me ' Извежда формата

End Sub

'При натискане на бутончето за минимизиране на формата

Private Sub Command3_Click()

Minimizirane Form1 'Задействаме процедурата от модула за минимизиране на форма без лента

End Sub

' При възстановяване на нормален изглед след Минимизация

Private Sub Form_Resize()

SkrivaneNaLentata Form1 ' Задействаме процедурата от модула за скриване на лентата, указвайки за коя форма иде реч

End Sub

'При кликане върху прозрачния етикет Label1 показваме съобщение, демонстрирайки как всяка област може да се превърне в контрола

Private Sub Label3_Click()

MsgBox "Това е моя нос, защо ме дразниш?", vbCritical, "Пример за задействане на събитие от произволна област"

End Sub

''''''''''''''''''''''''Следва преместване на формата, чрез натискане с мишката върху синята лента и преместване на мишката '''''''''''''

'При мишка в долно положение

Private Sub image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

DolnoPol Form1, X, Y ' Задействаме процедура от модула, която да запомни това положение и да разреши преместване на обекта

End Sub

' При премествамене на мишката

Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Premestvane Form1, X, Y ' Задействаме процедурата от модула за местене на обекта, като непрекъснато подаваме X и Y

End Sub

' При мишка горе

Private Sub image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

flag = 0 ' Сменяме флага, скоето забраняваме по нататъшното местене на формата

End Sub

'СОРС ЗА МОДУЛА

Public flag, ZapomnenaX, ZapomnenaY 'Декларации

'Декларираме двете АПИ функции, които ще направят формата прозрачна

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

'Процедура за превръщане на формата в прозрачна за конкретен цвят

Public Sub NapraviProzrachna(Obekt, Cvet As Long)

SetWindowLong Obekt.hWnd, -20, &H80000 ' Указва формата да се покаже само като слой без други конфигурации

SetLayeredWindowAttributes Obekt.hWnd, Cvet, &H0, &H1 'Тук указваме за кой цвят точно искаме да стане прозрачна формата

End Sub

' Процедура за Скриване на лентата

Public Sub SkrivaneNaLentata(ObektForma)

If ObektForma.WindowState <> 1 Then ' Ако състоянието е различно от Минимизирано

ObektForma.BorderStyle = 0 ' Сменяме стила на формата без лента

ObektForma.Caption = ObektForma.Caption ' Караме формата да се обнови, като я принуждаваме да си напише отново надписа на формата

End If

End Sub

' Процедура за минимизиране на форма без лента

Public Sub Minimizirane(ObektForma)

ObektForma.Visible = False 'Правим невидима формата, за да не се види как тя ще си смени стила

ObektForma.BorderStyle = 2 ' Сменяме стила на формата

ObektForma.Caption = ObektForma.Caption ' Караме формата да се обнови, като я принуждаваме да си напише отново надписа

ObektForma.WindowState = 1 ' Едва сега можем да я минимизираме

ObektForma.Visible = True ' И отново я правим видима

End Sub

'Процедура при мишка долу

Public Sub DolnoPol(Obekt, XX, YY)

flag = 1 ' Флаг запомнящ състоянието на мишката-долно положение на бутона

ZapomnenaX = Obekt.Left + XX ' Положение по Х на мишката в долно положение на бутона

ZapomnenaY = Obekt.Top + YY ' Положение по Y на мишката в долно положение на бутона

End Sub

' Процедура при преместване на мишката

Public Sub Premestvane(Obekt, XX, YY)

If flag = 1 Then ' IF позволяващ преместване на обекта само при долно положение на мишката

dX = Obekt.Left + XX ' Отклонение по Х при преместване на мишката

dY = Obekt.Top + YY ' Отклонение по Y при преместване на мишката

Obekt.Left = Obekt.Left + dX - ZapomnenaX 'Реално преместване на обекта по X

Obekt.Top = Obekt.Top + dY - ZapomnenaY 'Реално преместване на обекта по Y

ZapomnenaX = dX 'Запомняне на последното положение

ZapomnenaY = dY 'Запомняне на последното положение

End If

End Sub