Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Перемещение контролла Добавлено: 08.10.10 18:36  

Автор вопроса:  Игорь | ICQ: 457394129 
В общем нарыл функции, пытаюсь таскать контролл по форме:
Call ReleaseCapture
Call SendMessage(Component(Index).hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)


Контролл та таскается, тока вот его координаты не обновляются, то бишь что Left что Top остаются первоначальными, что посоветуете?

Ответить

  Ответы Всего ответов: 2  

Номер ответа: 1
Автор ответа:
 



Администратор

ICQ: 278109632 

Вопросов: 42
Ответов: 3949
  Web-сайт: domkratt.com
 Профиль | | #1 		Добавлено: 08.10.10 18:40
GetWindowRect

Ответить

Номер ответа: 2
Автор ответа:
 Just



Вопросов: 4
Ответов: 330
  Профиль | | #2 Добавлено: 08.10.10 22:41
вот модуль который я делал для своих нужд (все лишнее я убрал, вызывать просто: "MoveObject хэндл_объекта";)

'форма
  1.  
  2. Private Sub Picture1_Click()
  3. MoveObject Picture1.hwnd
  4. End Sub




'модуль
  1.  
  2. Option Explicit
  3.  
  4. 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
  5. Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
  6. Private Declare Function ReleaseCapture Lib "user32" () As Long
  7. Private Const WM_NCLBUTTONDOWN = &HA1&
  8. Private Const HTCAPTION = 2&
  9.  
  10. Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  11. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  12. Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  13. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  14.  
  15. Private Type RECT
  16.     Left As Long
  17.     Top As Long
  18.     Right As Long
  19.     Bottom As Long
  20. End Type
  21.  
  22. Private Type POINTAPI
  23.     X As Long
  24.     y As Long
  25. End Type
  26.  
  27. Private CurPos As POINTAPI
  28. Private rcWnd As RECT
  29.  
  30.  
  31. Public Function MoveObject(lHwnd As Long) As Boolean
  32. BringWindowToTop lHwnd
  33. ReleaseCapture
  34. SendMessage lHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
  35. MoveObject = PlaneObject(lHwnd)
  36. End Function
  37.  
  38.  
  39. Private Function PlaneObject(lHwnd As Long) As Boolean
  40. 'On Error Resume Next
  41. Dim lRet As Long, lParentHeight As Long
  42. Dim lObjectTop As Long, lObjectLeft As Long, lObjectRight As Long, lObjectBottom As Long, lObjectHeight As Long, lObjectWidth As Long
  43.  
  44. 'получение относительных координат объекта
  45. lRet = GetWindowRect(lHwnd, rcWnd)
  46. If lRet = 0 Then PlaneObject = False: Exit Function
  47. '''''''''''''''''''''''''''лево\верх
  48. CurPos.X = rcWnd.Left
  49. CurPos.y = rcWnd.Top
  50. lRet = ScreenToClient(GetParent(lHwnd), CurPos)
  51. If lRet = 0 Then PlaneObject = False: Exit Function
  52. lObjectLeft = CurPos.X
  53. lObjectTop = CurPos.y
  54. 'MsgBox lObjectLeft
  55. 'MsgBox lObjectTop
  56. '''''''''''''''''''''''''''право\низ
  57. CurPos.X = rcWnd.Right
  58. CurPos.y = rcWnd.Bottom
  59. lRet = ScreenToClient(GetParent(lHwnd), CurPos)
  60. If lRet = 0 Then PlaneObject = False: Exit Function
  61. lObjectRight = CurPos.X
  62. lObjectBottom = CurPos.y
  63. 'MsgBox lObjectRight
  64. 'MsgBox lObjectBottom
  65. '''''''''''''''''''''''''''ширина\высота
  66. lObjectWidth = lObjectRight - lObjectLeft
  67. lObjectHeight = lObjectBottom - lObjectTop
  68. 'MsgBox lObjectWidth
  69. 'MsgBox lObjectHeight
  70.  
  71. 'получение относительных координат формы
  72. lRet = GetWindowRect(GetParent(lHwnd), rcWnd)
  73. If lRet = 0 Then PlaneObject = False: Exit Function
  74. '''''''''''''''''''''''''''высота
  75. CurPos.X = rcWnd.Top
  76. CurPos.y = rcWnd.Bottom
  77. lRet = ScreenToClient(GetParent(lHwnd), CurPos)
  78. If lRet = 0 Then PlaneObject = False: Exit Function
  79. lParentHeight = CurPos.y
  80. 'MsgBox lParentHeight
  81.  
  82. 'проверка выхода за пределы формы
  83. If lObjectTop < 0 Then
  84.   lObjectTop = 0
  85. ElseIf (lObjectTop + lObjectHeight) > lParentHeight Then
  86.   lObjectTop = (lParentHeight - lObjectHeight)
  87.   'MsgBox "объект вышел за пределы формы"
  88. End If
  89.  
  90. 'переместить
  91. lRet = MoveWindow(lHwnd, lObjectLeft, lObjectTop, lObjectWidth, lObjectHeight, 1)
  92.  
  93. If lRet <> 0 Then
  94.   PlaneObject = True
  95. Else
  96.   PlaneObject = False
  97. End If
  98. End Function

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам