paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: Add support for MouseWheel event.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9536 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-12-15 23:48:12 +00:00
parent 39889975d4
commit 434196e0e2
3 changed files with 80 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
components/lazmapviewer/source/addons/plugins/mvplugins.pas
View File

@ -127,16 +127,21 @@ type
end;
type
TMvPluginNotifyEvent = procedure (Sender : TObject; AMapView: TMapView; var Handled: Boolean) of Object;
TMvPluginNotifyEvent = procedure (Sender : TObject; AMapView: TMapView;
var Handled: Boolean) of Object;
TMvPluginMouseEvent = procedure (Sender : TObject; AMapView: TMapView; Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer; var Handled: Boolean) of Object;
Shift: TShiftState; X, Y: Integer; var Handled: Boolean) of Object;
TMvPluginMouseMoveEvent = procedure (Sender : TObject; AMapView: TMapView; AShift: TShiftState;
X,Y: Integer; var Handled: Boolean) of Object;
TMvPluginMouseWheelEvent = procedure (Sender: TObject; AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint; var Handled: Boolean) of object;
TMvPluginGPSItemsModifiedEvent = procedure (Sender: TObject; AMapView: TMapView;
ChangedList: TGPSObjectList;
ActualObjs: TGPSObjList; Adding: Boolean;
var Handled : Boolean) of Object;
ChangedList: TGPSObjectList; ActualObjs: TGPSObjList; Adding: Boolean;
var Handled: Boolean) of Object;
{ TUserDefinedPlugin }
@ -146,18 +151,21 @@ type
FAfterPaintEvent : TMvPluginNotifyEvent;
FBeforeDrawObjectsEvent : TMvPluginNotifyEvent;
FCenterMoveEvent : TMvPluginNotifyEvent;
FGPSItemsModifiedEvent : TMvPluginGPSItemsModifiedEvent;
FMouseDownEvent : TMvPluginMouseEvent;
FMouseEnterEvent : TMvPluginNotifyEvent;
FMouseLeaveEvent : TMvPluginNotifyEvent;
FMouseMoveEvent : TMvPluginMouseMoveEvent;
FMouseUpEvent : TMvPluginMouseEvent;
FMouseWheelEvent : TMvPluginMouseWheelEvent;
FZoomChangeEvent : TMvPluginNotifyEvent;
FGPSItemsModifiedEvent : TMvPluginGPSItemsModifiedEvent;
protected
procedure AfterDrawObjects(AMapView: TMapView; var Handled: Boolean); override;
procedure AfterPaint(AMapView: TMapView; var Handled: Boolean); override;
procedure BeforeDrawObjects(AMapView: TMapView; var Handled: Boolean); override;
procedure CenterMove(AMapView: TMapView; var Handled: Boolean); override;
procedure GPSItemsModified(AMapView: TMapView; ChangedList: TGPSObjectList;
ActualObjs: TGPSObjList; Adding: Boolean; var Handled: Boolean); override;
procedure MouseDown(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); override;
procedure MouseEnter(AMapView: TMapView; var Handled: Boolean); override;
@ -166,23 +174,23 @@ type
var Handled: Boolean); override;
procedure MouseUp(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); override;
procedure MouseWheel(AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint; var Handled: Boolean); override;
procedure ZoomChange(AMapView: TMapView; var Handled: Boolean); override;
procedure GPSItemsModified(AMapView: TMapView; ChangedList: TGPSObjectList;
ActualObjs: TGPSObjList; Adding: Boolean;
var Handled : Boolean);override;
public
published
property OnAfterDrawObjects : TMvPluginNotifyEvent read FAfterDrawObjectsEvent write FAfterDrawObjectsEvent;
property OnAfterPaint : TMvPluginNotifyEvent read FAfterPaintEvent write FAfterPaintEvent;
property OnBeforeDrawObjects : TMvPluginNotifyEvent read FBeforeDrawObjectsEvent write FBeforeDrawObjectsEvent;
property OnCenterMove : TMvPluginNotifyEvent read FCenterMoveEvent write FCenterMoveEvent;
property OnGPSItemsModified : TMvPluginGPSItemsModifiedEvent read FGPSItemsModifiedEvent write FGPSItemsModifiedEvent;
property OnMouseDown : TMvPluginMouseEvent read FMouseDownEvent write FMouseDownEvent;
property OnMouseEnter : TMvPluginNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
property OnMouseLeave : TMvPluginNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
property OnMouseMove : TMvPluginMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
property OnMouseUp : TMvPluginMouseEvent read FMouseUpEvent write FMouseUpEvent;
property OnMouseWheel : TMvPluginMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
property OnZoomChange : TMvPluginNotifyEvent read FZoomChangeEvent write FZoomChangeEvent;
property OnGPSItemsModified : TMvPluginGPSItemsModifiedEvent read FGPSItemsModifiedEvent write FGPSItemsModifiedEvent;
// inherited
property Enabled;
@ -682,6 +690,13 @@ begin
FMouseUpEvent(Self, AMapView, Button, Shift, X, Y, Handled);
end;
procedure TUserDefinedPlugin.MouseWheel(AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint; var Handled: Boolean);
begin
if Assigned(FMouseWheelEvent) then
FMouseWheelEvent(Self, AMapView, AShift, AWheelDelta, AMousePos, Handled);
end;
procedure TUserDefinedPlugin.ZoomChange(AMapView: TMapView; var Handled: Boolean);
begin
if Assigned(FZoomChangeEvent) then

25
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -456,6 +456,8 @@ type
AMapEvent: TMouseMoveEvent): Boolean; virtual;
function MouseUp(AMapView: TMapView; AButton: TMouseButton; AShift: TShiftState;
X, Y: Integer; AMapEvent: TMouseEvent): Boolean; virtual;
function MouseWheel(AMapView: TMapView; AShift: TShiftState; AWheelDelta: Integer;
AMousePos: TPoint): Boolean; virtual;
function ZoomChange(AMapView: TMapView; AMapEvent: TNotifyEvent): Boolean; virtual;
function GPSItemsModified(AMapView: TMapView; ModifiedList: TGPSObjectList;
ActualObjs: TGPSObjList; Adding: Boolean): Boolean; virtual;
@ -712,6 +714,7 @@ type
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
end;
@ -2523,11 +2526,22 @@ begin
Engine.ZoomToCursor := AValue;
end;
{ Is called when the mouse wheel is rotated.
Default behaviour is to first call the user event handler in "inherited" and
then to pass the event on the the Engine for zooming.
If plugins are used, the plugin manager dispatches the event at first to all
the plugins; if one of the plugins reports the event to be handled the
plugin manager inhibits further processing of the event by the Engine, i.e.
prevents zooming. }
function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
var
lHandled: Boolean;
begin
Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if IsActive and (mvoMouseZooming in FOptions) then
lHandled := GetPluginManager.MouseWheel(self, Shift, WheelDelta, MousePos);
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if IsActive and (mvoMouseZooming in FOptions) and not lHandled then
begin
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
Invalidate;
@ -4449,6 +4463,13 @@ begin
DefaultMouseEvent(AMapView, AButton, AShift, X, Y, AMapEvent);
end;
// No user event here; it is handled by the MapView itself.
function TMvCustomPluginManager.MouseWheel(AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint): Boolean;
begin
Result := False;
end;
procedure TMvCustomPluginManager.RemoveMapView(AMapView: TMapView);
begin
//

33
components/lazmapviewer/source/mvplugincore.pas
View File

@ -39,16 +39,18 @@ type
procedure SetPluginManager(AValue: TMvPluginManager);
protected
function GetIndex: Integer; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ReadState(Reader: TReader); override;
procedure SetIndex(AValue: Integer); override;
procedure SetParentComponent(AParent: TComponent); override;
procedure Update; virtual;
protected
procedure AfterDrawObjects(AMapView: TMapView; var Handled: Boolean); virtual;
procedure AfterPaint(AMapView: TMapView; var Handled: Boolean); virtual;
procedure BeforeDrawObjects(AMapView: TMapView; var Handled: Boolean); virtual;
procedure CenterMove(AMapView: TMapView; var Handled: Boolean); virtual;
procedure GPSItemsModified(AMapView: TMapView; ModifiedList: TGPSObjectList;
ActualObjs: TGPSObjList; Adding: Boolean; var Handled : Boolean);virtual;
ActualObjs: TGPSObjList; Adding: Boolean; var Handled: Boolean); virtual;
procedure MouseDown(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); virtual;
procedure MouseEnter(AMapView: TMapView; var Handled: Boolean); virtual;
@ -57,10 +59,10 @@ type
var Handled: Boolean); virtual;
procedure MouseUp(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
X,Y: Integer; var Handled: Boolean); virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure MouseWheel(AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint; var Handled: Boolean); virtual;
procedure ZoomChange(AMapView: TMapView; var Handled: Boolean); virtual;
// procedure ZoomChanging(AMapView: TMapView; NewZoom: Integer; var Allow, Handled: Boolean); virtual;
procedure Update; virtual;
protected
property MapView: TMapView read FMapView write SetMapView;
property Enabled: Boolean read FEnabled write SetEnabled default true;
@ -192,6 +194,8 @@ type
AMapEvent: TMouseMoveEvent): Boolean; override;
function MouseUp(AMapView: TMapView; AButton: TMouseButton; AShift: TShiftState;
X, Y: Integer; AMapEvent: TMouseEvent): Boolean; override;
function MouseWheel(AMapView: TMapView; AShift: TShiftState; AWheelDelta: Integer;
AMousePos: TPoint): Boolean; override;
function ZoomChange(AMapView: TMapView; AMapEvent: TNotifyEvent): Boolean; override;
// procedure ZoomChanging(AMapView: TMapView; NewZoom: Integer; var Allow: Boolean; AMapEvent); override;
@ -345,6 +349,13 @@ begin
Unused(Shift, X, Y);
end;
procedure TMvCustomPlugin.MouseWheel(AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint; var Handled: Boolean);
begin
Unused(AMapView, Handled);
Unused(AShift, AWheelDelta, AMousePos);
end;
procedure TMvCustomPlugin.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
@ -871,6 +882,22 @@ begin
inherited MouseUp(AMapView, AButton, AShift, X, Y, AMapEvent);
end;
function TMvPluginManager.MouseWheel(AMapView: TMapView; AShift: TShiftState;
AWheelDelta: Integer; AMousePos: TPoint): Boolean;
var
i: Integer;
plugin: TMvCustomPlugin;
begin
Result := False;
for i := 0 to FPluginList.Count-1 do
begin
plugin := Item[i];
if HandlePlugin(plugin, AMapView) then
plugin.MouseWheel(AMapView, AShift, AWheelDelta, AMousePos, Result);
end;
// No user event here; it is handled by the Mapview itself
end;
procedure TMvPluginManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;