Visual Basic, .NET, ASP, VBScript
 

   
   
     

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

Страница: 1 |

 

  Вопрос: Мерцание UserControl'a Добавлено: 10.03.05 22:37  

Автор вопроса:  HACKER
Вот хотел контрол написать, спрайтер, его задача просто ездить по форме и говорить свои кординаты. Ездить он будет когда его будут тягать мышкой, и тут такая канитель приключилась... Ну мало того что UserControl с кода в форме перемещается нормально, а с кода в UserControl'e он перемещатся на форме, когда я ему указываю новые кординаты, нехочет. Ну думаю лана, есть айпи которые перемещают элементы зная хендл. Ну слава богу что хоть UserControl хендл имеет :) Так вот, переместить UserControl с кода внутри этого же UserControl'a с горем пополам получается, используя API функции


Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
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


Перемещает "почти" нормально... если бы при очень частом перемещении он ещё и не мерцал...

вообщем есть в контроле, батон, например. Я хочу чтоб этот батон тягался по форме вместе с контролом... Всё как обычно...

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Call MoveWindow(UserControl.hwnd, x / 15, y / 15, UserControl.Width, UserControl.Height, 0)

End Sub

это примерно :) И короче вот таким способом он страшно плохо ездит по форме... Пробывал по другому... вообщем вот:

http://webfile.ru/213756

от така у мяня трабла...

Ответить

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

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


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #1 Добавлено: 10.03.05 23:22
;)



Option Explicit

'***************************************************************************************
'*                     Написано: 10.03.2005 (Team HomeWork)                            *
'*                           e-mail: sne_pro@mail.ru                                   *
'***************************************************************************************

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
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetParent Lib "user32.dll" (ByVal hwnd As Long) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private bIsDwn  As Boolean
Private ptgOld  As POINTAPI
Private ptpOld  As POINTAPI

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    bIsDwn = True

    Call GetCursorPos(ptgOld)
    Call GetCursorPos(ptpOld)

    Call ScreenToClient(GetParent(UserControl.hwnd), ptpOld)
    ptpOld.x = ptpOld.x - x \ Screen.TwipsPerPixelX
    ptpOld.y = ptpOld.y - y \ Screen.TwipsPerPixelY
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim pt      As POINTAPI

    If bIsDwn Then
        Call GetCursorPos(pt)
        pt.x = pt.x - ptgOld.x + ptpOld.x
        pt.y = pt.y - ptgOld.y + ptpOld.y

        Call MoveWindow(UserControl.hwnd, pt.x, pt.y, UserControl.Width \ Screen.TwipsPerPixelX, UserControl.Height \ Screen.TwipsPerPixelY, True)
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    bIsDwn = False
End Sub



Всем спасибо за внимание :)

Ответить

Страница: 1 |

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



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