pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazMapViewer: Initial version of a LCL drawing engine. Still buggy. Extend demo project to allow selection of drawing engines.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6924 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-18 17:10:33 +00:00
parent 330ea06238
commit 0418e4b8d4
5 changed files with 777 additions and 764 deletions
Download Patch File Download Diff File Expand all files Collapse all files

791
components/lazmapviewer/example/main.lfm
View File

@ -11,133 +11,103 @@ object MainForm: TMainForm
OnShow = FormShow
ShowHint = True
LCLVersion = '2.1.0.0'
object ControlPanel: TPanel
Left = 606
object MapView: TMapView
Left = 0
Height = 640
Hint = 'Displays the map'
Top = 0
Width = 608
Active = False
Align = alClient
CacheOnDisk = True
CachePath = 'cache/'
DefaultTrackColor = clBlue
DefaultTrackWidth = 3
DownloadEngine = MapView.BuiltInDLE
DrawingEngine = MapView.BuiltInDE
InactiveColor = clWhite
MapProvider = 'OpenStreetMap Mapnik'
UseThreads = True
Zoom = 0
OnZoomChange = MapViewZoomChange
OnChange = MapViewChange
OnDrawGpsPoint = MapViewDrawGpsPoint
OnMouseLeave = MapViewMouseLeave
OnMouseMove = MapViewMouseMove
OnMouseUp = MapViewMouseUp
end
object PageControl: TPageControl
Left = 608
Height = 640
Top = 0
Width = 277
Width = 275
ActivePage = PgData
Align = alRight
ClientHeight = 640
ClientWidth = 277
TabIndex = 0
TabOrder = 1
object CbProviders: TComboBox
AnchorSideLeft.Control = LblProviders
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = ControlPanel
AnchorSideRight.Control = BtnLoadMapProviders
Left = 69
Height = 23
Top = 9
Width = 145
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 4
DropDownCount = 24
ItemHeight = 15
OnChange = CbProvidersChange
Style = csDropDownList
TabOrder = 0
end
object LblProviders: TLabel
AnchorSideLeft.Control = ControlPanel
AnchorSideTop.Control = CbProviders
AnchorSideTop.Side = asrCenter
Left = 9
Height = 15
Top = 13
Width = 52
BorderSpacing.Left = 8
Caption = 'Providers:'
FocusControl = CbProviders
ParentColor = False
end
object CbUseThreads: TCheckBox
AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = CbDoubleBuffer
Left = 9
Height = 19
Top = 40
Width = 62
Caption = 'Threads'
Checked = True
OnChange = CbUseThreadsChange
State = cbChecked
TabOrder = 1
end
object CbDoubleBuffer: TCheckBox
AnchorSideLeft.Control = CbUseThreads
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbProviders
AnchorSideTop.Side = asrBottom
Left = 87
Height = 19
Top = 40
Width = 87
BorderSpacing.Left = 16
BorderSpacing.Top = 8
BorderSpacing.Right = 9
Caption = 'DblBuffering'
Checked = True
OnChange = CbDoubleBufferChange
State = cbChecked
TabOrder = 2
end
object PgData: TTabSheet
Caption = 'Data'
ClientHeight = 612
ClientWidth = 267
object ZoomTrackBar: TTrackBar
AnchorSideLeft.Control = CbProviders
AnchorSideTop.Control = CbDoubleBuffer
AnchorSideLeft.Control = PgData
AnchorSideTop.Control = LblZoom
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ControlPanel
AnchorSideRight.Control = PgData
AnchorSideRight.Side = asrBottom
Left = 69
Left = 2
Height = 40
Top = 59
Width = 207
Top = 21
Width = 263
Max = 19
Min = 1
OnChange = ZoomTrackBarChange
Position = 1
TickMarks = tmBoth
Anchors = [akTop, akLeft, akRight]
TabOrder = 3
BorderSpacing.Left = 2
BorderSpacing.Right = 2
TabOrder = 0
end
object LblZoom: TLabel
AnchorSideLeft.Control = ControlPanel
AnchorSideTop.Control = ZoomTrackBar
AnchorSideTop.Side = asrCenter
Left = 9
AnchorSideLeft.Control = PgData
AnchorSideTop.Control = PgData
Left = 6
Height = 15
Top = 72
Top = 6
Width = 35
BorderSpacing.Left = 8
BorderSpacing.Left = 6
BorderSpacing.Top = 6
Caption = 'Zoom:'
ParentColor = False
end
object CbMouseCoords: TGroupBox
AnchorSideLeft.Control = LblProviders
AnchorSideLeft.Control = PgData
AnchorSideTop.Control = ZoomTrackBar
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnSaveMapProviders
AnchorSideRight.Control = PgData
AnchorSideRight.Side = asrBottom
Left = 9
Left = 6
Height = 66
Top = 107
Width = 259
Top = 69
Width = 255
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Top = 8
BorderSpacing.Right = 6
Caption = 'Mouse position'
ClientHeight = 46
ClientWidth = 255
TabOrder = 4
ClientWidth = 251
TabOrder = 1
object LblPositionLongitude: TLabel
AnchorSideLeft.Control = CbMouseCoords
AnchorSideTop.Control = CbMouseCoords
Left = 16
Left = 8
Height = 15
Top = 4
Width = 54
BorderSpacing.Left = 16
BorderSpacing.Left = 8
BorderSpacing.Top = 4
Caption = 'Longitude'
ParentColor = False
@ -146,11 +116,11 @@ object MainForm: TMainForm
AnchorSideLeft.Control = CbMouseCoords
AnchorSideTop.Control = LblPositionLongitude
AnchorSideTop.Side = asrBottom
Left = 16
Left = 8
Height = 15
Top = 23
Width = 43
BorderSpacing.Left = 16
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Latitude'
@ -161,7 +131,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = CbMouseCoords
AnchorSideRight.Control = CbMouseCoords
AnchorSideRight.Side = asrBottom
Left = 205
Left = 201
Height = 15
Top = 4
Width = 34
@ -178,7 +148,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CbMouseCoords
AnchorSideRight.Side = asrBottom
Left = 205
Left = 201
Height = 15
Top = 23
Width = 34
@ -192,30 +162,30 @@ object MainForm: TMainForm
end
end
object GbCenterCoords: TGroupBox
AnchorSideLeft.Control = LblProviders
AnchorSideLeft.Control = LblZoom
AnchorSideTop.Control = CbMouseCoords
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CbMouseCoords
AnchorSideRight.Side = asrBottom
Left = 9
Left = 6
Height = 66
Top = 181
Width = 259
Top = 143
Width = 255
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Center'
ClientHeight = 46
ClientWidth = 255
TabOrder = 5
ClientWidth = 251
TabOrder = 2
object LblCenterLongitude: TLabel
AnchorSideLeft.Control = GbCenterCoords
AnchorSideTop.Control = GbCenterCoords
Left = 16
Left = 8
Height = 15
Top = 4
Width = 54
BorderSpacing.Left = 16
BorderSpacing.Left = 8
BorderSpacing.Top = 4
Caption = 'Longitude'
ParentColor = False
@ -224,11 +194,11 @@ object MainForm: TMainForm
AnchorSideLeft.Control = GbCenterCoords
AnchorSideTop.Control = LblCenterLongitude
AnchorSideTop.Side = asrBottom
Left = 16
Left = 8
Height = 15
Top = 23
Width = 43
BorderSpacing.Left = 16
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Latitude'
@ -239,7 +209,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = GbCenterCoords
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 205
Left = 201
Height = 15
Top = 4
Width = 34
@ -256,7 +226,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 205
Left = 201
Height = 15
Top = 23
Width = 34
@ -269,69 +239,166 @@ object MainForm: TMainForm
ParentColor = False
end
end
object CbLocations: TComboBox
AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = BtnSearch
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = BtnSearch
Left = 9
Height = 23
Top = 334
Width = 190
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 8
BorderSpacing.Bottom = 4
DropDownCount = 24
ItemHeight = 15
TabOrder = 6
Text = 'New York'
end
object BtnSearch: TButton
AnchorSideTop.Control = GbScreenSize
object GbScreenSize: TGroupBox
AnchorSideLeft.Control = GbCenterCoords
AnchorSideTop.Control = GbCenterCoords
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 207
Left = 6
Height = 66
Top = 217
Width = 255
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Viewport size'
ClientHeight = 46
ClientWidth = 251
TabOrder = 3
object LblViewportWidth: TLabel
AnchorSideLeft.Control = GbScreenSize
AnchorSideTop.Control = GbScreenSize
Left = 8
Height = 15
Top = 4
Width = 32
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
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
Top = 4
Width = 34
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
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 16
BorderSpacing.Bottom = 8
Caption = 'Label2'
ParentColor = False
end
end
object CbDistanceUnits: TComboBox
AnchorSideTop.Control = GbCenterCoords
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 189
Height = 23
Top = 215
Width = 64
Anchors = [akTop, akRight]
BorderSpacing.Top = 6
BorderSpacing.Right = 8
ItemHeight = 15
ItemIndex = 1
Items.Strings = (
'm'
'km'
'miles'
)
OnChange = CbDistanceUnitsChange
Style = csDropDownList
TabOrder = 4
Text = 'km'
end
object GbSearch: TGroupBox
AnchorSideLeft.Control = GbScreenSize
AnchorSideTop.Control = GbScreenSize
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbScreenSize
AnchorSideRight.Side = asrBottom
Left = 6
Height = 105
Top = 291
Width = 255
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Search'
ClientHeight = 85
ClientWidth = 251
TabOrder = 5
object CbLocations: TComboBox
AnchorSideLeft.Control = GbSearch
AnchorSideTop.Control = GbSearch
AnchorSideRight.Control = BtnSearch
Left = 8
Height = 23
Top = 4
Width = 172
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
DropDownCount = 24
ItemHeight = 15
TabOrder = 0
Text = 'New York'
end
object BtnSearch: TButton
AnchorSideTop.Control = CbLocations
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = GbSearch
AnchorSideRight.Side = asrBottom
Left = 184
Height = 25
Top = 333
Top = 3
Width = 61
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Top = 12
BorderSpacing.Right = 6
Caption = 'Search'
OnClick = BtnSearchClick
TabOrder = 7
TabOrder = 1
end
object CbFoundLocations: TComboBox
AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = Label8
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnGoTo
Left = 9
Height = 21
Top = 388
Width = 196
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 8
DropDownCount = 24
ItemHeight = 15
ItemWidth = -2
OnDrawItem = CbFoundLocationsDrawItem
ParentShowHint = False
ShowHint = True
Style = csOwnerDrawFixed
TabOrder = 8
end
object Label8: TLabel
AnchorSideLeft.Control = LblProviders
object LblSelectLocation: TLabel
AnchorSideLeft.Control = CbLocations
AnchorSideTop.Control = CbLocations
AnchorSideTop.Side = asrBottom
Left = 9
Left = 8
Height = 15
Top = 369
Top = 35
Width = 177
BorderSpacing.Top = 12
BorderSpacing.Top = 8
Caption = 'Select one of the found locations:'
ParentColor = False
end
@ -340,71 +407,218 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = BtnSearch
AnchorSideRight.Side = asrBottom
Left = 213
Left = 190
Height = 25
Top = 386
Top = 52
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Bottom = 8
Caption = 'Go to'
OnClick = BtnGoToClick
TabOrder = 9
TabOrder = 2
end
object InfoBtnGPSPoints: TLabel
AnchorSideLeft.Control = BtnGPSPoints
AnchorSideTop.Control = BtnGPSPoints
object CbFoundLocations: TComboBox
AnchorSideLeft.Control = LblSelectLocation
AnchorSideTop.Control = LblSelectLocation
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnGoTo
AnchorSideRight.Side = asrBottom
Left = 9
Height = 52
Top = 483
Width = 259
Left = 8
Height = 21
Top = 54
Width = 178
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 8
DropDownCount = 24
ItemHeight = 15
ItemWidth = -2
OnDrawItem = CbFoundLocationsDrawItem
ParentShowHint = False
ShowHint = True
Style = csOwnerDrawFixed
TabOrder = 3
end
end
object GbGPS: TGroupBox
AnchorSideLeft.Control = GbSearch
AnchorSideTop.Control = GbSearch
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbSearch
AnchorSideRight.Side = asrBottom
Left = 6
Height = 105
Top = 404
Width = 255
Anchors = [akTop, akLeft, akRight]
AutoSize = False
BorderSpacing.Top = 8
Caption = 'GPS points'
ClientHeight = 85
ClientWidth = 251
TabOrder = 6
object BtnGPSPoints: TButton
AnchorSideLeft.Control = GbGPS
AnchorSideTop.Control = GbGPS
AnchorSideRight.Control = GbGPS
AnchorSideRight.Side = asrBottom
Left = 192
Height = 25
Top = 0
Width = 53
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Caption = 'List...'
OnClick = BtnGPSPointsClick
TabOrder = 0
end
object InfoBtnGPSPoints: TLabel
AnchorSideLeft.Control = GbGPS
AnchorSideTop.Control = BtnGPSPoints
AnchorSideRight.Control = BtnGPSPoints
Left = 8
Height = 30
Top = 4
Width = 178
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 BtnGPSPoints: TButton
AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = BtnSaveToFile
AnchorSideTop.Side = asrBottom
Left = 9
Height = 25
Top = 450
Width = 92
AutoSize = True
BorderSpacing.Top = 8
Caption = 'GPS points...'
OnClick = BtnGPSPointsClick
TabOrder = 10
end
object GPSPointInfo: TLabel
AnchorSideLeft.Control = InfoBtnGPSPoints
AnchorSideTop.Control = InfoBtnGPSPoints
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = InfoBtnGPSPoints
AnchorSideRight.Control = GbGPS
AnchorSideRight.Side = asrBottom
Left = 9
Height = 64
Top = 535
Width = 259
Anchors = [akTop, akLeft, akRight]
AnchorSideBottom.Control = GbGPS
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 35
Top = 50
Width = 237
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = False
BorderSpacing.Top = 16
BorderSpacing.Right = 6
Caption = 'GPSPointInfo'
ParentColor = False
WordWrap = True
end
end
object BtnSaveToFile: TButton
AnchorSideLeft.Control = GbGPS
AnchorSideTop.Control = GbGPS
AnchorSideTop.Side = asrBottom
Left = 6
Height = 25
Top = 517
Width = 110
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Save map to file'
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
AutoSize = True
BorderSpacing.Left = 8
Caption = 'Load GPX file...'
OnClick = BtnLoadGPXFileClick
TabOrder = 8
end
end
object PgConfig: TTabSheet
Caption = 'Config'
ClientHeight = 612
ClientWidth = 267
object Label1: TLabel
AnchorSideLeft.Control = CbDrawingEngine
AnchorSideTop.Control = PgConfig
Left = 6
Height = 15
Top = 6
Width = 86
BorderSpacing.Top = 6
Caption = 'Drawing engine:'
ParentColor = False
end
object CbDrawingEngine: TComboBox
AnchorSideLeft.Control = PgConfig
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PgConfig
AnchorSideRight.Side = asrBottom
Left = 6
Height = 23
Top = 23
Width = 255
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 2
BorderSpacing.Right = 6
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'default'
'LCL'
)
OnChange = CbDrawingEngineChange
Style = csDropDownList
TabOrder = 0
Text = 'default'
end
object LblProviders: TLabel
AnchorSideLeft.Control = CbProviders
AnchorSideTop.Control = CbDrawingEngine
AnchorSideTop.Side = asrBottom
Left = 6
Height = 15
Top = 54
Width = 52
BorderSpacing.Top = 8
Caption = 'Providers:'
FocusControl = CbProviders
ParentColor = False
end
object CbProviders: TComboBox
AnchorSideLeft.Control = PgConfig
AnchorSideTop.Control = LblProviders
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnLoadMapProviders
Left = 6
Height = 23
Top = 71
Width = 199
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 2
BorderSpacing.Right = 4
DropDownCount = 24
ItemHeight = 15
OnChange = CbProvidersChange
Style = csDropDownList
TabOrder = 1
end
object BtnLoadMapProviders: TSpeedButton
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbProviders
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = BtnSaveMapProviders
Left = 218
Left = 209
Height = 22
Top = 9
Top = 71
Width = 23
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -451,11 +665,11 @@ object MainForm: TMainForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbProviders
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = ControlPanel
AnchorSideRight.Control = PgConfig
AnchorSideRight.Side = asrBottom
Left = 245
Left = 236
Height = 22
Top = 9
Top = 71
Width = 23
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
@ -497,181 +711,62 @@ object MainForm: TMainForm
}
OnClick = BtnSaveMapProvidersClick
end
object BtnSaveToFile: TButton
AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = CbFoundLocations
object CbUseThreads: TCheckBox
AnchorSideLeft.Control = PgConfig
AnchorSideTop.Control = CbProviders
AnchorSideTop.Side = asrBottom
Left = 9
Height = 25
Top = 417
Width = 110
AutoSize = True
Left = 6
Height = 19
Top = 102
Width = 81
BorderSpacing.Left = 6
BorderSpacing.Top = 8
Caption = 'Save map to file'
OnClick = BtnSaveToFileClick
TabOrder = 11
Caption = 'Use threads'
Checked = True
OnChange = CbUseThreadsChange
State = cbChecked
TabOrder = 2
end
object GbScreenSize: TGroupBox
AnchorSideLeft.Control = GbCenterCoords
AnchorSideTop.Control = GbCenterCoords
object CbDoubleBuffer: TCheckBox
AnchorSideLeft.Control = CbUseThreads
AnchorSideTop.Control = CbUseThreads
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 9
Height = 66
Top = 255
Width = 259
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Viewport size'
ClientHeight = 46
ClientWidth = 255
TabOrder = 12
object LblViewportWidth: TLabel
AnchorSideLeft.Control = GbScreenSize
AnchorSideTop.Control = GbScreenSize
Left = 16
Height = 15
Top = 4
Width = 32
BorderSpacing.Left = 16
BorderSpacing.Top = 4
Caption = 'Width'
ParentColor = False
end
object LblViewportHeight: TLabel
AnchorSideLeft.Control = GbScreenSize
AnchorSideTop.Control = LblViewportWidth
AnchorSideTop.Side = asrBottom
Left = 16
Height = 15
Top = 23
Width = 36
BorderSpacing.Left = 16
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Height'
ParentColor = False
end
object InfoViewportWidth: TLabel
AnchorSideTop.Control = GbScreenSize
AnchorSideRight.Control = GbScreenSize
AnchorSideRight.Side = asrBottom
Left = 205
Height = 15
Top = 4
Width = 34
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 = 205
Height = 15
Top = 23
Width = 34
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 16
BorderSpacing.Bottom = 8
Caption = 'Label2'
ParentColor = False
end
end
object CbDistanceUnits: TComboBox
AnchorSideTop.Control = GbCenterCoords
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 176
Height = 23
Top = 253
Width = 76
Anchors = [akTop, akLeft, akRight]
Left = 6
Height = 19
Top = 127
Width = 87
BorderSpacing.Top = 6
BorderSpacing.Right = 16
ItemHeight = 15
ItemIndex = 1
Items.Strings = (
'm'
'km'
'miles'
)
OnChange = CbDistanceUnitsChange
Style = csDropDownList
TabOrder = 13
Text = 'km'
end
object BtnLoadGPXFile: TButton
AnchorSideLeft.Control = BtnSaveToFile
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnSaveToFile
Left = 127
Height = 25
Top = 417
Width = 105
AutoSize = True
BorderSpacing.Left = 8
Caption = 'Load GPX file...'
OnClick = BtnLoadGPXFileClick
TabOrder = 14
BorderSpacing.Right = 9
Caption = 'DblBuffering'
Checked = True
OnChange = CbDoubleBufferChange
State = cbChecked
TabOrder = 3
end
object CbDebugTiles: TCheckBox
AnchorSideLeft.Control = CbDoubleBuffer
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbDoubleBuffer
Left = 190
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 40
Width = 55
BorderSpacing.Left = 16
Caption = 'Debug'
Top = 152
Width = 79
BorderSpacing.Top = 6
Caption = 'Debug tiles'
OnChange = CbDebugTilesChange
TabOrder = 15
TabOrder = 4
end
end
object MapView: TMapView
Left = 0
Height = 640
Hint = 'Displays the map'
Top = 0
Width = 606
Active = False
Align = alClient
CacheOnDisk = True
CachePath = 'cache/'
DefaultTrackColor = clBlue
DefaultTrackWidth = 3
DownloadEngine = MapView.BuiltIn
InactiveColor = clWhite
MapProvider = 'OpenStreetMap Mapnik'
UseThreads = True
Zoom = 0
OnZoomChange = MapViewZoomChange
OnChange = MapViewChange
OnDrawGpsPoint = MapViewDrawGpsPoint
OnMouseLeave = MapViewMouseLeave
OnMouseMove = MapViewMouseMove
OnMouseUp = MapViewMouseUp
end
object GeoNames: TMVGeoNames
OnNameFound = GeoNamesNameFound
left = 328
top = 224
left = 240
top = 192
end
object OpenDialog: TOpenDialog
DefaultExt = '.pgx'
Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*'
left = 832
top = 424
left = 240
top = 456
end
end

37
components/lazmapviewer/example/main.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Buttons,
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine;
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine, mvDE_LCL;
type
@ -27,15 +27,19 @@ type
CbMouseCoords: TGroupBox;
CbDistanceUnits: TComboBox;
CbDebugTiles: TCheckBox;
CbDrawingEngine: TComboBox;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
GbSearch: TGroupBox;
GbGPS: TGroupBox;
InfoCenterLatitude: TLabel;
InfoViewportHeight: TLabel;
InfoCenterLongitude: TLabel;
InfoBtnGPSPoints: TLabel;
GPSPointInfo: TLabel;
InfoViewportWidth: TLabel;
Label8: TLabel;
Label1: TLabel;
LblSelectLocation: TLabel;
LblCenterLatitude: TLabel;
LblViewportHeight: TLabel;
LblViewportWidth: TLabel;
@ -48,10 +52,12 @@ type
LblZoom: TLabel;
MapView: TMapView;
GeoNames: TMVGeoNames;
ControlPanel: TPanel;
BtnLoadMapProviders: TSpeedButton;
BtnSaveMapProviders: TSpeedButton;
OpenDialog: TOpenDialog;
PageControl: TPageControl;
PgData: TTabSheet;
PgConfig: TTabSheet;
ZoomTrackBar: TTrackBar;
procedure BtnGoToClick(Sender: TObject);
procedure BtnLoadGPXFileClick(Sender: TObject);
@ -59,6 +65,7 @@ type
procedure BtnGPSPointsClick(Sender: TObject);
procedure BtnSaveToFileClick(Sender: TObject);
procedure CbDebugTilesChange(Sender: TObject);
procedure CbDrawingEngineChange(Sender: TObject);
procedure CbDoubleBufferChange(Sender: TObject);
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
@ -84,6 +91,7 @@ type
procedure ZoomTrackBarChange(Sender: TObject);
private
FLCLDrawingEngine: TLCLDrawingEngine;
procedure ClearFoundLocations;
procedure UpdateCoords(X, Y: Integer);
procedure UpdateDropdownWidth(ACombobox: TCombobox);
@ -105,7 +113,7 @@ implementation
uses
LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
mvEngine, mvExtraData, mvGPX,
mvEngine, mvGPX,
globals, gpslistform;
type
@ -226,6 +234,17 @@ begin
MapView.DebugTiles := CbDebugTiles.Checked;
end;
procedure TMainForm.CbDrawingEngineChange(Sender: TObject);
begin
case CbDrawingEngine.ItemIndex of
0: MapView.DrawingEngine := nil;
1: begin
if FLCLDrawingEngine = nil then FLCLDrawingEngine := TLCLDrawingEngine.Create(self);
MapView.DrawingEngine := FLCLDrawingEngine;
end;
end;
end;
procedure TMainForm.CbDoubleBufferChange(Sender: TObject);
begin
MapView.DoubleBuffered := CbDoubleBuffer.Checked;
@ -296,10 +315,17 @@ begin
CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider);
MapView.DoubleBuffered := true;
MapView.Zoom := 1;
ControlPanel.Caption := '';
CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
InfoPositionLongitude.Caption := '';
InfoPositionLatitude.Caption := '';
InfoCenterLongitude.Caption := '';
InfoCenterLatitude.Caption := '';
InfoViewportWidth.Caption := '';
InfoViewportHeight.Caption := '';
GPSPointInfo.caption := '';
ReadFromIni;
end;
@ -343,6 +369,7 @@ begin
// Draw the GPS point as a circle
ADrawer.BrushColor := clRed;
ADrawer.BrushStyle := bsSolid;
ADrawer.Ellipse(P.X - R, P.Y - R, P.X + R, P.Y + R);
// Draw the caption of the GPS point

14
components/lazmapviewer/lazmapviewerpkg.lpk
View File

@ -14,7 +14,7 @@
<Description Value="Component for viewing maps (Google, OpenStreetMap, etc).
This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/>
<License Value="GPL2 or later"/>
<Files Count="17">
<Files Count="18">
<Item1>
<Filename Value="source/mvcache.pas"/>
<UnitName Value="mvCache"/>
@ -74,16 +74,20 @@ This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/c
</Item14>
<Item15>
<Filename Value="source/mvgpx.pas"/>
<UnitName Value="mvgpx"/>
<UnitName Value="mvGPX"/>
</Item15>
<Item16>
<Filename Value="source/mvdrawingengine.pas"/>
<UnitName Value="mvdrawingengine"/>
<UnitName Value="mvDrawingEngine"/>
</Item16>
<Item17>
<Filename Value="source/mvdeintfgraphics.pas"/>
<UnitName Value="mvdeintfgraphics"/>
<Filename Value="source/mvde_intfgraphics.pas"/>
<UnitName Value="mvde_intfgraphics"/>
</Item17>
<Item18>
<Filename Value="source/mvde_lcl.pas"/>
<UnitName Value="mvde_lcl"/>
</Item18>
</Files>
<RequiredPkgs Count="1">
<Item1>

4
components/lazmapviewer/lazmapviewerpkg.pas
View File

@ -10,8 +10,8 @@ interface
uses
mvCache, mvDownloadEngine, mvDragObj, mvEngine, mvGeoNames, mvGpsObj,
mvJobQueue, mvJobs, mvMapProvider, mvTypes, mvMapViewer, mvExtraData,
mvDLEFpc, mvMapViewerReg, mvGPX, mvDrawingEngine, mvDEIntfGraphics,
LazarusPackageIntf;
mvDLEFpc, mvMapViewerReg, mvGPX, mvDrawingEngine, mvDE_IntfGraphics,
mvDE_LCL, LazarusPackageIntf;
implementation

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

@ -20,21 +20,11 @@
unit mvMapViewer;
{$MODE objfpc}{$H+}
(*
// Activate one of the following defines
{$DEFINE USE_LAZINTFIMAGE}
{.$DEFINE USE_RGBGRAPHICS} // NOTE: This needs package "rgb_graphics" in requirements
// Make sure that one of the USE_XXXX defines is active. Default is USE_LAZINTFIMAGE
{$IFNDEF USE_RGBGRAPHICS}{$IFNDEF USE_LAZINTFIMAGE}{$DEFINE USE_LAZINTFIMAGES}{$ENDIF}{$ENDIF}
{$IFDEF USE_RGBGRAPHICS}{$IFDEF USE_LAZINTFIMAGE}{$UNDEF USE_RGBGRAPHICS}{$ENDIF}{$ENDIF}
*)
interface
uses
Classes, SysUtils, Controls, Graphics, IntfGraphics,
// {$IFDEF USE_RGBGRAPHICS}RGBGraphics,{$ENDIF}
// {$IFDEF USE_LAZINTFIMAGE}FPCanvas,{$ENDIF}
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine;
Type
@ -104,12 +94,6 @@ Type
protected
AsyncInvalidate : boolean;
procedure ActivateEngine;
(*
{$IFDEF USE_LAZINTFIMAGE}
procedure CreateLazIntfImageAndCanvas(out ABuffer: TLazIntfImage;
out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer);
{$ENDIF}
*)
procedure DblClick; override;
procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
procedure DoDrawTileInfo(const TileID: TTileID; X,Y: Integer);
@ -176,65 +160,7 @@ Type
implementation
uses
{$IFDEF USE_LAZINTFIMAGE}
Math, FPImgCanv, FPImage, LCLVersion,
{$ENDIF}
GraphType, mvJobQueue, mvExtraData, mvDLEFpc, mvDEIntfGraphics;
(*
{$IFDEF USE_LAZINTFIMAGE}
// Workaround for http://mantis.freepascal.org/view.php?id=27144
procedure CopyPixels(ASource, ADest: TLazIntfImage;
XDst: Integer = 0; YDst: Integer = 0;
AlphaMask: Boolean = False; AlphaTreshold: Word = 0);
var
SrcHasMask, DstHasMask: Boolean;
x, y, xStart, yStart, xStop, yStop: Integer;
c: TFPColor;
SrcRawImage, DestRawImage: TRawImage;
begin
ASource.GetRawImage(SrcRawImage);
ADest.GetRawImage(DestRawImage);
if DestRawImage.Description.IsEqual(SrcRawImage.Description) and (XDst = 0) and (YDst = 0) then
begin
// same description -> copy
if DestRawImage.Data <> nil then
System.Move(SrcRawImage.Data^, DestRawImage.Data^, DestRawImage.DataSize);
if DestRawImage.Mask <> nil then
System.Move(SrcRawImage.Mask^, DestRawImage.Mask^, DestRawImage.MaskSize);
Exit;
end;
// copy pixels
XStart := IfThen(XDst < 0, -XDst, 0);
YStart := IfThen(YDst < 0, -YDst, 0);
XStop := IfThen(ADest.Width - XDst < ASource.Width, ADest.Width - XDst, ASource.Width) - 1;
YStop := IfTHen(ADest.Height - YDst < ASource.Height, ADest.Height - YDst, ASource.Height) - 1;
SrcHasMask := SrcRawImage.Description.MaskBitsPerPixel > 0;
DstHasMask := DestRawImage.Description.MaskBitsPerPixel > 0;
if DstHasMask then begin
for y:= yStart to yStop do
for x:=xStart to xStop do
ADest.Masked[x+XDst,y+YDst] := SrcHasMask and ASource.Masked[x,y];
end;
for y:=yStart to yStop do
for x:=xStart to xStop do
begin
c := ASource.Colors[x,y];
if not DstHasMask and SrcHasMask and (c.alpha = $FFFF) then // copy mask to alpha channel
if ASource.Masked[x,y] then
c.alpha := 0;
ADest.Colors[x+XDst,y+YDst] := c;
if AlphaMask and (c.alpha < AlphaTreshold) then
ADest.Masked[x+XDst,y+YDst] := True;
end;
end;
{$ENDIF} *)
GraphType, mvJobQueue, mvExtraData, mvDLEFpc, mvDE_IntfGraphics;
Type
@ -462,6 +388,7 @@ begin
FBuiltinDrawingEngine.CreateBuffer(0, 0);
FDrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
end;
Engine.Redraw;
end;
procedure TMapView.SetInactiveColor(AValue: TColor);
@ -822,6 +749,7 @@ begin
end
else begin
DrawingEngine.BrushColor := clWhite;
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
(*
{$IFDEF USE_RGBGRAPHICS}
@ -849,28 +777,6 @@ begin
DrawingEngine.Line(X, Y, X + TILE_SIZE, Y);
DrawingEngine.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE);
DrawingEngine.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE);
(*
{$IFDEF USE_LCL}
Buffer.Canvas.Pen.Color := clGray;
Buffer.Canvas.Pen.Style := psSolid;
Buffer.Canvas.Line(X, Y, X, Y + TILE_SIZE);
Buffer.Canvas.Line(X, Y, X + TILE_SIZE, Y);
Buffer.Canvas.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE);
Buffer.Canvas.Line(X + TILE_SIZE, Y + TILE_SIZE, X, Y + TILE_SIZE);
{$ENDIF}
{$IFDEF USE_RGBGRAPHICS}
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := colGray;
BufferCanvas.Pen.Style := psSolid;
BufferCanvas.Line(X, Y, X, Y + TILE_SIZE);
BufferCanvas.Line(X, Y, X + TILE_SIZE, Y);
BufferCanvas.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE);
BufferCanvas.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE);
{$ENDIF}
*)
end;
function TMapView.IsActive: Boolean;
@ -889,7 +795,7 @@ begin
FInactiveColor := clWhite;
FEngine := TMapViewerEngine.Create(self);
FBuiltinDownloadEngine := TMvDEFpc.Create(self);
FBuiltinDownLoadEngine.Name := 'BuiltIn';
FBuiltinDownloadEngine.Name := 'BuiltInDLE';
FDefaultTrackColor := clRed;
FDefaultTrackWidth := 1;
(*
@ -909,6 +815,7 @@ begin
Width := 150;
Height := 150;
FBuiltinDrawingEngine := TIntfGraphicsDrawingEngine.Create(self);
FBuiltinDrawingEngine.Name := 'BuiltInDE';
FbuiltinDrawingEngine.CreateBuffer(Width, Height);
end;
@ -924,26 +831,6 @@ begin
FreeAndNil(FGPSItems);
inherited Destroy;
end;
(*
{$IFDEF USE_LAZINTFIMAGE}
procedure TMapView.CreateLazIntfImageAndCanvas(out ABuffer: TLazIntfImage;
out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer);
var
rawImg: TRawImage;
begin
rawImg.Init;
{$IFDEF DARWIN}
rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight);
{$ELSE}
rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight);
{$ENDIF}
rawImg.CreateData(True);
ABuffer := TLazIntfImage.Create(rawImg, true);
ACanvas := TFPImageCanvas.Create(ABuffer);
ACanvas.Brush.FPColor := colWhite;
ACanvas.FillRect(0, 0, AWidth, AHeight);
end;
{$ENDIF} *)
procedure TMapView.SaveToFile(AClass: TRasterImageClass; const AFileName: String);
var