From 3750b0a3d7e89a2d11b1a23215c10efd6c7f4fdc Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 18 Jan 2024 12:11:41 +0000 Subject: [PATCH] lazmapviewer: Improved drawing code. Extend both fulldemo projects by map layers. Patch by Yuliyan Ivanov. Issue #39063. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9150 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../lazmapviewer/examples/fulldemo/main.lfm | 872 +++++++++++------- .../lazmapviewer/examples/fulldemo/main.pas | 95 +- .../examples/fulldemo_with_addons/main.lfm | 681 +++++++++----- .../examples/fulldemo_with_addons/main.pas | 97 +- .../mvde_rgbgraphics.pas | 1 - components/lazmapviewer/source/mvengine.pas | 53 +- .../lazmapviewer/source/mvmapviewer.pas | 40 +- 7 files changed, 1207 insertions(+), 632 deletions(-) diff --git a/components/lazmapviewer/examples/fulldemo/main.lfm b/components/lazmapviewer/examples/fulldemo/main.lfm index 5f809ce5d..815fa2dad 100644 --- a/components/lazmapviewer/examples/fulldemo/main.lfm +++ b/components/lazmapviewer/examples/fulldemo/main.lfm @@ -1,22 +1,22 @@ object MainForm: TMainForm Left = 381 - Height = 640 + Height = 589 Top = 187 - Width = 883 + Width = 750 Caption = 'LazMapViewer' - ClientHeight = 640 - ClientWidth = 883 - ShowHint = True - LCLVersion = '3.99.0.0' + ClientHeight = 589 + ClientWidth = 750 + Font.Height = -12 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow + ShowHint = True object MapView: TMapView Left = 0 - Height = 640 + Height = 589 Hint = 'Displays the map' Top = 0 - Width = 608 + Width = 500 Align = alClient Cyclic = True DefaultTrackColor = clBlue @@ -54,14 +54,14 @@ object MainForm: TMainForm AnchorSideRight.Control = PgData AnchorSideRight.Side = asrBottom Left = 2 - Height = 40 - Top = 21 - Width = 263 + Height = 38 + Top = 19 + Width = 240 Max = 19 Min = 1 + OnChange = ZoomTrackBarChange Position = 1 TickMarks = tmBoth - OnChange = ZoomTrackBarChange Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 2 BorderSpacing.Right = 2 @@ -70,12 +70,12 @@ object MainForm: TMainForm object LblZoom: TLabel AnchorSideLeft.Control = PgData AnchorSideTop.Control = PgData - Left = 6 + Left = 4 Height = 15 - Top = 6 - Width = 35 - BorderSpacing.Left = 6 - BorderSpacing.Top = 6 + Top = 4 + Width = 34 + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 Caption = 'Zoom:' ParentColor = False end @@ -85,28 +85,28 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = PgData AnchorSideRight.Side = asrBottom - Left = 6 - Height = 66 - Top = 69 - Width = 255 + Left = 4 + Height = 57 + Top = 63 + Width = 236 Anchors = [akTop, akLeft, akRight] AutoSize = True - BorderSpacing.Left = 6 - BorderSpacing.Top = 8 - BorderSpacing.Right = 6 + BorderSpacing.Left = 4 + BorderSpacing.Top = 6 + BorderSpacing.Right = 4 Caption = 'Mouse position' - ClientHeight = 46 - ClientWidth = 251 + ClientHeight = 40 + ClientWidth = 232 TabOrder = 1 object LblPositionLongitude: TLabel AnchorSideLeft.Control = CbMouseCoords AnchorSideTop.Control = CbMouseCoords - Left = 8 + Left = 6 Height = 15 - Top = 4 - Width = 54 - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 + Top = 2 + Width = 56 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 Caption = 'Longitude' ParentColor = False end @@ -114,13 +114,13 @@ object MainForm: TMainForm AnchorSideLeft.Control = CbMouseCoords AnchorSideTop.Control = LblPositionLongitude AnchorSideTop.Side = asrBottom - Left = 8 + Left = 6 Height = 15 - Top = 23 - Width = 43 - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 8 + Top = 19 + Width = 46 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 6 Caption = 'Latitude' ParentColor = False end @@ -129,14 +129,14 @@ object MainForm: TMainForm AnchorSideTop.Control = CbMouseCoords AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 201 + Left = 186 Height = 15 - Top = 4 - Width = 34 + Top = 2 + Width = 36 Alignment = taRightJustify Anchors = [akTop, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 16 + BorderSpacing.Top = 2 + BorderSpacing.Right = 10 Caption = 'Label2' ParentColor = False end @@ -146,15 +146,15 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 201 + Left = 186 Height = 15 - Top = 23 - Width = 34 + Top = 19 + Width = 36 Alignment = taRightJustify Anchors = [akTop, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 16 - BorderSpacing.Bottom = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 10 + BorderSpacing.Bottom = 6 Caption = 'Label2' ParentColor = False end @@ -165,26 +165,26 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 6 - Height = 66 - Top = 143 - Width = 255 + Left = 4 + Height = 57 + Top = 126 + Width = 236 Anchors = [akTop, akLeft, akRight] AutoSize = True - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Caption = 'Center' - ClientHeight = 46 - ClientWidth = 251 + ClientHeight = 40 + ClientWidth = 232 TabOrder = 2 object LblCenterLongitude: TLabel AnchorSideLeft.Control = GbCenterCoords AnchorSideTop.Control = GbCenterCoords - Left = 8 + Left = 6 Height = 15 - Top = 4 - Width = 54 - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 + Top = 2 + Width = 56 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 Caption = 'Longitude' ParentColor = False end @@ -192,13 +192,13 @@ object MainForm: TMainForm AnchorSideLeft.Control = GbCenterCoords AnchorSideTop.Control = LblCenterLongitude AnchorSideTop.Side = asrBottom - Left = 8 + Left = 6 Height = 15 - Top = 23 - Width = 43 - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 8 + Top = 19 + Width = 46 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 6 Caption = 'Latitude' ParentColor = False end @@ -207,14 +207,14 @@ object MainForm: TMainForm AnchorSideTop.Control = GbCenterCoords AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 201 + Left = 186 Height = 15 - Top = 4 - Width = 34 + Top = 2 + Width = 36 Alignment = taRightJustify Anchors = [akTop, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 16 + BorderSpacing.Top = 2 + BorderSpacing.Right = 10 Caption = 'Label2' ParentColor = False end @@ -224,15 +224,15 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 201 + Left = 186 Height = 15 - Top = 23 - Width = 34 + Top = 19 + Width = 36 Alignment = taRightJustify Anchors = [akTop, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 16 - BorderSpacing.Bottom = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 10 + BorderSpacing.Bottom = 6 Caption = 'Label2' ParentColor = False end @@ -243,26 +243,26 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 6 - Height = 66 - Top = 217 - Width = 255 + Left = 4 + Height = 57 + Top = 189 + Width = 236 Anchors = [akTop, akLeft, akRight] AutoSize = True - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Caption = 'Viewport size' - ClientHeight = 46 - ClientWidth = 251 + ClientHeight = 40 + ClientWidth = 232 TabOrder = 3 object LblViewportWidth: TLabel AnchorSideLeft.Control = GbScreenSize AnchorSideTop.Control = GbScreenSize - Left = 8 + Left = 6 Height = 15 - Top = 4 - Width = 32 - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 + Top = 2 + Width = 33 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 Caption = 'Width' ParentColor = False end @@ -270,13 +270,13 @@ object MainForm: TMainForm AnchorSideLeft.Control = GbScreenSize AnchorSideTop.Control = LblViewportWidth AnchorSideTop.Side = asrBottom - Left = 8 + Left = 6 Height = 15 - Top = 23 - Width = 36 - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 8 + Top = 19 + Width = 37 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 6 Caption = 'Height' ParentColor = False end @@ -284,14 +284,14 @@ object MainForm: TMainForm AnchorSideTop.Control = GbScreenSize AnchorSideRight.Control = GbScreenSize AnchorSideRight.Side = asrBottom - Left = 201 + Left = 186 Height = 15 - Top = 4 - Width = 34 + Top = 2 + Width = 36 Alignment = taRightJustify Anchors = [akTop, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 16 + BorderSpacing.Top = 2 + BorderSpacing.Right = 10 Caption = 'Label2' ParentColor = False end @@ -300,15 +300,15 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbScreenSize AnchorSideRight.Side = asrBottom - Left = 201 + Left = 186 Height = 15 - Top = 23 - Width = 34 + Top = 19 + Width = 36 Alignment = taRightJustify Anchors = [akTop, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 16 - BorderSpacing.Bottom = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 10 + BorderSpacing.Bottom = 6 Caption = 'Label2' ParentColor = False end @@ -318,24 +318,24 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 189 + Left = 192 Height = 23 - Top = 215 - Width = 64 + Top = 187 + Width = 42 Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 8 - ItemHeight = 15 + BorderSpacing.Top = 4 + BorderSpacing.Right = 6 + ItemHeight = 0 ItemIndex = 1 Items.Strings = ( 'm' 'km' 'miles' ) + OnChange = CbDistanceUnitsChange Style = csDropDownList TabOrder = 4 Text = 'km' - OnChange = CbDistanceUnitsChange end object GbSearch: TGroupBox AnchorSideLeft.Control = GbScreenSize @@ -343,32 +343,32 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbScreenSize AnchorSideRight.Side = asrBottom - Left = 6 - Height = 105 - Top = 291 - Width = 255 + Left = 4 + Height = 100 + Top = 252 + Width = 236 Anchors = [akTop, akLeft, akRight] AutoSize = True - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Caption = 'Search' - ClientHeight = 85 - ClientWidth = 251 + ClientHeight = 83 + ClientWidth = 232 TabOrder = 5 object CbLocations: TComboBox AnchorSideLeft.Control = GbSearch AnchorSideTop.Control = GbSearch AnchorSideRight.Control = BtnSearch - Left = 8 - Height = 23 - Top = 4 - Width = 172 + Left = 6 + Height = 25 + Top = 2 + Width = 173 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 + BorderSpacing.Bottom = 2 DropDownCount = 24 - ItemHeight = 15 + ItemHeight = 0 TabOrder = 0 Text = 'New York' end @@ -377,26 +377,26 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = GbSearch AnchorSideRight.Side = asrBottom - Left = 184 + Left = 181 Height = 25 - Top = 3 - Width = 61 + Top = 2 + Width = 47 Anchors = [akTop, akRight] AutoSize = True - BorderSpacing.Right = 6 + BorderSpacing.Right = 4 Caption = 'Search' - TabOrder = 1 OnClick = BtnSearchClick + TabOrder = 1 end object LblSelectLocation: TLabel AnchorSideLeft.Control = CbLocations AnchorSideTop.Control = CbLocations AnchorSideTop.Side = asrBottom - Left = 8 + Left = 6 Height = 15 - Top = 35 - Width = 177 - BorderSpacing.Top = 8 + Top = 33 + Width = 186 + BorderSpacing.Top = 6 Caption = 'Select one of the found locations:' ParentColor = False end @@ -405,38 +405,38 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = BtnSearch AnchorSideRight.Side = asrBottom - Left = 190 + Left = 188 Height = 25 - Top = 52 - Width = 55 + Top = 51 + Width = 40 Anchors = [akTop, akRight] AutoSize = True - BorderSpacing.Bottom = 8 + BorderSpacing.Bottom = 6 Caption = 'Go to' - TabOrder = 3 OnClick = BtnGoToClick + TabOrder = 3 end object CbFoundLocations: TComboBox AnchorSideLeft.Control = LblSelectLocation AnchorSideTop.Control = LblSelectLocation AnchorSideTop.Side = asrBottom AnchorSideRight.Control = BtnGoTo - Left = 8 - Height = 21 - Top = 54 - Width = 178 + Left = 6 + Height = 27 + Top = 50 + Width = 180 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 2 + BorderSpacing.Bottom = 6 DropDownCount = 24 - ItemHeight = 15 + ItemHeight = 10 ItemWidth = -2 + OnDrawItem = CbFoundLocationsDrawItem ParentShowHint = False ShowHint = True Style = csOwnerDrawFixed TabOrder = 2 - OnDrawItem = CbFoundLocationsDrawItem end end object GbGPS: TGroupBox @@ -445,44 +445,44 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbSearch AnchorSideRight.Side = asrBottom - Left = 6 - Height = 105 - Top = 404 - Width = 255 + Left = 4 + Height = 70 + Top = 358 + Width = 236 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Caption = 'GPS points' - ClientHeight = 85 - ClientWidth = 251 + ClientHeight = 66 + ClientWidth = 232 TabOrder = 6 object BtnGPSPoints: TButton AnchorSideLeft.Control = GbGPS AnchorSideTop.Control = GbGPS AnchorSideRight.Control = GbGPS AnchorSideRight.Side = asrBottom - Left = 192 + Left = 190 Height = 25 Top = 0 - Width = 53 + Width = 38 Anchors = [akTop, akRight] AutoSize = True - BorderSpacing.Left = 6 - BorderSpacing.Right = 6 + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 Caption = 'List...' - TabOrder = 0 OnClick = BtnGPSPointsClick + TabOrder = 0 end object InfoBtnGPSPoints: TLabel AnchorSideLeft.Control = GbGPS AnchorSideTop.Control = BtnGPSPoints AnchorSideRight.Control = BtnGPSPoints - Left = 8 + Left = 6 Height = 45 - Top = 4 - Width = 178 + Top = 2 + Width = 180 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 + BorderSpacing.Left = 6 + BorderSpacing.Top = 2 Caption = 'Click with right mouse button to add a GPS point.'#13#10'Settings on page "Config".' ParentColor = False WordWrap = True @@ -495,14 +495,14 @@ object MainForm: TMainForm AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = GbGPS AnchorSideBottom.Side = asrBottom - Left = 8 - Height = 20 - Top = 65 - Width = 237 + Left = 6 + Height = 9 + Top = 57 + Width = 222 Anchors = [akTop, akLeft, akRight, akBottom] AutoSize = False - BorderSpacing.Top = 16 - BorderSpacing.Right = 6 + BorderSpacing.Top = 10 + BorderSpacing.Right = 4 Caption = 'GPSPointInfo' ParentColor = False WordWrap = True @@ -512,29 +512,29 @@ object MainForm: TMainForm AnchorSideLeft.Control = GbGPS AnchorSideTop.Control = GbGPS AnchorSideTop.Side = asrBottom - Left = 6 + Left = 4 Height = 25 - Top = 517 - Width = 110 + Top = 434 + Width = 97 AutoSize = True - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Caption = 'Save map to file' - TabOrder = 7 OnClick = BtnSaveToFileClick + TabOrder = 7 end object BtnLoadGPXFile: TButton AnchorSideLeft.Control = BtnSaveToFile AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = BtnSaveToFile - Left = 124 + Left = 107 Height = 25 - Top = 517 - Width = 105 + Top = 434 + Width = 92 AutoSize = True - BorderSpacing.Left = 8 + BorderSpacing.Left = 6 Caption = 'Load GPX file...' - TabOrder = 8 OnClick = BtnLoadGPXFileClick + TabOrder = 8 end object BtnPrintMap: TButton AnchorSideLeft.Control = BtnSaveToFile @@ -542,29 +542,189 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = BtnSaveToFile AnchorSideRight.Side = asrBottom - Left = 6 - Height = 25 - Top = 550 - Width = 110 + Left = 4 + Height = 26 + Top = 465 + Width = 97 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 6 + Caption = 'Print...' + OnClick = BtnPrintMapClick + TabOrder = 9 + end + end + object pgLayers: TTabSheet + Caption = 'Layers' + ClientHeight = 556 + ClientWidth = 244 + object lblOpacity: TLabel + AnchorSideLeft.Control = Bevel2 + AnchorSideTop.Control = rgDrawMode + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 369 + Width = 45 + BorderSpacing.Top = 6 + Caption = 'Opacity:' + ParentColor = False + end + object tbOpacity: TTrackBar + AnchorSideLeft.Control = lblOpacity + AnchorSideTop.Control = lblOpacity + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = sgLayers + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 38 + Top = 386 + Width = 236 + Frequency = 10 + Max = 100 + OnChange = tbOpacityChange + PageSize = 5 + Position = 25 + TickMarks = tmBoth + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + TabOrder = 0 + end + object Bevel2: TBevel + AnchorSideLeft.Control = sgLayers + AnchorSideTop.Control = sgLayers + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = sgLayers + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 3 + Top = 268 + Width = 236 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 - Caption = 'Print...' - TabOrder = 9 - OnClick = BtnPrintMapClick + Shape = bsTopLine + end + object sgLayers: TStringGrid + AnchorSideLeft.Control = pgLayers + AnchorSideTop.Control = pgLayers + AnchorSideRight.Control = pgLayers + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 256 + Top = 4 + Width = 236 + Anchors = [akTop, akLeft, akRight] + AutoFillColumns = True + BorderSpacing.Around = 4 + ColCount = 3 + Columns = < + item + ButtonStyle = cbsCheckboxColumn + MinSize = 8 + MaxSize = 166 + SizePriority = 0 + Title.Alignment = taCenter + Title.Caption = 'Visible' + Width = 54 + ValueChecked = '-1' + end + item + ButtonStyle = cbsPickList + MinSize = 8 + MaxSize = 166 + Title.Caption = 'Provider' + Width = 148 + end> + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll, goRowHighlight] + RowCount = 11 + TabOrder = 1 + OnCheckboxToggled = sgLayersCheckboxToggled + OnEditingDone = sgLayersEditingDone + OnSelection = sgLayersSelection + ColWidths = ( + 30 + 54 + 148 + ) + Cells = ( + 11 + 0 + 1 + '0' + 0 + 2 + '1' + 0 + 3 + '2' + 0 + 4 + '3' + 0 + 5 + '4' + 0 + 6 + '5' + 0 + 7 + '6' + 0 + 8 + '7' + 0 + 9 + '8' + 0 + 10 + '9' + 1 + 0 + 'Vis' + ) + end + object rgDrawMode: TRadioGroup + AnchorSideLeft.Control = Bevel2 + AnchorSideTop.Control = Bevel2 + AnchorSideRight.Control = Bevel2 + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 87 + Top = 276 + Width = 236 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + BorderSpacing.Top = 8 + Caption = 'Draw Mode' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 68 + ClientWidth = 232 + Items.Strings = ( + 'Opaque' + 'Use Opacity' + 'Tile alpha' + ) + OnSelectionChanged = rgDrawModeSelectionChanged + TabOrder = 2 end end object PgConfig: TTabSheet Caption = 'Config' - ClientHeight = 612 - ClientWidth = 267 + ClientHeight = 556 + ClientWidth = 244 object LblProviders: TLabel AnchorSideLeft.Control = CbProviders AnchorSideTop.Control = PgConfig - Left = 6 + Left = 4 Height = 15 - Top = 12 - Width = 52 - BorderSpacing.Top = 12 + Top = 8 + Width = 55 + BorderSpacing.Top = 8 Caption = 'Providers:' FocusControl = CbProviders ParentColor = False @@ -574,31 +734,31 @@ object MainForm: TMainForm AnchorSideTop.Control = LblProviders AnchorSideTop.Side = asrBottom AnchorSideRight.Control = BtnLoadMapProviders - Left = 6 - Height = 23 - Top = 29 - Width = 201 + Left = 4 + Height = 27 + Top = 25 + Width = 170 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 6 + BorderSpacing.Left = 4 BorderSpacing.Top = 2 - BorderSpacing.Right = 4 + BorderSpacing.Right = 2 DropDownCount = 24 - ItemHeight = 15 + ItemHeight = 0 + OnChange = CbProvidersChange Style = csDropDownList TabOrder = 0 - OnChange = CbProvidersChange end object BtnLoadMapProviders: TSpeedButton AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CbProviders AnchorSideTop.Side = asrCenter AnchorSideRight.Control = BtnSaveMapProviders - Left = 211 - Height = 22 - Top = 29 - Width = 23 + Left = 176 + Height = 28 + Top = 24 + Width = 30 Anchors = [akTop, akRight] - BorderSpacing.Right = 4 + BorderSpacing.Right = 2 Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 @@ -644,12 +804,12 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = PgConfig AnchorSideRight.Side = asrBottom - Left = 238 - Height = 22 - Top = 29 - Width = 23 + Left = 208 + Height = 28 + Top = 24 + Width = 32 Anchors = [akTop, akRight] - BorderSpacing.Right = 6 + BorderSpacing.Right = 4 Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000A4653455A465 @@ -692,60 +852,59 @@ object MainForm: TMainForm AnchorSideLeft.Control = PgConfig AnchorSideTop.Control = CbZoomToCursor AnchorSideTop.Side = asrBottom - Left = 6 - Height = 19 - Top = 296 - Width = 79 - BorderSpacing.Left = 6 - BorderSpacing.Top = 6 + Left = 4 + Height = 21 + Top = 289 + Width = 88 + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 Caption = 'Use threads' Checked = True + OnChange = CbUseThreadsChange State = cbChecked TabOrder = 4 - OnChange = CbUseThreadsChange end object CbDoubleBuffer: TCheckBox AnchorSideLeft.Control = CbUseThreads AnchorSideTop.Control = CbUseThreads AnchorSideTop.Side = asrBottom - Left = 6 - Height = 19 - Top = 321 - Width = 85 - BorderSpacing.Top = 6 - BorderSpacing.Right = 9 + Left = 4 + Height = 21 + Top = 314 + Width = 95 + BorderSpacing.Top = 4 + BorderSpacing.Right = 6 Caption = 'DblBuffering' Checked = True + OnChange = CbDoubleBufferChange State = cbChecked TabOrder = 6 - OnChange = CbDoubleBufferChange end object CbDebugTiles: TCheckBox AnchorSideLeft.Control = CbDoubleBuffer AnchorSideTop.Control = CbDoubleBuffer AnchorSideTop.Side = asrBottom - Left = 6 - Height = 19 - Top = 346 - Width = 77 - BorderSpacing.Top = 6 + Left = 4 + Height = 21 + Top = 339 + Width = 86 + BorderSpacing.Top = 4 Caption = 'Debug tiles' - TabOrder = 7 OnChange = CbDebugTilesChange + TabOrder = 7 end object BtnPOITextFont: TButton AnchorSideLeft.Control = rgPOIMode AnchorSideTop.Control = rgPOIMode AnchorSideTop.Side = asrBottom - Left = 6 - Height = 25 - Top = 501 - Width = 93 - AutoSize = True - BorderSpacing.Top = 12 + Left = 4 + Height = 30 + Top = 491 + Width = 87 + BorderSpacing.Top = 8 Caption = 'POI text font' - TabOrder = 9 OnClick = BtnPOITextFontClick + TabOrder = 9 end object cbPOITextBgColor: TColorBox AnchorSideLeft.Control = LblPOITextBgColor @@ -753,28 +912,29 @@ object MainForm: TMainForm AnchorSideTop.Control = BtnPOITextFont AnchorSideTop.Side = asrCenter AnchorSideRight.Side = asrBottom - Left = 154 - Height = 22 - Top = 502 - Width = 107 + Left = 143 + Height = 30 + Top = 491 + Width = 95 NoneColorColor = clWhite Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors] Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 8 - ItemHeight = 16 - TabOrder = 10 + AutoSize = False + BorderSpacing.Left = 6 + ItemHeight = 10 OnChange = cbPOITextBgColorChange + TabOrder = 10 end object LblPOITextBgColor: TLabel AnchorSideLeft.Control = BtnPOITextFont AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = BtnPOITextFont AnchorSideTop.Side = asrCenter - Left = 107 + Left = 97 Height = 15 - Top = 506 - Width = 39 - BorderSpacing.Left = 8 + Top = 499 + Width = 40 + BorderSpacing.Left = 6 Caption = 'Backgr.' ParentColor = False end @@ -783,25 +943,25 @@ object MainForm: TMainForm AnchorSideTop.Control = CbDebugTiles AnchorSideTop.Side = asrBottom AnchorSideRight.Side = asrBottom - Left = 6 - Height = 4 - Top = 373 - Width = 255 + Left = 4 + Height = 2 + Top = 366 + Width = 234 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Shape = bsTopLine end object rgPOIMode: TRadioGroup AnchorSideLeft.Control = CbProviders AnchorSideTop.Control = Bevel1 AnchorSideTop.Side = asrBottom - Left = 6 - Height = 104 - Top = 385 - Width = 159 + Left = 4 + Height = 109 + Top = 374 + Width = 166 AutoFill = True AutoSize = True - BorderSpacing.Top = 8 + BorderSpacing.Top = 6 Caption = 'POI Mode' ChildSizing.LeftRightSpacing = 12 ChildSizing.TopBottomSpacing = 4 @@ -811,8 +971,8 @@ object MainForm: TMainForm ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 84 - ClientWidth = 155 + ClientHeight = 92 + ClientWidth = 162 ItemIndex = 0 Items.Strings = ( 'default drawing' @@ -820,48 +980,48 @@ object MainForm: TMainForm 'image from imagelist' 'custom drawing' ) - TabOrder = 8 OnClick = rgPOIModeClick + TabOrder = 8 end object CbZoomToCursor: TCheckBox AnchorSideLeft.Control = PgConfig AnchorSideTop.Control = gbProxy AnchorSideTop.Side = asrBottom - Left = 6 - Height = 19 - Top = 271 - Width = 100 - BorderSpacing.Left = 6 - BorderSpacing.Top = 12 - BorderSpacing.Right = 24 + Left = 4 + Height = 21 + Top = 264 + Width = 107 + BorderSpacing.Left = 4 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 Caption = 'Zoom to cursor' Checked = True + OnChange = CbZoomToCursorChange State = cbChecked TabOrder = 2 - OnChange = CbZoomToCursorChange end object cbCyclicView: TCheckBox AnchorSideLeft.Control = CbZoomToCursor AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CbZoomToCursor - Left = 130 - Height = 19 - Top = 271 - Width = 77 + Left = 127 + Height = 21 + Top = 264 + Width = 82 Caption = 'Cyclic view' Checked = True + OnChange = cbCyclicViewChange State = cbChecked TabOrder = 3 - OnChange = cbCyclicViewChange end object clbBackColor: TColorButton AnchorSideLeft.Control = cbCyclicView AnchorSideTop.Control = CbDoubleBuffer AnchorSideTop.Side = asrCenter - Left = 130 - Height = 25 - Top = 318 - Width = 105 + Left = 127 + Height = 28 + Top = 310 + Width = 108 BorderWidth = 2 ButtonColorAutoSize = False ButtonColorSize = 15 @@ -873,15 +1033,15 @@ object MainForm: TMainForm object CbPreviewTiles: TCheckBox AnchorSideLeft.Control = cbCyclicView AnchorSideTop.Control = CbUseThreads - Left = 130 - Height = 19 - Top = 296 - Width = 83 + Left = 127 + Height = 21 + Top = 289 + Width = 93 Caption = 'Preview tiles' Checked = True + OnChange = CbPreviewTilesChange State = cbChecked TabOrder = 5 - OnChange = CbPreviewTilesChange end object gbProxy: TGroupBox AnchorSideLeft.Control = PgConfig @@ -889,28 +1049,29 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = PgConfig AnchorSideRight.Side = asrBottom - Left = 6 - Height = 195 - Top = 64 - Width = 255 + Left = 4 + Height = 196 + Top = 60 + Width = 236 Anchors = [akTop, akLeft, akRight] AutoSize = True - BorderSpacing.Top = 6 - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 + BorderSpacing.Around = 4 Caption = 'Proxy' - ClientHeight = 175 - ClientWidth = 251 + ClientHeight = 179 + ClientWidth = 232 TabOrder = 1 object lblProxyHost: TLabel AnchorSideLeft.Control = rbNoProxy AnchorSideTop.Control = edProxyHost AnchorSideTop.Side = asrCenter - Left = 32 + Left = 20 Height = 15 - Top = 67 + Top = 72 Width = 28 - BorderSpacing.Left = 16 + BorderSpacing.Left = 10 Caption = 'Host:' + ParentColor = False end object edProxyHost: TEdit AnchorSideLeft.Control = edProxyUserName @@ -918,49 +1079,51 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbProxy AnchorSideRight.Side = asrBottom - Left = 99 - Height = 23 - Top = 63 - Width = 144 + Left = 87 + Height = 25 + Top = 67 + Width = 139 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Right = 8 - TabOrder = 3 + BorderSpacing.Right = 6 OnChange = rbProxyChange + TabOrder = 3 end object lblProxyPort: TLabel AnchorSideLeft.Control = lblProxyHost AnchorSideTop.Control = seProxyPort AnchorSideTop.Side = asrCenter - Left = 32 + Left = 20 Height = 15 - Top = 94 - Width = 22 + Top = 99 + Width = 24 Caption = 'Port' + ParentColor = False end object seProxyPort: TSpinEdit AnchorSideLeft.Control = lblProxyUserName AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = edProxyHost AnchorSideTop.Side = asrBottom - Left = 99 - Height = 23 - Top = 90 - Width = 104 - BorderSpacing.Top = 4 + Left = 87 + Height = 25 + Top = 94 + Width = 70 + BorderSpacing.Top = 2 MaxValue = 65535 - TabOrder = 4 OnChange = rbProxyChange + TabOrder = 4 end object lblProxyUserName: TLabel AnchorSideLeft.Control = lblProxyHost AnchorSideTop.Control = edProxyUserName AnchorSideTop.Side = asrCenter - Left = 32 + Left = 20 Height = 15 - Top = 121 - Width = 59 - BorderSpacing.Right = 8 + Top = 126 + Width = 61 + BorderSpacing.Right = 6 Caption = 'User name:' + ParentColor = False end object edProxyUserName: TEdit AnchorSideLeft.Control = lblProxyUserName @@ -969,25 +1132,26 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbProxy AnchorSideRight.Side = asrBottom - Left = 99 - Height = 23 - Top = 117 - Width = 144 + Left = 87 + Height = 25 + Top = 121 + Width = 139 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 8 - TabOrder = 5 + BorderSpacing.Top = 2 + BorderSpacing.Right = 6 OnChange = rbProxyChange + TabOrder = 5 end object lblProxyPassword: TLabel AnchorSideLeft.Control = lblProxyHost AnchorSideTop.Control = edProxyPassword AnchorSideTop.Side = asrCenter - Left = 32 + Left = 20 Height = 15 - Top = 148 - Width = 50 + Top = 153 + Width = 51 Caption = 'Password' + ParentColor = False end object edProxyPassword: TEdit AnchorSideLeft.Control = edProxyUserName @@ -995,56 +1159,56 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbProxy AnchorSideRight.Side = asrBottom - Left = 99 - Height = 23 - Top = 144 - Width = 144 + Left = 87 + Height = 25 + Top = 148 + Width = 139 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - TabOrder = 6 + BorderSpacing.Top = 2 + BorderSpacing.Right = 6 + BorderSpacing.Bottom = 6 OnChange = rbProxyChange + TabOrder = 6 end object rbProxyData: TRadioButton AnchorSideLeft.Control = rbNoProxy AnchorSideTop.Control = rbSystemProxy AnchorSideTop.Side = asrBottom - Left = 16 - Height = 19 - Top = 44 - Width = 74 - BorderSpacing.Top = 3 + Left = 10 + Height = 21 + Top = 46 + Width = 81 + BorderSpacing.Top = 2 Caption = 'Proxy data' - TabOrder = 2 OnChangeBounds = rbProxyChange + TabOrder = 2 end object rbNoProxy: TRadioButton AnchorSideLeft.Control = gbProxy AnchorSideTop.Control = gbProxy - Left = 16 - Height = 19 + Left = 10 + Height = 21 Top = 0 - Width = 67 - BorderSpacing.Left = 16 + Width = 73 + BorderSpacing.Left = 10 Caption = 'No proxy' - TabOrder = 0 OnChange = rbProxyChange + TabOrder = 0 end object rbSystemProxy: TRadioButton AnchorSideLeft.Control = rbNoProxy AnchorSideTop.Control = rbNoProxy AnchorSideTop.Side = asrBottom - Left = 16 - Height = 19 - Top = 22 - Width = 110 - BorderSpacing.Top = 3 + Left = 10 + Height = 21 + Top = 23 + Width = 118 + BorderSpacing.Top = 2 Caption = 'Use system proxy' Checked = True + OnChange = rbProxyChange TabOrder = 1 TabStop = True - OnChange = rbProxyChange end end end diff --git a/components/lazmapviewer/examples/fulldemo/main.pas b/components/lazmapviewer/examples/fulldemo/main.pas index beae98ef3..444bf2a21 100644 --- a/components/lazmapviewer/examples/fulldemo/main.pas +++ b/components/lazmapviewer/examples/fulldemo/main.pas @@ -7,7 +7,7 @@ interface uses Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin, PrintersDlgs, - mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine; + mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine, Grids; type @@ -81,6 +81,10 @@ type PrintDialog1: TPrintDialog; rgPOIMode: TRadioGroup; seProxyPort: TSpinEdit; + sgLayers: TStringGrid; + rgDrawMode: TRadioGroup; + lblOpacity: TLabel; + tbOpacity: TTrackBar; ZoomTrackBar: TTrackBar; procedure BtnGoToClick(Sender: TObject); procedure BtnLoadGPXFileClick(Sender: TObject); @@ -118,7 +122,14 @@ type procedure MapViewZoomChange(Sender: TObject); procedure BtnLoadMapProvidersClick(Sender: TObject); procedure BtnSaveMapProvidersClick(Sender: TObject); + procedure rgDrawModeSelectionChanged(Sender: TObject); procedure rgPOIModeClick(Sender: TObject); + procedure sgLayersCheckboxToggled(sender: TObject; aCol, aRow: Integer; + aState: TCheckboxState); + procedure sgLayersEditingDone(Sender: TObject); + procedure sgLayersSelection(Sender: TObject; aCol, aRow: Integer); + procedure tbOpacityChange(Sender: TObject); + procedure UpdateLayers; procedure ZoomTrackBarChange(Sender: TObject); private @@ -160,9 +171,11 @@ const MAX_LOCATIONS_HISTORY = 50; MAP_PROVIDER_FILENAME = 'map-providers.xml'; USE_DMS = true; + _TILELAYERS_ID_ = 42; var PointFormatSettings: TFormatsettings; + TileLayer: array[0..9] of TGPSTileLayer; function CalcIniName: String; begin @@ -183,6 +196,7 @@ begin MapView.GetMapProviders(CbProviders.Items); CbProviders.ItemIndex := 0; MapView.MapProvider := CbProviders.Text; + sgLayers.Columns[1].PickList.Assign(CbProviders.Items); end else ShowMessage(msg); end; @@ -193,6 +207,12 @@ begin MapView.Engine.WriteProvidersToXML(Application.Location + MAP_PROVIDER_FILENAME); end; +procedure TMainForm.rgDrawModeSelectionChanged(Sender: TObject); +begin + TileLayer[Pred(sgLayers.Row)].DrawMode := TItemDrawMode(rgDrawMode.ItemIndex); + MapView.Redraw; +end; + procedure TMainForm.BtnSearchClick(Sender: TObject); begin ClearFoundLocations; @@ -349,11 +369,13 @@ end; procedure TMainForm.cbCyclicViewChange(Sender: TObject); begin MapView.Cyclic := cbCyclicView.Checked; + UpdateLayers; end; procedure TMainForm.CbDebugTilesChange(Sender: TObject); begin MapView.DebugTiles := CbDebugTiles.Checked; + MapView.Invalidate; end; procedure TMainForm.CbDoubleBufferChange(Sender: TObject); @@ -423,6 +445,7 @@ end; procedure TMainForm.CbUseThreadsChange(Sender: TObject); begin MapView.UseThreads := CbUseThreads.Checked; + UpdateLayers; end; procedure TMainForm.CbDistanceUnitsChange(Sender: TObject); @@ -458,6 +481,7 @@ var homeDir: String; cacheDir: String; fn: String; + I: Integer; begin cInputQueryEditSizePercents := 0; @@ -483,6 +507,7 @@ begin MapView.CachePath := cacheDir; MapView.GetMapProviders(CbProviders.Items); CbProviders.ItemIndex := CbProviders.Items.IndexOf(MapView.MapProvider); + sgLayers.Columns[1].PickList.Assign(CbProviders.Items); MapView.DoubleBuffered := true; MapView.Zoom := 1; CbZoomToCursor.Checked := MapView.ZoomToCursor; @@ -499,12 +524,38 @@ begin InfoViewportHeight.Caption := ''; GPSPointInfo.caption := ''; + for I := 0 to High(TileLayer) do + begin + TileLayer[I] := TGPSTileLayer.Create; + with TileLayer[I] do + begin + Visible := False; + UseThreads := MapView.UseThreads; + DrawMode := idmUseOpacity; + Opacity := 0.25; + case I of + 0: MapProvider := 'Google Satellite Only'; + 1: MapProvider := 'Google Terrain'; + 2: MapProvider := 'Maps For Free'; + otherwise + MapProvider := ''; + end; + end; + sgLayers.Cells[1, I + 1] := TileLayer[I].Visible.ToString; + sgLayers.Cells[2, I + 1] := TileLayer[I].MapProvider; + MapView.GPSLayer[I].Add(TileLayer[I], _TILELAYERS_ID_); + end; + ReadFromIni; end; procedure TMainForm.FormDestroy(Sender: TObject); +var + I: Integer; begin WriteToIni; + for I := 0 to High(TileLayer) do + MapView.GPSLayer[I].Delete(TileLayer[I]); ClearFoundLocations; FreeAndNil(POIImage) end; @@ -742,6 +793,7 @@ begin MapView.Engine.ClearMapProviders; MapView.Engine.RegisterProviders; MapView.GetMapProviders(CbProviders.Items); + sgLayers.Columns[1].PickList.Assign(CbProviders.Items); end; R := Screen.DesktopRect; @@ -829,6 +881,47 @@ begin end; end; +procedure TMainForm.sgLayersCheckboxToggled(sender: TObject; aCol, + aRow: Integer; aState: TCheckboxState); +begin + TileLayer[Pred(sgLayers.Row)].Visible := (aState = cbChecked); + MapView.Redraw; +end; + +procedure TMainForm.sgLayersEditingDone(Sender: TObject); +var + S: String; +begin + if sgLayers.Col <> 2 then + Exit; + S := sgLayers.Cells[sgLayers.Col, sgLayers.Row]; + TileLayer[Pred(sgLayers.Row)].MapProvider := S; + sgLayers.Cells[sgLayers.Col, sgLayers.Row] := S; + MapView.Redraw; +end; + +procedure TMainForm.sgLayersSelection(Sender: TObject; aCol, aRow: Integer); +begin + rgDrawMode.ItemIndex := Ord(TileLayer[Pred(ARow)].DrawMode); + tbOpacity.Position := Round(TileLayer[Pred(ARow)].Opacity * 100); +end; + +procedure TMainForm.tbOpacityChange(Sender: TObject); +begin + TileLayer[Pred(sgLayers.Row)].Opacity := tbOpacity.Position / 100; + MapView.Redraw; +end; + +procedure TMainForm.UpdateLayers; +var + TL: TGPSTileLayer; +begin + // Notify tile layers for drawing engine change, it must be done implicitly + // but there is no other mechanism for now + for TL in TileLayer do + TL.ParentViewChanged; +end; + procedure TMainForm.UpdateCoords(X, Y: Integer); var rPt: TRealPoint; diff --git a/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm b/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm index f634a70db..d8b42f861 100644 --- a/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm +++ b/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm @@ -1,22 +1,21 @@ object MainForm: TMainForm Left = 332 - Height = 640 + Height = 662 Top = 183 - Width = 883 + Width = 942 Caption = 'LazMapViewer' - ClientHeight = 640 - ClientWidth = 883 - ShowHint = True - LCLVersion = '3.99.0.0' + ClientHeight = 662 + ClientWidth = 942 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow + ShowHint = True object MapView: TMapView Left = 0 - Height = 640 + Height = 662 Hint = 'Displays the map' Top = 0 - Width = 608 + Width = 667 Align = alClient Cyclic = True DefaultTrackColor = clBlue @@ -33,18 +32,18 @@ object MainForm: TMainForm OnMouseUp = MapViewMouseUp end object PageControl: TPageControl - Left = 608 - Height = 640 + Left = 667 + Height = 662 Top = 0 Width = 275 ActivePage = PgConfig Align = alRight - TabIndex = 1 + TabIndex = 2 TabOrder = 1 object PgData: TTabSheet Caption = 'Data' - ClientHeight = 612 - ClientWidth = 267 + ClientHeight = 627 + ClientWidth = 269 object ZoomTrackBar: TTrackBar AnchorSideLeft.Control = PgData AnchorSideTop.Control = LblZoom @@ -53,13 +52,13 @@ object MainForm: TMainForm AnchorSideRight.Side = asrBottom Left = 2 Height = 40 - Top = 21 - Width = 263 + Top = 23 + Width = 265 Max = 19 Min = 1 + OnChange = ZoomTrackBarChange Position = 1 TickMarks = tmBoth - OnChange = ZoomTrackBarChange Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 2 BorderSpacing.Right = 2 @@ -69,12 +68,13 @@ object MainForm: TMainForm AnchorSideLeft.Control = PgData AnchorSideTop.Control = PgData Left = 6 - Height = 15 + Height = 17 Top = 6 - Width = 35 + Width = 43 BorderSpacing.Left = 6 BorderSpacing.Top = 6 Caption = 'Zoom:' + ParentColor = False end object CbMouseCoords: TGroupBox AnchorSideLeft.Control = PgData @@ -83,56 +83,59 @@ object MainForm: TMainForm AnchorSideRight.Control = PgData AnchorSideRight.Side = asrBottom Left = 6 - Height = 66 - Top = 69 - Width = 255 + Height = 69 + Top = 71 + Width = 257 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Left = 6 BorderSpacing.Top = 8 BorderSpacing.Right = 6 Caption = 'Mouse position' - ClientHeight = 46 - ClientWidth = 251 + ClientHeight = 50 + ClientWidth = 253 TabOrder = 1 object LblPositionLongitude: TLabel AnchorSideLeft.Control = CbMouseCoords AnchorSideTop.Control = CbMouseCoords Left = 8 - Height = 15 + Height = 17 Top = 4 - Width = 54 + Width = 68 BorderSpacing.Left = 8 BorderSpacing.Top = 4 Caption = 'Longitude' + ParentColor = False end object LblPositionLatitude: TLabel AnchorSideLeft.Control = CbMouseCoords AnchorSideTop.Control = LblPositionLongitude AnchorSideTop.Side = asrBottom Left = 8 - Height = 15 - Top = 23 - Width = 43 + Height = 17 + Top = 25 + Width = 57 BorderSpacing.Left = 8 BorderSpacing.Top = 4 BorderSpacing.Bottom = 8 Caption = 'Latitude' + ParentColor = False end object InfoPositionLongitude: TLabel AnchorSideLeft.Control = CbMouseCoords AnchorSideTop.Control = CbMouseCoords AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 201 - Height = 15 + Left = 192 + Height = 17 Top = 4 - Width = 34 + Width = 45 Alignment = taRightJustify Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 16 Caption = 'Label2' + ParentColor = False end object InfoPositionLatitude: TLabel AnchorSideLeft.Control = CbMouseCoords @@ -140,16 +143,17 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 201 - Height = 15 - Top = 23 - Width = 34 + Left = 192 + Height = 17 + Top = 25 + Width = 45 Alignment = taRightJustify Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 16 BorderSpacing.Bottom = 8 Caption = 'Label2' + ParentColor = False end end object GbCenterCoords: TGroupBox @@ -159,54 +163,57 @@ object MainForm: TMainForm AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom Left = 6 - Height = 66 - Top = 143 - Width = 255 + Height = 69 + Top = 148 + Width = 257 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 8 Caption = 'Center' - ClientHeight = 46 - ClientWidth = 251 + ClientHeight = 50 + ClientWidth = 253 TabOrder = 2 object LblCenterLongitude: TLabel AnchorSideLeft.Control = GbCenterCoords AnchorSideTop.Control = GbCenterCoords Left = 8 - Height = 15 + Height = 17 Top = 4 - Width = 54 + Width = 68 BorderSpacing.Left = 8 BorderSpacing.Top = 4 Caption = 'Longitude' + ParentColor = False end object LblCenterLatitude: TLabel AnchorSideLeft.Control = GbCenterCoords AnchorSideTop.Control = LblCenterLongitude AnchorSideTop.Side = asrBottom Left = 8 - Height = 15 - Top = 23 - Width = 43 + Height = 17 + Top = 25 + Width = 57 BorderSpacing.Left = 8 BorderSpacing.Top = 4 BorderSpacing.Bottom = 8 Caption = 'Latitude' + ParentColor = False end object InfoCenterLongitude: TLabel AnchorSideLeft.Control = GbCenterCoords AnchorSideTop.Control = GbCenterCoords AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 201 - Height = 15 + Left = 192 + Height = 17 Top = 4 - Width = 34 + Width = 45 Alignment = taRightJustify Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 16 Caption = 'Label2' + ParentColor = False end object InfoCenterLatitude: TLabel AnchorSideLeft.Control = GbCenterCoords @@ -214,16 +221,17 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 201 - Height = 15 - Top = 23 - Width = 34 + Left = 192 + Height = 17 + Top = 25 + Width = 45 Alignment = taRightJustify Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 16 BorderSpacing.Bottom = 8 Caption = 'Label2' + ParentColor = False end end object GbScreenSize: TGroupBox @@ -233,69 +241,73 @@ object MainForm: TMainForm AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom Left = 6 - Height = 66 - Top = 217 - Width = 255 + Height = 69 + Top = 225 + Width = 257 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 8 Caption = 'Viewport size' - ClientHeight = 46 - ClientWidth = 251 + ClientHeight = 50 + ClientWidth = 253 TabOrder = 3 object LblViewportWidth: TLabel AnchorSideLeft.Control = GbScreenSize AnchorSideTop.Control = GbScreenSize Left = 8 - Height = 15 + Height = 17 Top = 4 - Width = 32 + Width = 41 BorderSpacing.Left = 8 BorderSpacing.Top = 4 Caption = 'Width' + ParentColor = False end object LblViewportHeight: TLabel AnchorSideLeft.Control = GbScreenSize AnchorSideTop.Control = LblViewportWidth AnchorSideTop.Side = asrBottom Left = 8 - Height = 15 - Top = 23 - Width = 36 + Height = 17 + Top = 25 + Width = 44 BorderSpacing.Left = 8 BorderSpacing.Top = 4 BorderSpacing.Bottom = 8 Caption = 'Height' + ParentColor = False end object InfoViewportWidth: TLabel AnchorSideTop.Control = GbScreenSize AnchorSideRight.Control = GbScreenSize AnchorSideRight.Side = asrBottom - Left = 201 - Height = 15 + Left = 192 + Height = 17 Top = 4 - Width = 34 + Width = 45 Alignment = taRightJustify Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 16 Caption = 'Label2' + ParentColor = False end object InfoViewportHeight: TLabel AnchorSideTop.Control = InfoViewportWidth AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbScreenSize AnchorSideRight.Side = asrBottom - Left = 201 - Height = 15 - Top = 23 - Width = 34 + Left = 192 + Height = 17 + Top = 25 + Width = 45 Alignment = taRightJustify Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 16 BorderSpacing.Bottom = 8 Caption = 'Label2' + ParentColor = False end end object CbDistanceUnits: TComboBox @@ -303,24 +315,24 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 189 - Height = 23 - Top = 215 + Left = 191 + Height = 25 + Top = 223 Width = 64 Anchors = [akTop, akRight] BorderSpacing.Top = 6 BorderSpacing.Right = 8 - ItemHeight = 15 + ItemHeight = 0 ItemIndex = 1 Items.Strings = ( 'm' 'km' 'miles' ) + OnChange = CbDistanceUnitsChange Style = csDropDownList TabOrder = 4 Text = 'km' - OnChange = CbDistanceUnitsChange end object GbSearch: TGroupBox AnchorSideLeft.Control = GbScreenSize @@ -329,31 +341,31 @@ object MainForm: TMainForm AnchorSideRight.Control = GbScreenSize AnchorSideRight.Side = asrBottom Left = 6 - Height = 105 - Top = 291 - Width = 255 + Height = 116 + Top = 302 + Width = 257 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 8 Caption = 'Search' - ClientHeight = 85 - ClientWidth = 251 + ClientHeight = 97 + ClientWidth = 253 TabOrder = 5 object CbLocations: TComboBox AnchorSideLeft.Control = GbSearch AnchorSideTop.Control = GbSearch AnchorSideRight.Control = BtnSearch Left = 8 - Height = 23 + Height = 27 Top = 4 - Width = 172 + Width = 180 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 8 BorderSpacing.Top = 4 BorderSpacing.Right = 4 BorderSpacing.Bottom = 4 DropDownCount = 24 - ItemHeight = 15 + ItemHeight = 0 TabOrder = 0 Text = 'New York' end @@ -362,43 +374,44 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = GbSearch AnchorSideRight.Side = asrBottom - Left = 184 - Height = 25 - Top = 3 - Width = 61 + Left = 192 + Height = 27 + Top = 4 + Width = 55 Anchors = [akTop, akRight] AutoSize = True BorderSpacing.Right = 6 Caption = 'Search' - TabOrder = 1 OnClick = BtnSearchClick + TabOrder = 1 end object LblSelectLocation: TLabel AnchorSideLeft.Control = CbLocations AnchorSideTop.Control = CbLocations AnchorSideTop.Side = asrBottom Left = 8 - Height = 15 - Top = 35 - Width = 177 + Height = 17 + Top = 39 + Width = 224 BorderSpacing.Top = 8 Caption = 'Select one of the found locations:' + ParentColor = False end object BtnGoTo: TButton AnchorSideTop.Control = CbFoundLocations AnchorSideTop.Side = asrCenter AnchorSideRight.Control = BtnSearch AnchorSideRight.Side = asrBottom - Left = 190 - Height = 25 - Top = 52 - Width = 55 + Left = 200 + Height = 27 + Top = 61 + Width = 47 Anchors = [akTop, akRight] AutoSize = True BorderSpacing.Bottom = 8 Caption = 'Go to' - TabOrder = 2 OnClick = BtnGoToClick + TabOrder = 2 end object CbFoundLocations: TComboBox AnchorSideLeft.Control = LblSelectLocation @@ -406,9 +419,9 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = BtnGoTo Left = 8 - Height = 21 - Top = 54 - Width = 178 + Height = 29 + Top = 60 + Width = 188 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 4 @@ -416,11 +429,11 @@ object MainForm: TMainForm DropDownCount = 24 ItemHeight = 15 ItemWidth = -2 + OnDrawItem = CbFoundLocationsDrawItem ParentShowHint = False ShowHint = True Style = csOwnerDrawFixed TabOrder = 3 - OnDrawItem = CbFoundLocationsDrawItem end end object GbGPS: TGroupBox @@ -431,43 +444,44 @@ object MainForm: TMainForm AnchorSideRight.Side = asrBottom Left = 6 Height = 105 - Top = 404 - Width = 255 + Top = 426 + Width = 257 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 Caption = 'GPS points' - ClientHeight = 85 - ClientWidth = 251 + ClientHeight = 86 + ClientWidth = 253 TabOrder = 6 object BtnGPSPoints: TButton AnchorSideLeft.Control = GbGPS AnchorSideTop.Control = GbGPS AnchorSideRight.Control = GbGPS AnchorSideRight.Side = asrBottom - Left = 192 - Height = 25 + Left = 200 + Height = 27 Top = 0 - Width = 53 + Width = 47 Anchors = [akTop, akRight] AutoSize = True BorderSpacing.Left = 6 BorderSpacing.Right = 6 Caption = 'List...' - TabOrder = 0 OnClick = BtnGPSPointsClick + TabOrder = 0 end object InfoBtnGPSPoints: TLabel AnchorSideLeft.Control = GbGPS AnchorSideTop.Control = BtnGPSPoints AnchorSideRight.Control = BtnGPSPoints Left = 8 - Height = 30 + Height = 34 Top = 4 - Width = 178 + Width = 186 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 8 BorderSpacing.Top = 4 Caption = 'Click with right mouse button to add a GPS point.' + ParentColor = False WordWrap = True end object GPSPointInfo: TLabel @@ -479,14 +493,15 @@ object MainForm: TMainForm AnchorSideBottom.Control = GbGPS AnchorSideBottom.Side = asrBottom Left = 8 - Height = 35 - Top = 50 - Width = 237 + Height = 32 + Top = 54 + Width = 239 Anchors = [akTop, akLeft, akRight, akBottom] AutoSize = False BorderSpacing.Top = 16 BorderSpacing.Right = 6 Caption = 'GPSPointInfo' + ParentColor = False WordWrap = True end end @@ -495,43 +510,200 @@ object MainForm: TMainForm AnchorSideTop.Control = GbGPS AnchorSideTop.Side = asrBottom Left = 6 - Height = 25 - Top = 517 - Width = 110 + Height = 27 + Top = 539 + Width = 116 AutoSize = True BorderSpacing.Top = 8 Caption = 'Save map to file' - TabOrder = 7 OnClick = BtnSaveToFileClick + TabOrder = 7 end object BtnLoadGPXFile: TButton AnchorSideLeft.Control = BtnSaveToFile AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = BtnSaveToFile - Left = 124 - Height = 25 - Top = 517 - Width = 105 + Left = 130 + Height = 27 + Top = 539 + Width = 111 AutoSize = True BorderSpacing.Left = 8 Caption = 'Load GPX file...' - TabOrder = 8 OnClick = BtnLoadGPXFileClick + TabOrder = 8 + end + end + object pgLayers: TTabSheet + Caption = 'Layers' + ClientHeight = 627 + ClientWidth = 269 + object lblOpacity: TLabel + AnchorSideLeft.Control = Bevel2 + AnchorSideTop.Control = rgDrawMode + AnchorSideTop.Side = asrBottom + Left = 5 + Height = 17 + Top = 445 + Width = 56 + BorderSpacing.Top = 8 + Caption = 'Opacity:' + ParentColor = False + end + object tbOpacity: TTrackBar + AnchorSideLeft.Control = lblOpacity + AnchorSideTop.Control = lblOpacity + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = sgLayers + AnchorSideRight.Side = asrBottom + Left = 5 + Height = 38 + Top = 464 + Width = 259 + Frequency = 10 + Max = 100 + OnChange = tbOpacityChange + PageSize = 5 + Position = 25 + TickMarks = tmBoth + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + TabOrder = 0 + end + object Bevel2: TBevel + AnchorSideLeft.Control = sgLayers + AnchorSideTop.Control = sgLayers + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = sgLayers + AnchorSideRight.Side = asrBottom + Left = 5 + Height = 4 + Top = 322 + Width = 259 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 10 + Shape = bsTopLine + end + object sgLayers: TStringGrid + AnchorSideLeft.Control = pgLayers + AnchorSideTop.Control = pgLayers + AnchorSideRight.Control = pgLayers + AnchorSideRight.Side = asrBottom + Left = 5 + Height = 307 + Top = 5 + Width = 259 + Anchors = [akTop, akLeft, akRight] + AutoFillColumns = True + BorderSpacing.Around = 5 + ColCount = 3 + Columns = < + item + ButtonStyle = cbsCheckboxColumn + SizePriority = 0 + Title.Alignment = taCenter + Title.Caption = 'Visible' + Width = 66 + ValueChecked = '-1' + end + item + ButtonStyle = cbsPickList + Title.Caption = 'Provider' + Width = 156 + end> + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll, goRowHighlight] + RowCount = 11 + TabOrder = 1 + OnCheckboxToggled = sgLayersCheckboxToggled + OnEditingDone = sgLayersEditingDone + OnSelection = sgLayersSelection + ColWidths = ( + 35 + 66 + 156 + ) + Cells = ( + 11 + 0 + 1 + '0' + 0 + 2 + '1' + 0 + 3 + '2' + 0 + 4 + '3' + 0 + 5 + '4' + 0 + 6 + '5' + 0 + 7 + '6' + 0 + 8 + '7' + 0 + 9 + '8' + 0 + 10 + '9' + 1 + 0 + 'Vis' + ) + end + object rgDrawMode: TRadioGroup + AnchorSideLeft.Control = Bevel2 + AnchorSideTop.Control = Bevel2 + AnchorSideRight.Control = Bevel2 + AnchorSideRight.Side = asrBottom + Left = 5 + Height = 105 + Top = 332 + Width = 259 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + BorderSpacing.Top = 10 + Caption = 'Draw Mode' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 86 + ClientWidth = 255 + Items.Strings = ( + 'Opaque' + 'Use Opacity' + 'Tile alpha' + ) + OnSelectionChanged = rgDrawModeSelectionChanged + TabOrder = 2 end end object PgConfig: TTabSheet Caption = 'Config' - ClientHeight = 612 - ClientWidth = 267 + ClientHeight = 627 + ClientWidth = 269 object Label1: TLabel AnchorSideLeft.Control = CbDrawingEngine AnchorSideTop.Control = PgConfig Left = 6 - Height = 15 + Height = 17 Top = 12 - Width = 86 + Width = 106 BorderSpacing.Top = 12 Caption = 'Drawing engine:' + ParentColor = False end object CbDrawingEngine: TComboBox AnchorSideLeft.Control = PgConfig @@ -540,36 +712,37 @@ object MainForm: TMainForm AnchorSideRight.Control = PgConfig AnchorSideRight.Side = asrBottom Left = 6 - Height = 23 - Top = 29 - Width = 255 + Height = 25 + Top = 31 + Width = 257 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 6 BorderSpacing.Top = 2 BorderSpacing.Right = 6 - ItemHeight = 15 + ItemHeight = 0 ItemIndex = 0 Items.Strings = ( 'default' 'RGBGraphics' 'BGRABitmap' ) + OnChange = CbDrawingEngineChange Style = csDropDownList TabOrder = 0 Text = 'default' - OnChange = CbDrawingEngineChange end object LblProviders: TLabel AnchorSideLeft.Control = CbProviders AnchorSideTop.Control = gbProxy AnchorSideTop.Side = asrBottom Left = 6 - Height = 15 - Top = 315 - Width = 52 + Height = 17 + Top = 344 + Width = 69 BorderSpacing.Top = 8 Caption = 'Providers:' FocusControl = CbProviders + ParentColor = False end object CbProviders: TComboBox AnchorSideLeft.Control = PgConfig @@ -577,28 +750,28 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = BtnLoadMapProviders Left = 6 - Height = 23 - Top = 332 - Width = 201 + Height = 29 + Top = 363 + Width = 190 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 6 BorderSpacing.Top = 2 BorderSpacing.Right = 4 DropDownCount = 24 - ItemHeight = 15 + ItemHeight = 0 + OnChange = CbProvidersChange Style = csDropDownList TabOrder = 1 - OnChange = CbProvidersChange end object BtnLoadMapProviders: TSpeedButton AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CbProviders AnchorSideTop.Side = asrCenter AnchorSideRight.Control = BtnSaveMapProviders - Left = 211 - Height = 22 - Top = 332 - Width = 23 + Left = 200 + Height = 26 + Top = 364 + Width = 28 Anchors = [akTop, akRight] BorderSpacing.Right = 4 Glyph.Data = { @@ -646,10 +819,10 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = PgConfig AnchorSideRight.Side = asrBottom - Left = 238 - Height = 22 - Top = 332 - Width = 23 + Left = 232 + Height = 27 + Top = 364 + Width = 31 Anchors = [akTop, akRight] BorderSpacing.Right = 6 Glyph.Data = { @@ -695,71 +868,71 @@ object MainForm: TMainForm AnchorSideTop.Control = CbZoomToCursor AnchorSideTop.Side = asrBottom Left = 6 - Height = 19 - Top = 394 - Width = 79 + Height = 21 + Top = 433 + Width = 103 BorderSpacing.Left = 6 BorderSpacing.Top = 12 Caption = 'Use threads' Checked = True + OnChange = CbUseThreadsChange State = cbChecked TabOrder = 2 - OnChange = CbUseThreadsChange end object CbDoubleBuffer: TCheckBox AnchorSideLeft.Control = CbUseThreads AnchorSideTop.Control = CbUseThreads AnchorSideTop.Side = asrBottom Left = 6 - Height = 19 - Top = 419 - Width = 85 + Height = 21 + Top = 460 + Width = 108 BorderSpacing.Top = 6 BorderSpacing.Right = 9 Caption = 'DblBuffering' Checked = True + OnChange = CbDoubleBufferChange State = cbChecked TabOrder = 3 - OnChange = CbDoubleBufferChange end object CbDebugTiles: TCheckBox AnchorSideLeft.Control = CbDoubleBuffer AnchorSideTop.Control = CbDoubleBuffer AnchorSideTop.Side = asrBottom Left = 6 - Height = 19 - Top = 444 - Width = 77 + Height = 21 + Top = 487 + Width = 98 BorderSpacing.Top = 6 Caption = 'Debug tiles' - TabOrder = 4 OnChange = CbDebugTilesChange + TabOrder = 4 end object CbShowPOIImage: TCheckBox AnchorSideLeft.Control = CbDebugTiles AnchorSideTop.Control = Bevel1 AnchorSideTop.Side = asrBottom Left = 6 - Height = 19 - Top = 481 - Width = 105 + Height = 21 + Top = 526 + Width = 130 BorderSpacing.Top = 6 Caption = 'Show POI image' - TabOrder = 5 OnChange = CbShowPOIImageChange + TabOrder = 5 end object BtnPOITextFont: TButton AnchorSideTop.Control = CbShowPOIImage AnchorSideTop.Side = asrBottom Left = 6 - Height = 25 - Top = 508 - Width = 93 + Height = 27 + Top = 555 + Width = 97 AutoSize = True BorderSpacing.Top = 8 Caption = 'POI text font' - TabOrder = 6 OnClick = BtnPOITextFontClick + TabOrder = 6 end object cbPOITextBgColor: TColorBox AnchorSideLeft.Control = LblPOITextBgColor @@ -768,29 +941,30 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = CbDrawingEngine AnchorSideRight.Side = asrBottom - Left = 154 - Height = 22 - Top = 509 - Width = 107 + Left = 168 + Height = 25 + Top = 556 + Width = 95 NoneColorColor = clWhite Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors] Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 8 ItemHeight = 16 - TabOrder = 7 OnChange = cbPOITextBgColorChange + TabOrder = 7 end object LblPOITextBgColor: TLabel AnchorSideLeft.Control = BtnPOITextFont AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = BtnPOITextFont AnchorSideTop.Side = asrCenter - Left = 107 - Height = 15 - Top = 513 - Width = 39 + Left = 111 + Height = 17 + Top = 560 + Width = 49 BorderSpacing.Left = 8 Caption = 'Backgr.' + ParentColor = False end object Bevel1: TBevel AnchorSideLeft.Control = CbDrawingEngine @@ -800,8 +974,8 @@ object MainForm: TMainForm AnchorSideRight.Side = asrBottom Left = 6 Height = 4 - Top = 471 - Width = 255 + Top = 516 + Width = 257 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 Shape = bsTopLine @@ -811,27 +985,28 @@ object MainForm: TMainForm AnchorSideTop.Control = CbProviders AnchorSideTop.Side = asrBottom Left = 6 - Height = 19 - Top = 363 - Width = 100 + Height = 21 + Top = 400 + Width = 126 BorderSpacing.Left = 6 BorderSpacing.Top = 8 Caption = 'Zoom to cursor' Checked = True + OnChange = CbZoomToCursorChange State = cbChecked TabOrder = 8 - OnChange = CbZoomToCursorChange end object Label2: TLabel AnchorSideLeft.Control = CbDownloadEngine AnchorSideTop.Control = CbDrawingEngine AnchorSideTop.Side = asrBottom Left = 6 - Height = 15 - Top = 60 - Width = 96 + Height = 17 + Top = 64 + Width = 119 BorderSpacing.Top = 8 Caption = 'Download engine:' + ParentColor = False end object CbDownloadEngine: TComboBox AnchorSideLeft.Control = PgConfig @@ -840,14 +1015,14 @@ object MainForm: TMainForm AnchorSideRight.Control = PgConfig AnchorSideRight.Side = asrBottom Left = 6 - Height = 23 - Top = 77 - Width = 255 + Height = 25 + Top = 83 + Width = 257 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 6 BorderSpacing.Top = 2 BorderSpacing.Right = 6 - ItemHeight = 15 + ItemHeight = 0 ItemIndex = 0 Items.Strings = ( 'default' @@ -855,48 +1030,48 @@ object MainForm: TMainForm 'FpHTTPClient' 'WinInet' ) + OnChange = CbDownloadEngineChange Style = csDropDownList TabOrder = 9 Text = 'default' - OnChange = CbDownloadEngineChange end object CbCyclic: TCheckBox AnchorSideLeft.Control = CbZoomToCursor AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CbZoomToCursor - Left = 130 - Height = 19 - Top = 363 - Width = 77 + Left = 156 + Height = 21 + Top = 400 + Width = 94 BorderSpacing.Left = 24 Caption = 'Cyclic view' Checked = True + OnChange = CbCyclicChange State = cbChecked TabOrder = 10 - OnChange = CbCyclicChange end object CbPreviewTiles: TCheckBox AnchorSideLeft.Control = CbCyclic AnchorSideTop.Control = CbUseThreads AnchorSideTop.Side = asrCenter - Left = 130 - Height = 19 - Top = 394 - Width = 83 + Left = 156 + Height = 21 + Top = 433 + Width = 108 Caption = 'Preview tiles' Checked = True + OnChange = CbPreviewTilesChange State = cbChecked TabOrder = 11 - OnChange = CbPreviewTilesChange end object clbBackColor: TColorButton AnchorSideLeft.Control = CbPreviewTiles AnchorSideTop.Control = CbDoubleBuffer AnchorSideTop.Side = asrCenter - Left = 130 - Height = 25 - Top = 416 - Width = 105 + Left = 156 + Height = 30 + Top = 455 + Width = 108 BorderWidth = 2 ButtonColorAutoSize = False ButtonColorSize = 15 @@ -912,27 +1087,28 @@ object MainForm: TMainForm AnchorSideRight.Control = PgConfig AnchorSideRight.Side = asrBottom Left = 6 - Height = 197 - Top = 110 - Width = 255 + Height = 218 + Top = 118 + Width = 257 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 4 BorderSpacing.Around = 6 Caption = 'Proxy' - ClientHeight = 177 - ClientWidth = 251 + ClientHeight = 199 + ClientWidth = 253 TabOrder = 12 object lblProxyHost: TLabel AnchorSideLeft.Control = rbNoProxy AnchorSideTop.Control = edProxyHost AnchorSideTop.Side = asrCenter Left = 28 - Height = 15 - Top = 69 - Width = 28 + Height = 17 + Top = 76 + Width = 36 BorderSpacing.Left = 18 Caption = 'Host:' + ParentColor = False end object edProxyHost: TEdit AnchorSideLeft.Control = edProxyUserName @@ -940,49 +1116,51 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbProxy AnchorSideRight.Side = asrBottom - Left = 95 - Height = 23 - Top = 65 - Width = 148 + Left = 111 + Height = 27 + Top = 71 + Width = 134 Anchors = [akTop, akLeft, akRight] BorderSpacing.Right = 8 - TabOrder = 0 OnChange = rbProxyChange + TabOrder = 0 end object lblProxyPort: TLabel AnchorSideLeft.Control = lblProxyHost AnchorSideTop.Control = seProxyPort AnchorSideTop.Side = asrCenter Left = 28 - Height = 15 - Top = 96 - Width = 22 + Height = 17 + Top = 107 + Width = 30 Caption = 'Port' + ParentColor = False end object seProxyPort: TSpinEdit AnchorSideLeft.Control = lblProxyUserName AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = edProxyHost AnchorSideTop.Side = asrBottom - Left = 95 - Height = 23 - Top = 92 + Left = 111 + Height = 27 + Top = 102 Width = 104 BorderSpacing.Top = 4 MaxValue = 65535 - TabOrder = 1 OnChange = rbProxyChange + TabOrder = 1 end object lblProxyUserName: TLabel AnchorSideLeft.Control = lblProxyHost AnchorSideTop.Control = edProxyUserName AnchorSideTop.Side = asrCenter Left = 28 - Height = 15 - Top = 123 - Width = 59 + Height = 17 + Top = 138 + Width = 75 BorderSpacing.Right = 8 Caption = 'User name:' + ParentColor = False end object edProxyUserName: TEdit AnchorSideLeft.Control = lblProxyUserName @@ -991,25 +1169,26 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbProxy AnchorSideRight.Side = asrBottom - Left = 95 - Height = 23 - Top = 119 - Width = 148 + Left = 111 + Height = 27 + Top = 133 + Width = 134 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 8 - TabOrder = 2 OnChange = rbProxyChange + TabOrder = 2 end object lblProxyPassword: TLabel AnchorSideLeft.Control = lblProxyHost AnchorSideTop.Control = edProxyPassword AnchorSideTop.Side = asrCenter Left = 28 - Height = 15 - Top = 150 - Width = 50 + Height = 17 + Top = 169 + Width = 66 Caption = 'Password' + ParentColor = False end object edProxyPassword: TEdit AnchorSideLeft.Control = edProxyUserName @@ -1017,57 +1196,57 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = gbProxy AnchorSideRight.Side = asrBottom - Left = 95 - Height = 23 - Top = 146 - Width = 148 + Left = 111 + Height = 27 + Top = 164 + Width = 134 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 8 BorderSpacing.Bottom = 8 - TabOrder = 3 OnChange = rbProxyChange + TabOrder = 3 end object rbNoProxy: TRadioButton AnchorSideLeft.Control = gbProxy AnchorSideTop.Control = gbProxy Left = 10 - Height = 19 + Height = 21 Top = 0 - Width = 67 + Width = 85 BorderSpacing.Left = 10 Caption = 'No proxy' - TabOrder = 4 OnChange = rbProxyChange + TabOrder = 4 end object rbSystemProxy: TRadioButton AnchorSideLeft.Control = rbNoProxy AnchorSideTop.Control = rbNoProxy AnchorSideTop.Side = asrBottom Left = 10 - Height = 19 - Top = 23 - Width = 110 + Height = 21 + Top = 25 + Width = 141 BorderSpacing.Top = 4 Caption = 'Use system proxy' Checked = True Enabled = False + OnChange = rbProxyChange TabOrder = 5 TabStop = True - OnChange = rbProxyChange end object rbProxyData: TRadioButton AnchorSideLeft.Control = rbNoProxy AnchorSideTop.Control = rbSystemProxy AnchorSideTop.Side = asrBottom Left = 10 - Height = 19 - Top = 46 - Width = 74 + Height = 21 + Top = 50 + Width = 96 BorderSpacing.Top = 4 Caption = 'Proxy data' - TabOrder = 6 OnChange = rbProxyChange + TabOrder = 6 end end end @@ -1087,6 +1266,6 @@ object MainForm: TMainForm MinFontSize = 0 MaxFontSize = 0 Left = 800 - Top = 472 + Top = 528 end end diff --git a/components/lazmapviewer/examples/fulldemo_with_addons/main.pas b/components/lazmapviewer/examples/fulldemo_with_addons/main.pas index 66fcec966..73b63df6e 100644 --- a/components/lazmapviewer/examples/fulldemo_with_addons/main.pas +++ b/components/lazmapviewer/examples/fulldemo_with_addons/main.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, - ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin, + ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin, Grids, mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine, mvDE_RGBGraphics, mvDE_BGRA, mvDLEFPC, mvDLEWin, mvDLESynapse; @@ -16,6 +16,7 @@ type TMainForm = class(TForm) Bevel1: TBevel; + Bevel2: TBevel; BtnSearch: TButton; BtnGoTo: TButton; BtnGPSPoints: TButton; @@ -27,6 +28,8 @@ type CbFoundLocations: TComboBox; CbLocations: TComboBox; CbProviders: TComboBox; + lblOpacity: TLabel; + rgDrawMode: TRadioGroup; rbProxyData: TRadioButton; rbSystemProxy: TRadioButton; CbUseThreads: TCheckBox; @@ -83,6 +86,9 @@ type PgConfig: TTabSheet; rbNoProxy: TRadioButton; seProxyPort: TSpinEdit; + pgLayers: TTabSheet; + sgLayers: TStringGrid; + tbOpacity: TTrackBar; ZoomTrackBar: TTrackBar; procedure BtnGoToClick(Sender: TObject); procedure BtnLoadGPXFileClick(Sender: TObject); @@ -121,6 +127,13 @@ type procedure BtnLoadMapProvidersClick(Sender: TObject); procedure BtnSaveMapProvidersClick(Sender: TObject); procedure rbProxyChange(Sender: TObject); + procedure rgDrawModeSelectionChanged(Sender: TObject); + procedure sgLayersCheckboxToggled(Sender: TObject; aCol, aRow: Integer; + aState: TCheckboxState); + procedure sgLayersEditingDone(Sender: TObject); + procedure sgLayersSelection(Sender: TObject; aCol, aRow: Integer); + procedure tbOpacityChange(Sender: TObject); + procedure UpdateLayers; procedure ZoomTrackBarChange(Sender: TObject); private @@ -167,9 +180,11 @@ const MAX_LOCATIONS_HISTORY = 50; MAP_PROVIDER_FILENAME = 'map-providers.xml'; USE_DMS = true; + _TILELAYERS_ID_ = 42; var PointFormatSettings: TFormatsettings; + TileLayer: array[0..9] of TGPSTileLayer; function CalcIniName: String; @@ -177,7 +192,6 @@ begin Result := ChangeFileExt(Application.ExeName, '.ini'); end; - { TMainForm } procedure TMainForm.BtnLoadMapProvidersClick(Sender: TObject); @@ -191,6 +205,7 @@ begin MapView.GetMapProviders(CbProviders.Items); CbProviders.ItemIndex := 0; MapView.MapProvider := CbProviders.Text; + sgLayers.Columns[1].PickList.Assign(CbProviders.Items); end else ShowMessage(msg); end; @@ -206,6 +221,53 @@ begin UpdateDownloadEngineProxy; end; +procedure TMainForm.rgDrawModeSelectionChanged(Sender: TObject); +begin + TileLayer[Pred(sgLayers.Row)].DrawMode := TItemDrawMode(rgDrawMode.ItemIndex); + MapView.Redraw; +end; + +procedure TMainForm.sgLayersCheckboxToggled(Sender: TObject; aCol, + aRow: Integer; aState: TCheckboxState); +begin + TileLayer[Pred(sgLayers.Row)].Visible := (aState = cbChecked); + MapView.Redraw; +end; + +procedure TMainForm.sgLayersEditingDone(Sender: TObject); +var + S: String; +begin + if sgLayers.Col <> 2 then + Exit; + S := sgLayers.Cells[sgLayers.Col, sgLayers.Row]; + TileLayer[Pred(sgLayers.Row)].MapProvider := S; + sgLayers.Cells[sgLayers.Col, sgLayers.Row] := S; + MapView.Redraw; +end; + +procedure TMainForm.sgLayersSelection(Sender: TObject; aCol, aRow: Integer); +begin + rgDrawMode.ItemIndex := Ord(TileLayer[Pred(ARow)].DrawMode); + tbOpacity.Position := Round(TileLayer[Pred(ARow)].Opacity * 100); +end; + +procedure TMainForm.tbOpacityChange(Sender: TObject); +begin + TileLayer[Pred(sgLayers.Row)].Opacity := tbOpacity.Position / 100; + MapView.Redraw; +end; + +procedure TMainForm.UpdateLayers; +var + TL: TGPSTileLayer; +begin + // Notify tile layers for drawing engine change, it must be done implicitly + // but there is no other mechanism for now + for TL in TileLayer do + TL.ParentViewChanged; +end; + procedure TMainForm.BtnSearchClick(Sender: TObject); begin ClearFoundLocations; @@ -284,6 +346,7 @@ end; procedure TMainForm.CbDebugTilesChange(Sender: TObject); begin MapView.DebugTiles := CbDebugTiles.Checked; + MapView.Invalidate; end; procedure TMainForm.CbDownloadEngineChange(Sender: TObject); @@ -328,6 +391,7 @@ begin MapView.DrawingEngine := FBGRADrawingEngine; end; end; + UpdateLayers; end; procedure TMainForm.CbDoubleBufferChange(Sender: TObject); @@ -390,6 +454,7 @@ end; procedure TMainForm.CbUseThreadsChange(Sender: TObject); begin MapView.UseThreads := CbUseThreads.Checked; + UpdateLayers; end; procedure TMainForm.CbDistanceUnitsChange(Sender: TObject); @@ -406,6 +471,7 @@ end; procedure TMainForm.CbCyclicChange(Sender: TObject); begin MapView.Cyclic := CbCyclic.Checked; + UpdateLayers; end; procedure TMainForm.clbBackColorColorChanged(Sender: TObject); @@ -430,6 +496,7 @@ var fn: String; homeDir: String; cacheDir: String; + I: Integer; begin cInputQueryEditSizePercents := 0; @@ -454,6 +521,7 @@ begin end; MapView.CachePath := cacheDir; MapView.GetMapProviders(CbProviders.Items); + sgLayers.Columns[1].PickList.Assign(CbProviders.Items); CbProviders.ItemIndex := CbProviders.Items.IndexOf(MapView.MapProvider); MapView.DoubleBuffered := true; MapView.Zoom := 1; @@ -471,10 +539,34 @@ begin InfoViewportHeight.Caption := ''; GPSPointInfo.Caption := ''; + for I := 0 to High(TileLayer) do + begin + TileLayer[I] := TGPSTileLayer.Create; + with TileLayer[I] do + begin + Visible := False; + UseThreads := MapView.UseThreads; + DrawMode := idmUseOpacity; + Opacity := 0.25; + case I of + 0: MapProvider := 'Google Satellite Only'; + 1: MapProvider := 'Google Terrain'; + 2: MapProvider := 'Maps For Free'; + otherwise + MapProvider := ''; + end; + end; + sgLayers.Cells[1, I + 1] := TileLayer[I].Visible.ToString; + sgLayers.Cells[2, I + 1] := TileLayer[I].MapProvider; + MapView.GPSLayer[I].Add(TileLayer[I], _TILELAYERS_ID_); + end; + ReadFromIni; end; procedure TMainForm.FormDestroy(Sender: TObject); +var + I: Integer; begin WriteToIni; ClearFoundLocations; @@ -629,6 +721,7 @@ begin MapView.Engine.ClearMapProviders; MapView.Engine.RegisterProviders; MapView.GetMapProviders(CbProviders.Items); + sgLayers.Columns[1].PickList.Assign(CbProviders.Items); end; R := Screen.DesktopRect; diff --git a/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas b/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas index 74cd6fada..bcfe767db 100644 --- a/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas +++ b/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas @@ -69,7 +69,6 @@ type procedure SetFontStyle(AValue: TFontStyles); override; procedure SetPenColor(AValue: TColor); override; procedure SetPenWidth(AValue: Integer); override; - public destructor Destroy; override; procedure CreateBuffer(AWidth, AHeight: Integer); override; diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 7da6f9bc7..8f887b853 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -36,6 +36,8 @@ type TDrawStretchedTileEvent = procedure (const TileId: TTileId; X,Y: Integer; TileImg: TPictureCacheItem; const R: TRect) of object; + TEraseBackgroundEvent = procedure (const R: TRect) of Object; + TTileDownloadedEvent = procedure (const TileId: TTileId) of object; TTileIdArray = Array of TTileId; @@ -74,6 +76,7 @@ type FOnChange: TNotifyEvent; FOnDrawTile: TDrawTileEvent; FOnDrawStretchedTile: TDrawStretchedTileEvent; + FOnEraseBackground: TEraseBackgroundEvent; FOnTileDownloaded: TTileDownloadedEvent; FOnZoomChange: TNotifyEvent; lstProvider : TStringList; @@ -123,6 +126,7 @@ type function GetTileName(const Id: TTileId): String; procedure evDownload(Data: TObject; Job: TJob); procedure TileDownloaded(Data: PtrInt); + procedure EraseBackground(const R: TRect); procedure DrawTileFromCache(constref ATile: TTileId; constref AWin: TMapWindow); procedure DrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TPictureCacheItem; const R: TRect); Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TPictureCacheItem); @@ -194,6 +198,7 @@ type property OnChange: TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change property OnDrawStretchedTile: TDrawStretchedTileEvent read FOnDrawStretchedTile write FOnDrawStretchedTile; property OnDrawTile: TDrawTileEvent read FOnDrawTile write FOnDrawTile; + property OnEraseBackground: TEraseBackgroundEvent read FOnEraseBackground write FOnEraseBackground; property OnTileDownloaded: TTileDownloadedEvent read FOnTileDownloaded write FOnTileDownloaded; property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange; end; @@ -357,25 +362,25 @@ function TMapViewerEngine.CalculateVisibleTiles(const aWin: TMapWindow; out Area: TArea): Boolean; var MaxX, MaxY, startX, startY: int64; - WorldSize: Int64; + WorldMax: Int64; begin Area := Default(TArea); - Result := True; - WorldSize := 1 shl AWin.Zoom; + Result := (aWin.X <= 0) and (aWin.Y <= 0); + WorldMax := 1 shl AWin.Zoom - 1; MaxX := Int64(aWin.Width) div TILE_SIZE + 1; MaxY := Int64(aWin.Height) div TILE_SIZE + 1; - if (MaxX > WorldSize) or (MaxY > WorldSize) then + if (MaxX > WorldMax) or (MaxY > WorldMax) then begin Result := False; - MaxX := Min(WorldSize - 1, MaxX); - MaxY := Min(WorldSize - 1, MaxY); + MaxX := Min(WorldMax, MaxX); + MaxY := Min(WorldMax, MaxY); end; startX := -aWin.X div TILE_SIZE; startY := -aWin.Y div TILE_SIZE; if (startX < 0) or (startY < 0) then begin - startX := Max(0, -aWin.X div TILE_SIZE); - startY := Max(0, -aWin.Y div TILE_SIZE); + startX := Max(0, startX); + startY := Max(0, startY); Result := False; end; Area.Left := startX; @@ -1025,13 +1030,27 @@ var end; end; - procedure EraseBackground; + procedure EraseAround; var - I, J: Integer; + T, L, B, R: Integer; begin - for J := 0 to (AWin.Height div TILE_SIZE) + 1 do - for I := 0 to (AWin.Width div TILE_SIZE) + 1 do - DrawTile(tile, I * TILE_SIZE, J * TILE_SIZE, Nil); + T := -AWin.Y div TILE_SIZE - Max(0, Sign(AWin.Y)); + B := T + AWin.Height div TILE_SIZE + 1; + L := -AWin.X div TILE_SIZE - Max(0, Sign(AWin.X)); + R := L + AWin.Width div TILE_SIZE + 1; + if T < TilesVis.top then // Erase above top + EraseBackground(Rect(0, 0, AWin.Width, AWin.Y + TilesVis.top * TILE_SIZE)); + if L < TilesVis.left then // Erase on the left + EraseBackground(Rect(0, AWin.Y + TilesVis.top * TILE_SIZE, + AWin.X + TilesVis.left * TILE_SIZE, + AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE)); + if R > TilesVis.right then // Erase on the right + EraseBackground(Rect(AWin.X + (TilesVis.right + 1) * TILE_SIZE, + AWin.Y + TilesVis.top * TILE_SIZE, AWin.Width, + AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE)); + if B > TilesVis.bottom then // Erase below + EraseBackground(Rect(0, AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE, + AWin.Width, AWin.Height)); end; begin @@ -1039,7 +1058,7 @@ begin Exit; if not CalculateVisibleTiles(AWin, TilesVis) then - EraseBackground; + EraseAround; SetLength(Tiles, (TilesVis.Bottom - TilesVis.Top + 1) * (TilesVis.Right - TilesVis.Left + 1)); iTile := Low(Tiles); numTiles := 1 shl AWin.Zoom; @@ -1273,6 +1292,12 @@ begin end; end; +procedure TMapViewerEngine.EraseBackground(const R: TRect); +begin + if Assigned(FOnEraseBackground) then + FOnEraseBackground(R); +end; + procedure TMapViewerEngine.DrawTileFromCache(constref ATile: TTileId; constref AWin: TMapWindow); var diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 565af7ccd..b480bd307 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -111,6 +111,7 @@ Type procedure DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TPictureCacheItem; const R: TRect); procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TPictureCacheItem); procedure DoDrawTileInfo(const {%H-}TileID: TTileID; X,Y: Integer); + procedure DoEraseBackground(const R: TRect); procedure DoTileDownloaded(const TileId: TTileId); function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; @@ -713,20 +714,35 @@ begin end; procedure TMapView.Paint; -begin - inherited Paint; - if IsActive then - begin - Engine.Redraw; - DrawObjects(Default(TTileId), 0, 0, Canvas.Width, Canvas.Height); - DrawingEngine.PaintToCanvas(Canvas); - end - else + + procedure Inactive; begin Canvas.Brush.Color := InactiveColor; Canvas.Brush.Style := bsSolid; Canvas.FillRect(0, 0, ClientWidth, ClientHeight); end; + + procedure Redrw; + begin + Engine.Redraw; + DrawObjects(Default(TTileId), 0, 0, Canvas.Width, Canvas.Height); + DrawingEngine.PaintToCanvas(Canvas); + end; + + procedure Drag; + begin + // Placeholder for dragging visuals + Redrw; + end; + +begin + inherited Paint; + if IsActive + then if Engine.InDrag + then Drag + else Redrw + else + Inactive; end; procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList; @@ -1010,6 +1026,11 @@ begin DrawingEngine.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE); end; +procedure TMapView.DoEraseBackground(const R: TRect); +begin + DrawingEngine.FillPixels(R.Left, R.Top, R.Right, R.Bottom, InactiveColor); +end; + procedure TMapView.DoTileDownloaded(const TileId: TTileId); begin // TODO: Include tile information to optimize redraw. @@ -1055,6 +1076,7 @@ begin FEngine.CacheOnDisk := true; FEngine.OnDrawTile := @DoDrawTile; FEngine.OnDrawStretchedTile := @DoDrawStretchedTile; + FEngine.OnEraseBackground := @DoEraseBackground; FEngine.OnTileDownloaded := @DoTileDownloaded; FEngine.DrawPreviewTiles := True; FEngine.DrawTitleInGuiThread := false;