diff --git a/components/lazmapviewer/examples/colored_tracks/main.lfm b/components/lazmapviewer/examples/colored_tracks/main.lfm index f95a52daa..7a21c3a1c 100644 --- a/components/lazmapviewer/examples/colored_tracks/main.lfm +++ b/components/lazmapviewer/examples/colored_tracks/main.lfm @@ -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 diff --git a/components/lazmapviewer/examples/colored_tracks/main.pas b/components/lazmapviewer/examples/colored_tracks/main.pas index 6b21c93e2..dd5d262b4 100644 --- a/components/lazmapviewer/examples/colored_tracks/main.pas +++ b/components/lazmapviewer/examples/colored_tracks/main.pas @@ -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; diff --git a/components/lazmapviewer/examples/fulldemo/main.lfm b/components/lazmapviewer/examples/fulldemo/main.lfm index bbab9667c..af66c1f6c 100644 --- a/components/lazmapviewer/examples/fulldemo/main.lfm +++ b/components/lazmapviewer/examples/fulldemo/main.lfm @@ -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 diff --git a/components/lazmapviewer/examples/fulldemo/main.pas b/components/lazmapviewer/examples/fulldemo/main.pas index 190a60391..e66535741 100644 --- a/components/lazmapviewer/examples/fulldemo/main.pas +++ b/components/lazmapviewer/examples/fulldemo/main.pas @@ -26,6 +26,7 @@ type CbFoundLocations: TComboBox; CbLocations: TComboBox; CbProviders: TComboBox; + PgLayers: TTabSheet; rbSystemProxy: TRadioButton; rbNoProxy: TRadioButton; rbProxyData: TRadioButton; diff --git a/components/lazmapviewer/examples/trackdemo/main.lfm b/components/lazmapviewer/examples/trackdemo/main.lfm index 3b0fe6b0c..73d203b4d 100644 --- a/components/lazmapviewer/examples/trackdemo/main.lfm +++ b/components/lazmapviewer/examples/trackdemo/main.lfm @@ -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 diff --git a/components/lazmapviewer/source/mvdragobj.pas b/components/lazmapviewer/source/mvdragobj.pas index f2f369b44..3539e4adc 100644 --- a/components/lazmapviewer/source/mvdragobj.pas +++ b/components/lazmapviewer/source/mvdragobj.pas @@ -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; diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 04bb8557d..9c756b52c 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -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 diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index bc0b0aa5c..aac290257 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -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;