paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 23:39:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added track progress

Browse Source 
git-svn-id: trunk@7939 -
This commit is contained in:
marc 2005-10-08 17:36:38 +00:00
parent 0ca23e391d
commit ddb2cdee81
2 changed files with 57 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lcl/interfaces/carbon/carbonprivatehiview.inc
View File

@ -53,6 +53,13 @@ begin
DeliverMessage(AInfo^.LCLObject, Msg);
end;
function CarbonPrivateHIView_MouseMove(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AInfo: PWidgetInfo): OSStatus; mwpascal;
begin
WriteLN('MouseMove');
Result := CallNextEventHandler(ANextHandler, AEvent);
end;
// ==================================================================
@ -88,6 +95,12 @@ begin
InstallControlEventHandler(AInfo^.Widget, RegisterEventHandler(@CarbonPrivateHIView_Hit),
1, @TmpSpec, Pointer(AInfo), nil);
MouseSpec[0] := MakeEventSpec(kEventClassMouse, kEventMouseMoved);
MouseSpec[1] := MakeEventSpec(kEventClassMouse, kEventMouseDragged);
InstallControlEventHandler(AInfo^.Widget, RegisterEventHandler(@CarbonPrivateHIView_MouseMove),
2, @MouseSpec[0], Pointer(AInfo), nil);
// InstallControlHandler(AInfo, kEventClassControl, kEventControlDispose, RegisterEventHandler(@CarbonWSWinControl_Dispose));
// InstallControlHandler(AInfo, kEventClassControl, kEventControlHit, @CarbonWSWinControl_Hit, MCarbonWSWinControl_Hit_UPP);
DebugLN(TWinControl(Ainfo^.LCLObject).Name,':', TWinControl(Ainfo^.LCLObject).ClassName ,' Events set')

56
lcl/interfaces/carbon/carbonprivatewindow.inc
View File

@ -60,19 +60,46 @@ end;
//Generic function that handles all types of mouse events
procedure TrackProgress(AControl: ControlRef; APartCode: ControlPartCode); mwpascal;
var
Modifiers, ButtonState: UInt32;
MousePoint: HIPoint;
pt: FPCMacOSAll.Point;
begin
GetGlobalMouse(Pt);
MousePoint.X := pt.h;
MousePoint.Y := pt.v;
// todo, convert to correct co-ordinates
HIViewConvertPoint(MousePoint, nil, AControl);
Modifiers := GetCurrentKeyModifiers;
ButtonState := GetCurrentButtonState;
DebugLn('-- track, x:%d, y:%d, m:0x%x, b:0x%x', [Round(MousePoint.X), Round(MousePoint.Y), Modifiers, ButtonState]);
end;
function CarbonPrivateWindow_ControlTrack(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AInfo: PWidgetInfo): OSStatus; mwpascal;
var
Modifiers: UInt32;
MousePoint: HIPoint;//QDPoint;
Modifiers, ButtonState: UInt32;
MousePoint: HIPoint;//QDPoint;
ActionUPP, OldActionUPP: ControlActionUPP;
begin
DebugLn('-- Control track A');
GetEventParameter(AEvent, kEventParamKeyModifiers, typeUInt32, nil, SizeOf(Modifiers), nil, @Modifiers);
GetEventParameter(AEvent, kEventParamMouseLocation, typeHIPoint, nil, SizeOf(MousePoint), nil, @MousePoint);
GetEventParameter(AEvent, kEventParamWindowMouseLocation, typeHIPoint, nil, SizeOf(MousePoint), nil, @MousePoint);
GetEventParameter(AEvent, kEventParamControlAction, typeControlActionUPP, nil, sizeof(ActionUPP), nil, @OldActionUPP);
ButtonState := GetCurrentEventButtonState;
ActionUPP := NewControlActionUPP(@TrackProgress);
SetEventParameter(AEvent, kEventParamControlAction, typeControlActionUPP, sizeof(ActionUPP), @ActionUPP);
Result := CallNextEventHandler(ANextHandler, AEvent);
DebugLn('Control track, x:%d, y:%d, m:0x%x', [Round(MousePoint.X), Round(MousePoint.Y), Modifiers]);
Result := CallNextEventHandler(ANextHandler, AEvent);
SetEventParameter(AEvent, kEventParamControlAction, typeControlActionUPP, sizeof(OldActionUPP), @OldActionUPP);
DisposeControlActionUPP(ActionUPP);
DebugLn('-- Control track B, x:%d, y:%d, m:0x%x, b:0x%x', [Round(MousePoint.X), Round(MousePoint.Y), Modifiers, ButtonState]);
end;
function CarbonPrivateWindow_MouseProc(ANextHandler: EventHandlerCallRef;
@ -131,6 +158,7 @@ var
pt: FPCMacOSAll.Point;
mtr: MouseTrackingResult;
begin
DebugLN('-- mouse down --');
Msg := @AMsg;
ClickCount := GetClickCount;
@ -151,14 +179,14 @@ var
//LMMouse.Keys;
{$Warning CarbonPrivateWindow_MouseProc LMMouse.Keys TODO}
// Spec := MakeEventSpec(kEventClassControl, kEventControlTrack);
// InstallControlEventHandler(Control, RegisterEventHandler(@CarbonPrivateWindow_ControlTrack),
// 1, @Spec, nil, nil);
Spec := MakeEventSpec(kEventClassControl, kEventControlTrack);
InstallControlEventHandler(Control, RegisterEventHandler(@CarbonPrivateWindow_ControlTrack),
1, @Spec, nil, nil);
repeat
TrackMouseLocation(nil, Pt, mtr);
DebugLn('Mouse track, x:%d, y:%d, m:0x%x', [Round(pt.h), Round(pt.v), mtr]);
until mtr = kMouseTrackingMouseUp;
// repeat
// TrackMouseLocation(nil, Pt, mtr);
// DebugLn('Mouse track, x:%d, y:%d, m:0x%x', [Round(pt.h), Round(pt.v), mtr]);
// until mtr = kMouseTrackingMouseUp;
end;
@ -170,6 +198,7 @@ var
MousePoint: TPoint;
Msg: ^TLMMouse;
begin
DebugLN('-- mouse up --');
// this is not called if NextHandler is called on MouseDown
// perhaps mousetracking can fix this
Msg := @AMsg;
@ -192,6 +221,7 @@ var
MousePoint: TPoint;
MSg: ^TLMMouseMove;
begin
DebugLN('-- mouse move --');
Msg := @AMsg;
MousePoint := GetMousePoint;
@ -203,11 +233,13 @@ var
procedure HandleMouseDraggedEvent(var AMsg);
begin
DebugLN('-- mouse dragged --');
//TODO
end;
procedure HandleMouseWheelEvent(var AMsg);
begin
DebugLN('-- mouse wheel --');
//TODO should be simple
end;