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

LazMapviewer: Enable/disable zooming and panning of the map. Issue #39069, patch by Yuliyan Ivanov. Update colored_tracks demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9182 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-01-29 13:04:09 +00:00
parent d7b7d410a5
commit 1b0cc03ff5
8 changed files with 140 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
components/lazmapviewer/examples/colored_tracks/main.lfm
View File

@ -22,7 +22,7 @@ object MainForm: TMainForm
UseThreads = True
OnZoomChange = MapViewZoomChange
end
object Panel1: TPanel
object ParamsPanel: TPanel
Left = 8
Height = 67
Top = 544
@ -34,9 +34,9 @@ object MainForm: TMainForm
ClientHeight = 67
ClientWidth = 917
TabOrder = 1
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label2
object cbRedTour: TCheckBox
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = MainLabel
AnchorSideTop.Side = asrBottom
Left = 0
Height = 19
@ -46,12 +46,12 @@ object MainForm: TMainForm
Checked = True
State = cbChecked
TabOrder = 0
OnChange = CheckBox1Change
OnChange = cbRedTourChange
end
object CheckBox2: TCheckBox
AnchorSideLeft.Control = CheckBox1
object cbBlueTour: TCheckBox
AnchorSideLeft.Control = cbRedTour
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CheckBox1
AnchorSideTop.Control = cbRedTour
Left = 179
Height = 19
Top = 19
@ -61,12 +61,12 @@ object MainForm: TMainForm
Checked = True
State = cbChecked
TabOrder = 1
OnChange = CheckBox2Change
OnChange = cbBlueTourChange
end
object CheckBox3: TCheckBox
AnchorSideLeft.Control = CheckBox2
object cbBlackTour: TCheckBox
AnchorSideLeft.Control = cbBlueTour
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CheckBox1
AnchorSideTop.Control = cbRedTour
Left = 339
Height = 19
Top = 19
@ -76,12 +76,12 @@ object MainForm: TMainForm
Checked = True
State = cbChecked
TabOrder = 2
OnChange = CheckBox3Change
OnChange = cbBlackTourChange
end
object ZoomLabel: TLabel
AnchorSideTop.Control = CheckBox1
AnchorSideTop.Control = cbRedTour
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Panel1
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
Left = 857
Height = 15
@ -90,9 +90,9 @@ object MainForm: TMainForm
Anchors = [akTop, akRight]
Caption = 'ZoomLabel'
end
object Label2: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
object MainLabel: TLabel
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel
Left = 0
Height = 15
Top = 0
@ -102,10 +102,10 @@ object MainForm: TMainForm
Font.Style = [fsBold]
ParentFont = False
end
object ComboBox1: TComboBox
AnchorSideLeft.Control = Label1
object cbProviders: TComboBox
AnchorSideLeft.Control = lblProviders
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CheckBox1
AnchorSideTop.Control = cbRedTour
AnchorSideTop.Side = asrBottom
Left = 79
Height = 23
@ -122,11 +122,11 @@ object MainForm: TMainForm
Style = csDropDownList
TabOrder = 3
Text = 'Google Maps'
OnChange = ComboBox1Change
OnChange = cbProvidersChange
end
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = ComboBox1
object lblProviders: TLabel
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = cbProviders
AnchorSideTop.Side = asrCenter
Left = 0
Height = 15
@ -135,5 +135,37 @@ object MainForm: TMainForm
BorderSpacing.Right = 8
Caption = 'Map provider'
end
object cbAllowDragging: TCheckBox
AnchorSideLeft.Control = cbProviders
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbProviders
AnchorSideTop.Side = asrCenter
Left = 376
Height = 19
Top = 46
Width = 99
BorderSpacing.Left = 24
Caption = 'Allow dragging'
Checked = True
State = cbChecked
TabOrder = 4
OnChange = cbAllowDraggingChange
end
object cbAllowZooming: TCheckBox
AnchorSideLeft.Control = cbAllowDragging
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbProviders
AnchorSideTop.Side = asrCenter
Left = 499
Height = 19
Top = 46
Width = 98
BorderSpacing.Left = 24
Caption = 'Allow zooming'
Checked = True
State = cbChecked
TabOrder = 5
OnChange = cbAllowZoomingChange
end
end
end

60
components/lazmapviewer/examples/colored_tracks/main.pas
View File

@ -13,19 +13,23 @@ type
{ TMainForm }
TMainForm = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
ComboBox1: TComboBox;
Label1: TLabel;
cbRedTour: TCheckBox;
cbBlueTour: TCheckBox;
cbBlackTour: TCheckBox;
cbAllowDragging: TCheckBox;
cbAllowZooming: TCheckBox;
cbProviders: TComboBox;
lblProviders: TLabel;
ZoomLabel: TLabel;
Label2: TLabel;
MainLabel: TLabel;
MapView: TMapView;
Panel1: TPanel;
procedure CheckBox1Change(Sender: TObject);
procedure CheckBox2Change(Sender: TObject);
procedure CheckBox3Change(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
ParamsPanel: TPanel;
procedure cbRedTourChange(Sender: TObject);
procedure cbBlueTourChange(Sender: TObject);
procedure cbBlackTourChange(Sender: TObject);
procedure cbAllowDraggingChange(Sender: TObject);
procedure cbAllowZoomingChange(Sender: TObject);
procedure cbProvidersChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure MapViewZoomChange(Sender: TObject);
private
@ -67,7 +71,7 @@ begin
try
// Threaded painting interferes with track painting over several tiles
MapView.UseThreads := true; //false;
MapView.MapProvider := Combobox1.Text;
MapView.MapProvider := cbProviders.Text;
MapView.Active := true;
// Load GPX files
@ -99,27 +103,43 @@ begin
ZoomLabel.Caption := 'Zoom ' + MapView.Zoom.ToString;
end;
procedure TMainForm.CheckBox1Change(Sender: TObject);
procedure TMainForm.cbRedTourChange(Sender: TObject);
begin
FTrack1.Visible := Checkbox1.Checked;
FTrack1.Visible := cbRedTour.Checked;
Mapview.Invalidate;
end;
procedure TMainForm.CheckBox2Change(Sender: TObject);
procedure TMainForm.cbBlueTourChange(Sender: TObject);
begin
FTrack2.Visible := Checkbox2.Checked;
FTrack2.Visible := cbBlueTour.Checked;
MapView.Invalidate;
end;
procedure TMainForm.CheckBox3Change(Sender: TObject);
procedure TMainForm.cbBlackTourChange(Sender: TObject);
begin
FTrack3.Visible := Checkbox3.Checked;
FTrack3.Visible := cbBlackTour.Checked;
MapView.Invalidate;
end;
procedure TMainForm.ComboBox1Change(Sender: TObject);
procedure TMainForm.cbAllowDraggingChange(Sender: TObject);
begin
MapView.MapProvider := Combobox1.Text;
if cbAllowDragging.Checked then
MapView.Options := MapView.Options + [mvoMouseDragging]
else
MapView.Options := MapView.Options - [mvoMouseDragging];
end;
procedure TMainForm.cbAllowZoomingChange(Sender: TObject);
begin
if cbAllowZooming.Checked then
MapView.Options := MapView.Options + [mvoMouseZooming]
else
MapView.Options := MapView.Options - [mvoMouseZooming];
end;
procedure TMainForm.cbProvidersChange(Sender: TObject);
begin
MapView.MapProvider := cbProviders.Text;
end;
function TMainForm.LoadGPXFile(AFileName: String;

8
components/lazmapviewer/examples/fulldemo/main.lfm
View File

@ -554,7 +554,7 @@ object MainForm: TMainForm
OnClick = BtnPrintMapClick
end
end
object pgLayers: TTabSheet
object PgLayers: TTabSheet
Caption = 'Layers'
ClientHeight = 561
ClientWidth = 267
@ -605,9 +605,9 @@ object MainForm: TMainForm
Shape = bsTopLine
end
object sgLayers: TStringGrid
AnchorSideLeft.Control = pgLayers
AnchorSideTop.Control = pgLayers
AnchorSideRight.Control = pgLayers
AnchorSideLeft.Control = PgLayers
AnchorSideTop.Control = PgLayers
AnchorSideRight.Control = PgLayers
AnchorSideRight.Side = asrBottom
Left = 4
Height = 256

1
components/lazmapviewer/examples/fulldemo/main.pas
View File

@ -26,6 +26,7 @@ type
CbFoundLocations: TComboBox;
CbLocations: TComboBox;
CbProviders: TComboBox;
PgLayers: TTabSheet;
rbSystemProxy: TRadioButton;
rbNoProxy: TRadioButton;
rbProxyData: TRadioButton;

3
components/lazmapviewer/examples/trackdemo/main.lfm
View File

@ -212,6 +212,7 @@ object MainForm: TMainForm
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
POITextBgColor = clCream
UseThreads = True
OnCenterMove = MapViewCenterMove
OnZoomChange = MapViewZoomChange
end
@ -362,6 +363,8 @@ object MainForm: TMainForm
Width = 79
BorderSpacing.Left = 16
Caption = 'Use threads'
Checked = True
State = cbChecked
TabOrder = 3
OnChange = cbUseThreadsChange
end

2
components/lazmapviewer/source/mvdragobj.pas
View File

@ -48,12 +48,12 @@ Type
Procedure DoDrag(X,Y: integer);
Procedure DoEndDrag(X,Y: integer);
Function HasMoved(X,Y: integer) : Boolean;
Procedure AbortDrag;
public
Procedure MouseDown(aDragSrc: TObject; X,Y: integer);
Procedure MouseUp(X,Y: integer);
Procedure MouseMove(X,Y: integer);
Procedure AbortDrag;
property OnDrag: TDragEvent read FOnDrag write SetOnDrag;
property OnEndDrag: TDragEvent read FOnEndDrag write SetOnEndDrag;

3
components/lazmapviewer/source/mvengine.pas
View File

@ -1176,13 +1176,12 @@ begin
Cache.BasePath := aValue;
end;
procedure TMapViewerEngine.SetCenter(aCenter: TRealPoint);
procedure TMapViewerEngine.SetCenter(ACenter: TRealPoint);
begin
if (MapWin.Center.Lon <> aCenter.Lon) or (MapWin.Center.Lat <> aCenter.Lat) then
begin
Mapwin.Center := aCenter;
CalculateWin(MapWin);
Redraw(MapWin);
if Assigned(OnCenterMove) then
OnCenterMove(Self);
if Assigned(OnChange) then

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

@ -31,6 +31,19 @@ Type
TDrawGpsPointEvent = procedure (Sender: TObject;
ADrawer: TMvCustomDrawingEngine; APoint: TGpsPoint) of object;
TMapViewOption =
(
mvoMouseDragging, // Allow dragging of the map with the mouse
mvoMouseZooming // Allow zooming into the map with the mouse
);
TMapViewOptions = set of TMapViewOption;
const
DefaultMapViewOptions = [mvoMouseDragging, mvoMouseZooming];
type
{ TMapView }
TMapView = class(TCustomControl)
@ -43,6 +56,7 @@ Type
FDrawPreviewTiles: boolean;
FActive: boolean;
FGPSItems: array [0..9] of TGPSObjectList;
FOptions: TMapViewOptions;
FPOIImage: TBitmap;
FPOITextBgColor: TColor;
FOnDrawGpsPoint: TDrawGpsPointEvent;
@ -95,6 +109,7 @@ Type
procedure SetOnCenterMove(AValue: TNotifyEvent);
procedure SetOnChange(AValue: TNotifyEvent);
procedure SetOnZoomChange(AValue: TNotifyEvent);
procedure SetOptions(AValue: TMapViewOptions);
procedure SetPOIImage(const AValue: TBitmap);
procedure SetPOIImages(const AValue: TCustomImageList);
procedure SetPOIImagesWidth(AValue: Integer);
@ -166,6 +181,7 @@ Type
property DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine;
property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine;
property DrawPreviewTiles: Boolean read GetDrawPreviewTiles write SetDrawPreviewTiles default true;
property Options: TMapViewOptions read FOptions write SetOptions default DefaultMapViewOptions;
property Font: TFont read FFont write SetFont stored IsFontStored;
property Height default 150;
property InactiveColor: TColor read GetInactiveColor write SetInactiveColor default clWhite;
@ -598,6 +614,17 @@ begin
Engine.OnZoomChange := AValue;
end;
procedure TMapView.SetOptions(AValue: TMapViewOptions);
begin
if FOptions = AValue then Exit;
FOptions := AValue;
if Engine.InDrag and not (mvoMouseDragging in FOptions) then
begin
Engine.DragObj.AbortDrag;
Invalidate;
end;
end;
procedure TMapView.SetPOIImage(const AValue: TBitmap);
begin
if FPOIImage = AValue then exit;
@ -646,7 +673,7 @@ function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if IsActive then
if IsActive and (mvoMouseZooming in FOptions) then
begin
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
Invalidate;
@ -657,7 +684,7 @@ procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if IsActive then
if IsActive and (mvoMouseDragging in FOptions) then
begin
Engine.MouseDown(self,Button,Shift,X,Y);
Invalidate;
@ -668,7 +695,7 @@ procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if IsActive then
if IsActive and (mvoMouseDragging in FOptions) then
begin
Engine.MouseUp(self,Button,Shift,X,Y);
Engine.Redraw;
@ -679,7 +706,7 @@ end;
procedure TMapView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if IsActive then
if IsActive and (mvoMouseDragging in FOptions) then
begin
Engine.MouseMove(self,Shift,X,Y);
if Engine.InDrag
@ -1135,6 +1162,8 @@ begin
Height := 150;
FActive := false;
FOptions := DefaultMapViewOptions;
FDefaultTrackColor := clRed;
FDefaultTrackWidth := 1;