mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-23 20:46:20 +02:00
- added: [win32] mousewheel default handler sends scrollbar messages
- fixed: lmsetcursor; partial todo git-svn-id: trunk@5392 -
This commit is contained in:
parent
88a195111d
commit
bade7949c7
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user