| |
Прилипание формы к границам экрана |
|
| |
Данный пример покажет, как ваша форма
автоматически "прилипает" к границам экрана
Создайте стандартный пример. В свойствах формы
укажите:
BorderStyle = 0 - None
ScaleMode = 3 - Pixel
Private Declare Function GetCursorPos Lib "user32"
(lpPoint As PointAPI) As Long
Private Type PointAPI
X As Long
Y As Long
End Type
Dim Pos As PointAPI
Dim A As Boolean
Dim B As Boolean
Dim C As Boolean
Dim D As Boolean
Dim SX As Integer
Dim SY As Integer
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SX = X
SY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetCursorPos Pos
If Not Button = vbLeftButton Then Exit Sub
If Pos.X - SX >= 10 Then A = False
If Pos.X - SX <= 10 Then Left = 0: A = True
If Pos.Y - SY >= 10 Then B = False
If Pos.Y - SY <= 10 Then Top = 0: B = True
If Pos.X - SX <= Screen.Width / Screen.TwipsPerPixelX - Width / Screen.TwipsPerPixelX -
10 Then C = False
If Pos.X - SX >= Screen.Width / Screen.TwipsPerPixelX - Width / Screen.TwipsPerPixelX -
10 Then Left = Screen.Width - Width: C = True
If Pos.Y - SY + Height / Screen.TwipsPerPixelY > Screen.Height / Screen.TwipsPerPixelX
- 10 Then Top = Screen.Height - Height: D = True
If Pos.Y - SY + Height / Screen.TwipsPerPixelY <= Screen.Height / Screen.TwipsPerPixelX
- 10 Then D = False
If B = True Then GoTo Cya
If D = True Then GoTo Cya
Top = Pos.Y * Screen.TwipsPerPixelY - SY * Screen.TwipsPerPixelY
Cya:
If A = True Then Exit Sub
If C = True Then Exit Sub
Left = Pos.X * Screen.TwipsPerPixelX - SX * Screen.TwipsPerPixelX
End Sub
'Автор этого проекта Беляев Данила outen@mail.ru
|
|
| |
|
|
|
|