| taravasya 
 
  
 Member
 | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору Как в VBA 6.5(офис 2007) перемещать окно формы без заголовка?
 Нарыл вот такой код:
 
 Код:
 | Private Sub Detail_MouseMove(Button As Integer, _ Shift As Integer, X As Single, Y As Single)
 fMoving = True
 End Sub
 
 Private Sub Detail_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
 Dim sngNewX As Single
 Dim sngNewY As Single
 If (fMoving) Then
 ' calculate using window dimensions so the mouse doesn't jump
 sngNewX = (Me.WindowLeft - Me.WindowWidth / 2) + X
 sngNewY = (Me.WindowTop - Me.WindowHeight / 2) + Y
 
 ' move the form
 Me.Move sngNewX, sngNewY
 End If
 End Sub
 
 Private Sub Detail_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
 fMoving = False
 End Sub
 
 | 
 Он почти работает. Но в нём есть один большой недостаток. Его надо либо применять к маленькой картинке, либо надо смириться с прыжком формы в начале передвижения мышкой. Здесь её навострили для того что бы в начале перемещения мышки, курсор оказывался по середине объекта:
 
 Код:
 | sngNewX = (Me.WindowLeft - Me.WindowWidth / 2) + X sngNewY = (Me.WindowTop - Me.WindowHeight / 2) + Y
 | 
 Причём в комментарии говориться, что мол для того, что бы мышка не прыгала... А толку? Мышка прыгает или окно?... Не велика разница. И что самое смешное, что такое безобразие лежит на мсдн-е. Неужели нет ничего элегантнее?
 
 Добавлено:
 ВАУ!!! Нашёл другой код. Немножко покалдовал, убрал, добавил, перемешал и вышло вот такое:
 
 Код:
 | Private fMoving As Boolean Dim preX As Long
 Dim preY As Long
 Private Sub ЗаголовокФормы_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 fMoving = True
 preX = X
 preY = Y
 
 End Sub
 
 Private Sub ЗаголовокФормы_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If (fMoving) Then
 Me.Move Me.WindowLeft + (X - preX), Me.WindowTop + (Y - preY)
 End If
 End Sub
 
 Private Sub ЗаголовокФормы_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 fMoving = False
 End Sub
 | 
 Работает на ура!
 |