- Timestamp:
- Jul 22, 2008, 1:12:35 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab
r561 r564 7 7 Namespace UI 8 8 9 'Namespace Detail10 'TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL11 'End Namespace9 Namespace Detail 10 TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL 11 End Namespace 12 12 13 13 Class Control … … 176 176 AddMessageEvent(WM_XBUTTONUP, mu) 177 177 Dim mb = New MessageHandler(AddressOf(OnMouseDblClkBase)) 178 AddMessageEvent(WM_LBUTTONDBLCLK, m u)179 AddMessageEvent(WM_RBUTTONDBLCLK, m u)180 AddMessageEvent(WM_MBUTTONDBLCLK, m u)181 AddMessageEvent(WM_XBUTTONDBLCLK, m u)178 AddMessageEvent(WM_LBUTTONDBLCLK, mb) 179 AddMessageEvent(WM_RBUTTONDBLCLK, mb) 180 AddMessageEvent(WM_MBUTTONDBLCLK, mb) 181 AddMessageEvent(WM_XBUTTONDBLCLK, mb) 182 182 183 183 AddMessageEvent(WM_MOUSEMOVE, AddressOf(OnMouseMoveBase)) 184 184 AddMessageEvent(WM_MOUSELEAVE, AddressOf(OnMouseLeaveBase)) 185 AddMessageEvent(WM_MOUSEHOVER, AddressOf(OnMouseHoverBase)) 185 186 AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase)) 186 187 AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase)) … … 191 192 192 193 Sub OnEraseBackground(sender As Object, e As MessageArgs) 193 Dim rc = ClientRect 194 FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH) 194 If IsNothing(paintBackground) Then 195 Dim rc = ClientRect 196 FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH) 197 Else 198 OnPaintBackground(New PaintBackgroundArgs(e.WParam, e.LParam)) 199 End If 195 200 e.LResult = TRUE 196 201 End Sub … … 225 230 mouseEntered = True 226 231 OnMouseEnter(me) 232 trackMouseEvent(TME_LEAVE Or TME_HOVER) 227 233 End If 228 234 End Sub 229 235 230 236 Sub OnMouseLeaveBase(sender As Object, e As MessageArgs) 237 OnMouseLeave(Args.Empty) 238 mouseEntered = False 239 End Sub 240 241 Sub OnMouseHoverBase(sender As Object, e As MessageArgs) 231 242 Dim me = makeMouseEventFromMsg(e) 232 OnMouseLeave(me) 233 mouseEntered = False 243 OnMouseHover(me) 234 244 End Sub 235 245 … … 415 425 ' その他の補助関数 416 426 Private 417 ' Sub tracMouseEvent() 418 /*If pTrackMouseEvent <> 0 Then427 Function trackMouseEvent(flags As DWord) As BOOL 428 If pTrackMouseEvent <> 0 Then 419 429 Dim tme As TRACKMOUSEEVENT 420 430 With tme 421 431 .cbSize = Len(tme) 422 .dwFlags = TME_HOVER Or TME_LEAVE423 .hwndTrack = wnd432 .dwFlags = flags 433 .hwndTrack = hwnd 424 434 .dwHoverTime = HOVER_DEFAULT 425 435 End With 426 pTrackMouseEvent(tme)427 End If 428 */ 'End Sub 436 trackMouseEvent = pTrackMouseEvent(tme) 437 End If 438 End Function 429 439 430 440 '-------------------------------- … … 437 447 Static atom As ATOM 438 448 Static hmodComctl As HMODULE 439 ' Static pTrackMouseEvent AsPTrackMouseEvent449 Static pTrackMouseEvent As Detail.PTrackMouseEvent 440 450 441 451 Static Const WindowClassName = "ActiveBasic.Windows.UI.Control" … … 445 455 tlsIndex = TlsAlloc() 446 456 hInstance = hinst 447 'hmodComctl = LoadLibrary("comctl32.dll")448 ' pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) 457 hmodComctl = LoadLibrary("comctl32.dll") 458 pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) As Detail.PTrackMouseEvent 449 459 450 460 Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId()) … … 483 493 TlsFree(tlsIndex) 484 494 End If 485 'If hmodComctl <> 0 Then486 'FreeLibrary(hmodComctl)487 'End If495 If hmodComctl <> 0 Then 496 FreeLibrary(hmodComctl) 497 End If 488 498 If PropertyInstance <> 0 Then 489 499 GlobalDeleteAtom(PropertyInstance)
Note:
See TracChangeset
for help on using the changeset viewer.