Страница: 1 | 2 | 3 |
Вопрос: Как поймать событие чужого окна?
Добавлено: 03.01.07 22:08
Автор вопроса: -АлександР- | Web-сайт:
Точнее, как поймать событие resize парент-окна из кода ю-котрола?
Подскажите, в какую сторону вообще глядеть
VB6,
заведомо благодарен
Ответы
Всего ответов: 37
Номер ответа: 1
Автор ответа:
Artyom
Разработчик
Вопросов: 130
Ответов: 6602
Профиль | | #1
Добавлено: 03.01.07 23:02
Private Sub UserControl1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
AddHandler Me.Parent.Resize, AddressOf ParentResize
End Sub
Sub ParentResize(ByVal sender As Object, ByVal e As System.EventArgs)
End Sub
End Class
Это .NET. Типа для сравнения геморойности методов.
В 6-ке тебе нужно юзать сабклассинг - успехов!
Номер ответа: 2
Автор ответа:
Artyom
Разработчик
Вопросов: 130
Ответов: 6602
Профиль | | #2
Добавлено: 03.01.07 23:04
Кстати, попробуй что-то типа такого сделать:
Sub Init ()
MyParent = Me.Container
End Sub
Как-то так, у меня нет VB6 поэтому я мог где-то ошибиться в синтаксисе или названии процедур, но смысл такой - объявляешь некую переменную с ключевым словом WithEvents и сможешь доступаться к ее событиям. Возможно заработает.
Номер ответа: 3
Автор ответа:
GSerg
Вопросов: 0
Ответов: 1876
Профиль | | #3
Добавлено: 04.01.07 07:08
-АлександР-, а тебе мало было http://www.vbnet.ru/forum/show.aspx?id=126828 ?
Нафиг плодить?
Я же тебе сразу сказал - в режиме дизайна у формы нет событий и ты не сможешь их ловить.
Номер ответа: 4
Автор ответа:
-АлександР-
Вопросов: 55
Ответов: 1008
Web-сайт:
Профиль | | #4
Добавлено: 04.01.07 16:23
Brand
Ну к сожалению на .Нет я пока не решаюсь... но это пока скоро подойдет к концу...
Кстатти, в тему, а можно осуществить на .Нет такое:
нарисовать на контроле методами gdi+ что-то, сделать сам контрол прозрачным. так, чтобы нарисованное было видно(это я знаю, что моно) и
оно обрабатывало mousedown/move ?
GSerg
А в дизайне только юзерконтрола show рулит нормально, да и то оно вызывается:
1)когда ложишь в дизайне его на форму
2)когда form-load
3)-//- unload
и никакие переменные не сохраняют, чтоьы ему сазать: при первом разе елай то-то, при втором - то-то.
Форму отвраперить тоже нормально не получилось, ((((
потому что et frn= form1 дол/быть чтобы поймать событие form_load, а этого никак не сделать, т. к. объект extender еще не создан до этой процедуры. Значит нельзя получить через контейнер((
Вряд ли из этого нету выхода, но долшо искать...
опыт нужен больший, чем у меня
Номер ответа: 5
Автор ответа:
Artyom
Разработчик
Вопросов: 130
Ответов: 6602
Профиль | | #5
Добавлено: 04.01.07 16:30
нарисовать на контроле методами gdi+ что-то, сделать сам контрол прозрачным. так, чтобы нарисованное было видно(это я знаю, что моно) и
оно обрабатывало mousedown/move ?
С помощью региона можно.
Номер ответа: 6
Автор ответа:
-АлександР-
Вопросов: 55
Ответов: 1008
Web-сайт:
Профиль | | #6
Добавлено: 05.01.07 11:45
А можно сделать регион по гарисованной форме (незамкнутой)?
Номер ответа: 7
Автор ответа:
EROS
Вопросов: 58
Ответов: 4255
Профиль | | #7
Добавлено: 05.01.07 12:14
Если наследоваться от Control или UserControl, то функциональность мыши в них уже изначально заложена, и для реализации этих событий вообще ничего делать не надо..
Номер ответа: 8
Автор ответа:
Artyom
Разработчик
Вопросов: 130
Ответов: 6602
Профиль | | #8
Добавлено: 05.01.07 17:21
Можно.
Номер ответа: 9
Автор ответа:
Artyom
Разработчик
Вопросов: 130
Ответов: 6602
Профиль | | #9
Добавлено: 05.01.07 17:27
Лучше поищи на vbnet.ru статью про регионы, многие вопросы сами собой отпадут, похоже ты не совсем понимаешь как это с технической точки зрения работает.
Номер ответа: 10
Автор ответа:
Fever
Вопросов: 60
Ответов: 808
Профиль | | #10
Добавлено: 28.01.07 17:10
И что?
Ох нафлудили...
С помощью Get/SetWindowLong для параметра #(-4) т.е процедуры WindowProc мы сохраняем старое значение в переменную OldWndProc, а затем ставим свое AdressOf MyWndProc.
Процедура MyWndProc должна быть определена как всегда, и к тому же в модуле.
В ней мы отлавливаем нужные события и т.д. Если есть события которые мы хотим обрабатывать обычным способом мы вызываем OldWndProc с помощью CallWindowProc. Про отладку внутри процедуры MyWndProc забудь, будет куча новых глюков, а со старыми ты не справишься. Также внутри этой сабы не должно быть End, Stop, Debug.XXX, Msgbox, InputBox и ошибок. Вообщем главное - написать в первый раз
Хреновенький пример:
' ___ ___
' /\__\ /\__\
' /:/ _/_ /:/ /
' /:/ /\ \ /:/ /___
' /:/ /::\ \ /:/ //\ \
' /:/_/:/\:\__\ /:/__/ \:\__\
' \:\/:/ /:/ / \:\ \ /:/ /
' \::/ /:/ / \:\ /:/ /
' \/_/:/ / \:\/:/ /
' /:/ / \::/ /
' \/__/ \/__/
' STARGAZER GROUP
Option Explicit
Option Base 1
'Begin Definitions
' Begin API
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal lngHandle As Long, ByVal lngMsg As Long, ByVal lngFirstParam As Long, ByVal lngLastParam As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal lngHandle As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RectEx) As Long
Private Declare Function GetCursorPos Lib "user32" (pntPoint As Point) As Long
Private Declare Function SystemParametersInfoA Lib "user32" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible& Lib "user32" (ByVal hWnd As Long)
Private Declare Function GetParent& Lib "user32" (ByVal hWnd As Long)
Private Declare Function GetDesktopWindow Lib "user32" () As Long
'debug
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
'Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
' End API
' Begin Types
'API need it
Private Type Point
X As Long
Y As Long
End Type
'rectangle of related window
Private Type RectEx
Left As Long
Top As Long
Right As Long
Bottom As Long
'following enhancement can do some bad things, but this makes code easier
Width As Long
Height As Long
OldWProc As Long
hWnd As Long
End Type
' End Types
' Begin Variables
Public RelWnd() As RectEx, RWCount As Long 'Related Windows
Private m_Borders() As RectEx, BCount As Long 'All lines to join
Private m_Enabled As Boolean, m_Size As Long 'Propertie's inner variables
Private SPoint As Point 'Coordinates of cursor when move started
'this should be inside WndProc, but it cause memory loses
Private WScreen As RectEx 'Properties of screen(without taskbar)
Private CPoint As Point 'Current Point
Private Iter As Long 'Cycle iterator
Private CurrRW As Long 'Window which is moving now
Private TRect As RectEx 'temporary rectangle
Private TMP0 As Long
' End Variables
'End
'Begin Code
Private Sub StartHook() 'this procedures starts subclassing for all related windows
Dim I As Long
For I = 1 To RWCount
With RelWnd(I)
If .hWnd <> 0 Then
.OldWProc = SetWindowLongA(.hWnd, -4, AddressOf WndProc) 'I don't like this.
End If
End With
Next I
End Sub
Private Sub StopHook() '...and VERSUS VERSA
Dim I As Long
For I = 1 To RWCount
With RelWnd(I)
If .hWnd <> 0 Then
Call SetWindowLongA(.hWnd, -4, .OldWProc) 'I don't like this too.
End If
End With
Next I
End Sub
Private Function WndProc(ByVal Handle As Long, ByVal Msg As Long, _
ByVal FParam As Long, ByVal lParam As Long) As Long
'eats 10% of processor time on Celeron 2GHz. VB !
'WARNING: never use STOP,END,Breakpoints here, be careful with errors here.
' This causes application hangs and fatal errors!
'Get RelWnd item number with this handle
For Iter = 1 To RWCount
If RelWnd(Iter).hWnd = Handle Then CurrRW = Iter: Exit For
Next Iter
If Msg = &HA1 Then 'start dragging
If FParam = 2 Then
SystemParametersInfoA 48, 0, WScreen, 0 'gets an actual screen size to glue to taskbar, but not to bottom of the screen
GetCursorPos CPoint 'get the position of cursor in start of form dragging
GetWindowRect Handle, RelWnd(CurrRW) 'what does user drag?
SPoint.X = CPoint.X - RelWnd(CurrRW).Left 'fill variables for moving
SPoint.Y = CPoint.Y - RelWnd(CurrRW).Top
End If
ElseIf Msg = &H216 Then 'this is unknown sysevent. Danila, what's this?
GetCursorPos CPoint 'coordinates of cursor to get the DX and DY of moving
GetWindowRect Handle, RelWnd(CurrRW)
With RelWnd(CurrRW)
TMP0 = CPoint.X - .Left - SPoint.X 'This helps not to count this twice.
TRect.Left = .Left + TMP0 'Just a good optimization
TRect.Right = .Right + TMP0
TMP0 = CPoint.Y - .Top - SPoint.Y
TRect.Top = .Top + TMP0
TRect.Bottom = .Bottom + TMP0
TRect.Width = .Right - .Left
TRect.Height = .Bottom - .Top
End With
BCount = 0
ReDim m_Borders(1)
EnumWindows AddressOf EnumWinProc, 0
With TRect
If Near(.Right, WScreen.Right, m_Size) Then
.Left = WScreen.Right - .Width
.Right = WScreen.Right
ElseIf Near(.Left, WScreen.Left, m_Size) Then
.Left = WScreen.Left
.Right = WScreen.Left + .Width
End If
If Near(.Bottom, WScreen.Bottom, m_Size) Then
.Top = WScreen.Bottom - .Height
.Bottom = WScreen.Bottom
ElseIf Near(.Top, WScreen.Top, m_Size) Then
.Top = WScreen.Top
.Bottom = WScreen.Top + .Height
End If
End With
For Iter = 1 To BCount
With m_Borders(BCount)
Debug.Print "0"
If Cross(TRect.Top, TRect.Bottom, .Top, .Bottom) Then
Debug.Print "1"
If Near(TRect.Left, .Right, m_Size) Then
Debug.Print "11"
TRect.Left = .Right
TRect.Right = .Right + TRect.Width
ElseIf Near(TRect.Right, .Left, m_Size) Then
Debug.Print "12"
TRect.Left = .Left - TRect.Width
TRect.Right = .Left
End If
End If
If Cross(TRect.Left, TRect.Right, .Left, .Right) Then 'this properties are already changed
Debug.Print "2"
If Near(TRect.Top, .Bottom, m_Size) Then
Debug.Print "21"
TRect.Top = .Bottom
TRect.Bottom = .Bottom + TRect.Height
ElseIf Near(TRect.Bottom, .Top, m_Size) Then
Debug.Print "22"
TRect.Top = .Bottom - TRect.Width
TRect.Bottom = .Top
End If
End If
End With
Next Iter
With TRect
'in VB you can't say: RelWnd(CurrRW) = TRect like in VB .NET
RelWnd(CurrRW).Left = TRect.Left
RelWnd(CurrRW).Top = TRect.Top
RelWnd(CurrRW).Bottom = TRect.Bottom
RelWnd(CurrRW).Right = TRect.Right
End With
RtlMoveMemory ByVal lParam, RelWnd(CurrRW), 16 'Len(rect)
End If
WndProc = CallWindowProcA(RelWnd(CurrRW).OldWProc, Handle, Msg, FParam, lParam)
End Function
Private Function EnumWinProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim I As Long, txt As String
'WARNING: never use STOP,END,Breakpoints here, be careful with errors here.
' This causes application hangs and fatal errors!
If IsWindowVisible(hWnd) And _
GetParent(hWnd) = 0 And _
hWnd <> GetDesktopWindow Then 'this is very strong laws. Some windows could be lost
For I = 1 To RWCount
If RelWnd(I).hWnd = hWnd Then I = -1: Exit For
Next I
txt = Space$(256) '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GetWindowText hWnd, txt, 256
txt = Left(txt, GetWindowTextLength(hWnd))
If txt = "Program Manager" Then I = -1
If I <> -1 Then
BCount = BCount + 1
ReDim Preserve m_Borders(BCount)
GetWindowRect hWnd, m_Borders(BCount)
'With m_Borders(BCount)
' .Width = .Right - .Left
' .Height = .Bottom - .Top
'End With
End If
End If
EnumWinProc = 1
End Function
'Private Function InLimit(TheSmall As Long, Num As Long, TheBig As Long) As Boolean
' InLimit = (TheSmall <= Num) And (Num <= TheBig)
'End Function
Private Function Near(Num As Long, NearTo As Long, Accur As Long) As Boolean
Near = (NearTo - Accur <= Num) And (Num <= NearTo + Accur)
End Function
Private Function Cross(s1 As Long, e1 As Long, s2 As Long, e2 As Long) As Boolean
'cross intervals
Cross = (e1 >= s2) Or (e2 >= s1)
End Function
'End Code
'Begin Properties
Public Property Get Size() As Long
Size = m_Size
End Property
Public Property Let Size(ByVal New_Size As Long)
m_Size = New_Size
End Property
Public Property Get Enabled() As Boolean
Enabled = m_Enabled
End Property
Public Property Let Enabled(ByVal New_Enab As Boolean)
If m_Enabled <> New_Enab Then
If New_Enab Then StartHook Else StopHook
End If
m_Enabled = New_Enab
End Property
'End Properties
Номер ответа: 11
Автор ответа:
Fever
Вопросов: 60
Ответов: 808
Профиль | | #11
Добавлено: 28.01.07 17:12
Тута много лишнего, эт сорс Mover'а by SG
Номер ответа: 12
Автор ответа:
EROS
Вопросов: 58
Ответов: 4255
Профиль | | #12
Добавлено: 28.01.07 21:21
хыыы ))) вот геморрой-то!!!
Потому и пожелали Вам успехов! )))
Номер ответа: 13
Автор ответа:
-АлександР-
Вопросов: 55
Ответов: 1008
Web-сайт:
Профиль | | #13
Добавлено: 28.01.07 22:29
Номер ответа: 14
Автор ответа:
EROS
Вопросов: 58
Ответов: 4255
Профиль | | #14
Добавлено: 28.01.07 23:39
На NET мне только единожды пришлось вмешаться в работу WndProc (аналог сабклассинга) и переопределить ее чтобы сделать возможным таскать форму за любое место.. и то, реализовал это без каких либо API, исключительно средствами НЕТ.. причем без всяких геморроев похожих на пример выше... Почему Вы так упорно держитесь за эту 6-ку? Глядя на код-пример несколькими постами ранее неужели вы не видите, что 6-ка это ... это только издевательство над самим собой!
Номер ответа: 15
Автор ответа:
-АлександР-
Вопросов: 55
Ответов: 1008
Web-сайт:
Профиль | | #15
Добавлено: 29.01.07 00:05
Ну это ж .Нет)) Я согласен, он гораздо удобнее и во всем буквально превосходит 6-ку... В современном мире - он это все!
Но 6-ка - это история, раритет. А историю - нужно знать))