- added: [win32] mousewheel default handler sends scrollbar messages

- fixed: lmsetcursor; partial todo

git-svn-id: trunk@5392 -
This commit is contained in:
micha 2004-04-10 17:54:52 +00:00
parent 88a195111d
commit bade7949c7
5 changed files with 88 additions and 14 deletions

View File

@ -2871,6 +2871,8 @@ begin
Shift := [ssMiddle];
DoMouseWheel(Shift, Message.WheelDelta, MousePos);
inherited;
end;
{------------------------------------------------------------------------------
@ -3446,6 +3448,10 @@ end;
{ =============================================================================
$Log$
Revision 1.217 2004/04/10 17:54:52 micha
- added: [win32] mousewheel default handler sends scrollbar messages
- fixed: lmsetcursor; partial todo
Revision 1.216 2004/04/09 23:52:01 mattias
fixed hiding uninitialized controls

View File

@ -123,6 +123,7 @@ Var
LMessage: TLMessage;
PLMsg: PLMessage;
R: TRect;
P: TPoint;
NewLeft, NewTop, NewWidth, NewHeight: integer;
LeftOffset, TopOffset: Integer;
OwnerObject: TObject;
@ -627,12 +628,29 @@ Begin
PLMsg:=@LMMouseEvent;
With LMMouseEvent Do
Begin
Msg := LM_MOUSEWHEEL;
WheelDelta := SmallInt(Hi(WParam));
X := SmallInt(Lo(LParam));
Y := SmallInt(Hi(LParam));
State := GetShiftState;
UserData := Pointer(GetWindowLong(Window, GWL_USERDATA));
// check if mouse cursor within this window, otherwise send message to window the mouse is hovering over
if GetWindowRect(Window, R) <> 0 then
begin
if (X < R.Left) or (R.Right < X)
or (Y < R.Top) or (R.Bottom < Y) then
begin
P.X := X;
P.Y := Y;
Window := TWin32WidgetSet(InterfaceObject).WindowFromPoint(P);
if Window = HWND(nil) then
exit;
PostMessage(Window, WM_MOUSEWHEEL, WParam, LParam);
exit;
end;
end;
Msg := LM_MOUSEWHEEL;
WheelDelta := SmallInt(Hi(WParam));
State := GetShiftState;
UserData := Pointer(GetWindowLong(Window, GWL_USERDATA));
End;
End;
//TODO:LM_MOVEPAGE,LM_MOVETOROW,LM_MOVETOCOLUMN
@ -936,8 +954,6 @@ End;
------------------------------------------------------------------------------}
function OverlayWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
var
PS: PAINTSTRUCT;
begin
case Msg of
WM_ERASEBKGND:
@ -1110,6 +1126,10 @@ end;
{
$Log$
Revision 1.99 2004/04/10 17:54:52 micha
- added: [win32] mousewheel default handler sends scrollbar messages
- fixed: lmsetcursor; partial todo
Revision 1.98 2004/03/05 18:37:46 micha
prevent selection invalid page

View File

@ -78,7 +78,7 @@ Type
Procedure ResizeChild(Sender: TWinControl; Left, Top, Width, Height: Integer);
Procedure AssignSelf(Window: HWnd; Data: Pointer);
Procedure ReDraw(Child: TObject);
Procedure LmSetCursor(Sender: TObject);
Procedure LmSetCursor(Sender: TObject; Data: Pointer);
Procedure SetLimitText(Window: HWND; Limit: Word);
Procedure ShowHide(Sender: TObject);
@ -224,6 +224,10 @@ End.
{ =============================================================================
$Log$
Revision 1.76 2004/04/10 17:54:52 micha
- added: [win32] mousewheel default handler sends scrollbar messages
- fixed: lmsetcursor; partial todo
Revision 1.75 2004/03/26 21:20:54 vincents
Fixed line endings

View File

@ -423,7 +423,7 @@ Begin
ShowHide(Sender);
End;
LM_SETCURSOR:
LmSetCursor(Sender);
LmSetCursor(Sender, Data);
LM_SETLABEL:
SetLabel(Sender, Data);
LM_GETVALUE:
@ -1781,18 +1781,18 @@ const
WARNING: Sender will be casted to TControl, CLEANUP!
------------------------------------------------------------------------------}
Procedure TWin32WidgetSet.LmSetCursor(Sender: TObject);
Procedure TWin32WidgetSet.LmSetCursor(Sender: TObject; Data: Pointer);
Var
Cursor: PChar;
Res: HCURSOR;
Begin
Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Start');
Assert(False, Format('Trace:TWin32WidgetSet.LmSetCursor - Sender --> %S', [Sender.ClassName]));
Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Getting the cursor');
Cursor := LclCursorToWin32CursorMap[TControl(Sender).Cursor];
if Data = nil then
Data := Pointer(Integer(crDefault));
Cursor := LclCursorToWin32CursorMap[Integer(Data)];
Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Loading the cursor');
Res := LoadCursor(0, Cursor);
Assert(False, Format('Trace:Cursor handle --> 0x%X', [Res]));
Windows.SetCursor(Windows.LoadCursor(0, Cursor));
Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Exit');
End;
@ -2092,6 +2092,9 @@ Begin
pClassName := @ClsName;
WindowTitle := StrCaption;
SubClassWndProc := nil;
if Sender is TTreeView then
if TTreeView(Sender).BorderStyle = bsSingle then
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
End;
csForm:
Begin
@ -3024,6 +3027,10 @@ End;
{
$Log$
Revision 1.184 2004/04/10 17:54:52 micha
- added: [win32] mousewheel default handler sends scrollbar messages
- fixed: lmsetcursor; partial todo
Revision 1.183 2004/03/18 22:26:24 mattias
fixed grids TComboBox from Jesus

View File

@ -1,4 +1,4 @@
// included by win32int.pp
{******************************************************************************
All Windows API implementations.
@ -171,6 +171,32 @@ var
end;
end;
procedure CallMouseWheelHandler;
var
ScrollInfo: Windows.tagScrollInfo;
WParam: Windows.WParam;
begin
if not TWinControl(Sender).HandleAllocated then
exit;
FillChar(ScrollInfo, sizeof(ScrollInfo), #0);
ScrollInfo.cbSize := sizeof(ScrollInfo);
ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE;
if Windows.GetScrollInfo(TWinControl(Sender).Handle, SB_VERT, ScrollInfo) then
begin
with TLMMouseEvent(Message) do
begin
WParam := Windows.WParam(ScrollInfo.nPos - (WheelDelta * Integer(ScrollInfo.nPage) * 4) div (120 * 10));
if WParam > ScrollInfo.nMax then
WParam := ScrollInfo.nMax;
if WParam < ScrollInfo.nMin then
WParam := ScrollInfo.nMin;
WParam := SB_THUMBPOSITION or (WParam shl 16);
end;
Windows.PostMessage(TWinControl(Sender).Handle, WM_VSCROLL, WParam, HWND(nil));
end;
end;
procedure DrawOwnerButton(Data: PDrawItemStruct);
var Flags:integer; // How the button looks like (pressed or not pressed)
BitmapHandle: HBITMAP; // Handle of the button glyph
@ -321,6 +347,13 @@ begin
end;
end;
end;
LM_MOUSEWHEEL:
begin
// provide default wheel scrolling functionality
CallMouseWheelHandler;
end;
end;
end;
@ -2941,6 +2974,10 @@ end;
{ =============================================================================
$Log$
Revision 1.106 2004/04/10 17:54:52 micha
- added: [win32] mousewheel default handler sends scrollbar messages
- fixed: lmsetcursor; partial todo
Revision 1.105 2004/03/25 23:08:22 vincents
added Trace: to assert message