Манипуляции с окнами
25-06-2008 15:35
к комментариям - к полной версии
- понравилось!
Обратила внимание, что часть кода работоспособная в Win98 перестала корректно работать в WinXP. Публикую подправленый код.
1) Создаем окно с BorderStyle=0 (Нет)
2) В окне несколько элементов Picture и задаем ем следущие имена:
- BorderU
- BorderD
- BorderL
- BorderR
- BorderS
- Header
3) В секции (General)(Declaration):
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
4)Процедуры:
Private Sub HeadBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Таскаем окно по экрану за заголовок
ReleaseCapture
SendMessage Me.hwnd, &HA1, 2, 0&
End Sub
Private Sub BorderD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
If Button = 1 Then
SendMessage Me.hwnd, &HA1, 15, 0& 'изменяем положение нижней границы окна при нажатой левой кнопки мыши
Else
SendMessage Me.hwnd, &HA1, 12, 0& 'изменяем положение верхней границы окна при нажатии правой кнопки мыши
End If
End Sub
Private Sub BorderR_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
If Button = 1 Then
SendMessage Me.hwnd, &HA1, 11, 0& '11 правая граница
Else
SendMessage Me.hwnd, &HA1, 10, 0& '11 левая граница
End If
End Sub
Private Sub BorderS_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
If Button = 1 Then
SendMessage Me.hwnd, &HA1, 17, 0& 'низ и правая
Else
SendMessage Me.hwnd, &HA1, 13, 0& 'верх и лево
End If
End Sub
Private Sub Form_Resize()
Dim i As Integer, w As Single
BorderU.Move 0, 0, Me.ScaleWidth, 120
HeadBar.Move BorderU.Left, BorderU.Height, BorderU.Width - 240,480
BorderL.Move 0, 120, 120, Me.ScaleHeight - 240
BorderR.Move Me.ScaleWidth - 120, 120, 120, Me.ScaleHeight - 240
BorderD.Move 0, Me.ScaleHeight - 120, Me.ScaleWidth - 120, 120
BorderS.Move Me.ScaleWidth - 120, Me.ScaleHeight - 120
End Sub
5) Бордюры раскрашиваем или цветом или при помощи метода .Line (в последнем случае на забудте установить свойство AutoRedraw = True)
6) Попробуйте изменять размеры окна при нажатой левой или правой кнопок мыши.
вверх^
к полной версии
понравилось!
в evernote