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

lazMapViewer: Activate GeoNames component in demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6311 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-16 17:57:58 +00:00
parent eb727001e8
commit 83e1ee6f4f
7 changed files with 430 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -297,6 +297,54 @@ object MainForm: TMainForm
OnClick = BtnSearchClick OnClick = BtnSearchClick
TabOrder = 7 TabOrder = 7
end end
object CbFoundLocations: TComboBox
AnchorSideLeft.Control = CbLocations
AnchorSideTop.Control = Label8
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnGoTo
Left = 9
Height = 21
Top = 318
Width = 156
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
AnchorSideTop.Control = CbLocations
AnchorSideTop.Side = asrBottom
Left = 9
Height = 15
Top = 299
Width = 177
BorderSpacing.Top = 12
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 = 173
Height = 25
Top = 316
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
Caption = 'Go to'
OnClick = BtnGoToClick
TabOrder = 9
end
end end
object MapView: TMapView object MapView: TMapView
Left = 0 Left = 0
@ -315,6 +363,7 @@ object MainForm: TMainForm
OnMouseMove = MapViewMouseMove OnMouseMove = MapViewMouseMove
end end
object GeoNames: TMVGeoNames object GeoNames: TMVGeoNames
OnNameFound = GeoNamesNameFound
left = 520 left = 520
top = 288 top = 288
end end

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

@ -5,8 +5,9 @@ unit Main;
interface interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
ComCtrls, mvgeonames, mvMapViewer; ExtCtrls, StdCtrls, ComCtrls,
mvGeoNames, mvMapViewer, mvTypes;
type type
@ -14,7 +15,9 @@ type
TMainForm = class(TForm) TMainForm = class(TForm)
BtnSearch: TButton; BtnSearch: TButton;
BtnGoTo: TButton;
CbDoubleBuffer: TCheckBox; CbDoubleBuffer: TCheckBox;
CbFoundLocations: TComboBox;
CbLocations: TComboBox; CbLocations: TComboBox;
CbProviders: TComboBox; CbProviders: TComboBox;
CbUseThreads: TCheckBox; CbUseThreads: TCheckBox;
@ -22,6 +25,7 @@ type
GbCenterCoords: TGroupBox; GbCenterCoords: TGroupBox;
InfoCenterLatitude: TLabel; InfoCenterLatitude: TLabel;
InfoCenterLongitude: TLabel; InfoCenterLongitude: TLabel;
Label8: TLabel;
LblCenterLatitude: TLabel; LblCenterLatitude: TLabel;
LblPositionLongitude: TLabel; LblPositionLongitude: TLabel;
LblPositionLatitude: TLabel; LblPositionLatitude: TLabel;
@ -34,19 +38,26 @@ type
GeoNames: TMVGeoNames; GeoNames: TMVGeoNames;
Panel1: TPanel; Panel1: TPanel;
ZoomTrackBar: TTrackBar; ZoomTrackBar: TTrackBar;
procedure BtnGoToClick(Sender: TObject);
procedure BtnSearchClick(Sender: TObject); procedure BtnSearchClick(Sender: TObject);
procedure CbDoubleBufferChange(Sender: TObject); procedure CbDoubleBufferChange(Sender: TObject);
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure CbProvidersChange(Sender: TObject); procedure CbProvidersChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject); procedure CbUseThreadsChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure GeoNamesNameFound(const AName: string; const ADescr: String;
const ALoc: TRealPoint);
procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X, procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); Y: Integer);
procedure MapViewZoomChange(Sender: TObject); procedure MapViewZoomChange(Sender: TObject);
procedure ZoomTrackBarChange(Sender: TObject); procedure ZoomTrackBarChange(Sender: TObject);
private private
procedure ClearFoundLocations;
procedure UpdateDropdownWidth(ACombobox: TCombobox);
procedure UpdateLocationHistory(ALocation: String); procedure UpdateLocationHistory(ALocation: String);
public public
@ -63,7 +74,13 @@ implementation
{$R *.lfm} {$R *.lfm}
uses uses
IniFiles, mvTypes; LCLType, IniFiles, Math;
type
TLocationParam = class
Descr: String;
Loc: TRealPoint;
end;
const const
MAX_LOCATIONS_HISTORY = 50; MAX_LOCATIONS_HISTORY = 50;
@ -82,22 +99,72 @@ end;
procedure TMainForm.BtnSearchClick(Sender: TObject); procedure TMainForm.BtnSearchClick(Sender: TObject);
begin begin
MapView.Center := GeoNames.Search(CbLocations.Text, MapView.DownloadEngine); // MapView.Center := GeoNames.Search(CbLocations.Text, MapView.DownloadEngine);
{
ClearFoundLocations; ClearFoundLocations;
GeoNames.LocationName := CbLocations.Text; // GeoNames.LocationName := CbLocations.Text;
GeoNames.ListLocations(MapView.DownloadEngine); GeoNames.Search(CbLocations.Text, MapView.DownloadEngine);
// GeoNames.ListLocations(MapView.DownloadEngine);
//CbFoundLocations.Text := CbFoundLocations.Items[0]; //CbFoundLocations.Text := CbFoundLocations.Items[0];
UpdateDropdownWidth(CbFoundLocations); UpdateDropdownWidth(CbFoundLocations);
}
UpdateLocationHistory(CbLocations.Text); UpdateLocationHistory(CbLocations.Text);
end; end;
procedure TMainForm.BtnGoToClick(Sender: TObject);
var
s: String;
P: TLocationParam;
begin
if CbFoundLocations.ItemIndex = -1 then
exit;
// Extract parameters of found locations. We need that to get the coordinates.
s := CbFoundLocations.Items.Strings[CbFoundLocations.ItemIndex];
P := TLocationParam(CbFoundLocations.Items.Objects[CbFoundLocations.ItemIndex]);
if P = nil then
exit;
CbFoundLocations.Text := s;
// Show location in center of mapview
MapView.Zoom := 12;
MapView.Center := P.Loc;
MapView.Invalidate;
end;
procedure TMainForm.CbDoubleBufferChange(Sender: TObject); procedure TMainForm.CbDoubleBufferChange(Sender: TObject);
begin begin
MapView.DoubleBuffered := CbDoubleBuffer.Checked; MapView.DoubleBuffered := CbDoubleBuffer.Checked;
end; end;
procedure TMainForm.CbFoundLocationsDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
s: String;
P: TLocationParam;
combo: TCombobox;
x, y: Integer;
begin
combo := TCombobox(Control);
if (State * [odSelected, odFocused] <> []) then begin
combo.Canvas.Brush.Color := clHighlight;
combo.Canvas.Font.Color := clHighlightText;
end else begin
combo.Canvas.Brush.Color := clWindow;
combo.Canvas.Font.Color := clWindowText;
end;
combo.Canvas.FillRect(ARect);
combo.Canvas.Brush.Style := bsClear;
s := combo.Items.Strings[Index];
P := TLocationParam(combo.Items.Objects[Index]);
x := ARect.Left + 2;
y := ARect.Top + 2;
combo.Canvas.Font.Style := [fsBold];
combo.Canvas.TextOut(x, y, s);
inc(y, combo.Canvas.TextHeight('Tg'));
combo.Canvas.Font.Style := [];
combo.Canvas.TextOut(x, y, P.Descr);
end;
procedure TMainForm.CbProvidersChange(Sender: TObject); procedure TMainForm.CbProvidersChange(Sender: TObject);
begin begin
MapView.MapProvider := CbProviders.Text; MapView.MapProvider := CbProviders.Text;
@ -108,6 +175,18 @@ begin
MapView.UseThreads := CbUseThreads.Checked; MapView.UseThreads := CbUseThreads.Checked;
end; end;
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
P: TLocationParam;
begin
for i:=0 to CbFoundLocations.Items.Count-1 do begin
P := TLocationParam(CbFoundLocations.Items.Objects[i]);
P.Free;
end;
CbFoundLocations.Items.Clear;
end;
procedure TMainForm.FormCreate(Sender: TObject); procedure TMainForm.FormCreate(Sender: TObject);
begin begin
ForceDirectories(HOMEDIR + 'cache/'); ForceDirectories(HOMEDIR + 'cache/');
@ -134,12 +213,22 @@ begin
MapView.Active := true; MapView.Active := true;
end; end;
procedure TMainForm.GeoNamesNameFound(const AName: string;
const ADescr: String; const ALoc: TRealPoint);
var
P: TLocationParam;
begin
P := TLocationParam.Create;
P.Descr := ADescr;
P.Loc := ALoc;
CbFoundLocations.Items.AddObject(AName, P);
end;
procedure TMainForm.MapViewMouseMove(Sender: TObject; Shift: TShiftState; procedure TMainForm.MapViewMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
var var
rPt: TRealPoint; rPt: TRealPoint;
begin begin
rPt := MapView.ScreenToLonLat(Point(X, Y));
(* (*
p := MapView.GetMouseMapPixel(X, Y); p := MapView.GetMouseMapPixel(X, Y);
LblZoom.Caption := Format('Pixel: %d:%d', [p.X, p.Y]); LblZoom.Caption := Format('Pixel: %d:%d', [p.X, p.Y]);
@ -147,8 +236,10 @@ begin
Label3.Caption := Format('Tile: %d:%d', [p.X, p.Y]); Label3.Caption := Format('Tile: %d:%d', [p.X, p.Y]);
r := mv.GetMouseMapLongLat(X, Y); r := mv.GetMouseMapLongLat(X, Y);
*) *)
rPt := MapView.ScreenToLonLat(Point(X, Y));
InfoPositionLongitude.Caption := Format('%.6f°', [rPt.Lon]); InfoPositionLongitude.Caption := Format('%.6f°', [rPt.Lon]);
InfoPositionLatitude.Caption := Format('%.6f°', [rPt.Lat]); InfoPositionLatitude.Caption := Format('%.6f°', [rPt.Lat]);
rPt := MapView.Center; rPt := MapView.Center;
InfoCenterLongitude.Caption := Format('%.6f°', [rPt.Lon]); InfoCenterLongitude.Caption := Format('%.6f°', [rPt.Lon]);
@ -207,6 +298,33 @@ begin
end; end;
end; end;
procedure TMainForm.UpdateDropdownWidth(ACombobox: TCombobox);
var
cnv: TControlCanvas;
i, w: Integer;
s: String;
P: TLocationParam;
begin
w := 0;
cnv := TControlCanvas.Create;
try
cnv.Control := ACombobox;
cnv.Font.Assign(ACombobox.Font);
for i:=0 to ACombobox.Items.Count-1 do begin
cnv.Font.Style := [fsBold];
s := ACombobox.Items.Strings[i];
w := Max(w, cnv.TextWidth(s));
P := TLocationParam(ACombobox.Items.Objects[i]);
cnv.Font.Style := [];
w := Max(w, cnv.TextWidth(P.Descr));
end;
ACombobox.ItemWidth := w + 16;
ACombobox.ItemHeight := 2 * cnv.TextHeight('Tg') + 6;
finally
cnv.Free;
end;
end;
procedure TMainForm.UpdateLocationHistory(ALocation: String); procedure TMainForm.UpdateLocationHistory(ALocation: String);
var var
idx: Integer; idx: Integer;

8
components/lazmapviewer/source/mvdlefpc.pas
View File

@ -37,7 +37,7 @@ type
TMVDEFPC = class(TMvCustomDownloadEngine) TMVDEFPC = class(TMvCustomDownloadEngine)
protected protected
procedure DownloadFile(const Url: string; str: TStream); override; procedure DownloadFile(const Url: string; AStream: TStream); override;
{$IF FPC_FullVersion >= 30101} {$IF FPC_FullVersion >= 30101}
published published
property UseProxy; property UseProxy;
@ -56,7 +56,7 @@ uses
{ TMVDEFPC } { TMVDEFPC }
procedure TMVDEFPC.DownloadFile(const Url: string; str: TStream); procedure TMVDEFPC.DownloadFile(const Url: string; AStream: TStream);
var var
http: TFpHttpClient; http: TFpHttpClient;
begin begin
@ -73,8 +73,8 @@ begin
http.Proxy.Password := ProxyPassword; http.Proxy.Password := ProxyPassword;
end; end;
{$ENDIF} {$ENDIF}
http.Get(Url, str); http.Get(Url, AStream);
str.Position := 0; AStream.Position := 0;
finally finally
http.Free; http.Free;
end; end;

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

@ -40,7 +40,7 @@ implementation
procedure TMvCustomDownloadEngine.DownloadFile(const Url: string; AStream: TStream); procedure TMvCustomDownloadEngine.DownloadFile(const Url: string; AStream: TStream);
begin begin
// to be overridden...
end; end;
end. end.

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

@ -80,8 +80,7 @@ Type
function GetUseThreads: Boolean; function GetUseThreads: Boolean;
function GetWidth: integer; function GetWidth: integer;
function GetZoom: integer; function GetZoom: integer;
function IsValidTile(const aWin: TMapWindow; const aTile: TTIleId function IsValidTile(const aWin: TMapWindow; const aTile: TTIleId): boolean;
): boolean;
procedure MoveMapCenter(Sender: TDragObj); procedure MoveMapCenter(Sender: TDragObj);
procedure SetActive(AValue: boolean); procedure SetActive(AValue: boolean);
procedure SetCacheOnDisk(AValue: Boolean); procedure SetCacheOnDisk(AValue: Boolean);
@ -687,45 +686,48 @@ begin
Result:=Inttostr(Id.X)+'.'+inttostr(Id.Y)+'.'+inttostr(Id.Z); Result:=Inttostr(Id.X)+'.'+inttostr(Id.Y)+'.'+inttostr(Id.Z);
end; end;
procedure TMapViewerEngine.evDownload(Data : TObject;Job : TJob); procedure TMapViewerEngine.evDownload(Data: TObject; Job: TJob);
var Id : TTileId; var
Url : String; Id: TTileId;
Env : TEnvTile; Url: String;
MapO : TMapProvider; Env: TEnvTile;
FStream : TMemoryStream; MapO: TMapProvider;
Begin lStream: TMemoryStream;
Env:=TEnvTile(Data); begin
Id:=Env.Tile; Env := TEnvTile(Data);
MapO:=Env.Win.MapProvider; Id := Env.Tile;
if Assigned(MapO) then MapO := Env.Win.MapProvider;
Begin if Assigned(MapO) then
if not(Cache.InCache(MapO,Id)) then begin
Begin if not Cache.InCache(MapO, Id) then
if Assigned(FDownloadEngine) then begin
begin if Assigned(FDownloadEngine) then
Url:=MapO.GetUrlForTile(Id); begin
if Url<>'' then Url := MapO.GetUrlForTile(Id);
begin if Url<>'' then
FStream:=TMemoryStream.Create; begin
Try lStream := TMemoryStream.Create;
Try try
FDownloadEngine.DownloadFile(Url,Fstream); try
Cache.Add(MapO,Id,FStream); FDownloadEngine.DownloadFile(Url, lStream);
except Cache.Add(MapO, Id, lStream);
end; except
finally end;
FreeAndNil(FStream); finally
end; FreeAndNil(lStream);
end; end;
end; end;
end; end;
end; end;
if Job.Cancelled then end;
Exit;
if DrawTitleInGuiThread then if Job.Cancelled then
Queue.QueueAsyncCall(@TileDownloaded,PtrInt(Env)) Exit;
else
TileDownloaded(PtrInt(Env)); if DrawTitleInGuiThread then
Queue.QueueAsyncCall(@TileDownloaded, PtrInt(Env))
else
TileDownloaded(PtrInt(Env));
end; end;
procedure TMapViewerEngine.TileDownloaded(Data: PtrInt); procedure TMapViewerEngine.TileDownloaded(Data: PtrInt);
@ -754,17 +756,17 @@ end;
function TMapViewerEngine.GetYahooSvr(id: integer): String; function TMapViewerEngine.GetYahooSvr(id: integer): String;
Begin Begin
Result:=inttostr(id+1); Result := IntToStr(id+1);
end; end;
function TMapViewerEngine.GetYahooY(const Tile : TTileId): string; function TMapViewerEngine.GetYahooY(const Tile : TTileId): string;
Begin Begin
Result :=inttostr( - (Tile.Y - (1 shl Tile.Z) div 2) - 1); Result := IntToStr( -(Tile.Y - (1 shl Tile.Z) div 2) - 1);
end; end;
function TMapViewerEngine.GetYahooZ(const Tile : TTileId): string; function TMapViewerEngine.GetYahooZ(const Tile : TTileId): string;
Begin Begin
result:=inttostr(Tile.Z+1); result := IntToStr(Tile.Z+1);
end; end;
function TMapViewerEngine.GetQuadKey(const Tile : TTileId): string; function TMapViewerEngine.GetQuadKey(const Tile : TTileId): string;
@ -788,39 +790,37 @@ begin
end; end;
end; end;
Type
{ TMemObj } { TMemObj }
TMemObj = Class type
private TMemObj = Class
FWin : TMapWindow; private
public FWin : TMapWindow;
constructor Create(const aWin : TMapWindow); public
End; constructor Create(const aWin : TMapWindow);
end;
{ TMemObj }
constructor TMemObj.Create(const aWin: TMapWindow); constructor TMemObj.Create(const aWin: TMapWindow);
begin begin
FWin:=aWin; FWin := aWin;
end; end;
procedure TMapViewerEngine.MoveMapCenter(Sender: TDragObj); procedure TMapViewerEngine.MoveMapCenter(Sender: TDragObj);
var old : TMemObj; var
nCenter : TRealPoint; old: TMemObj;
Job : TJob; nCenter: TRealPoint;
aPt : TPoint; Job: TJob;
aPt: TPoint;
Begin Begin
if Sender.LnkObj=nil then if Sender.LnkObj=nil then
Begin begin
Sender.LnkObj:=TMemObj.Create(MapWin); Sender.LnkObj := TMemObj.Create(MapWin);
end; end;
old:=TMemObj(Sender.LnkObj); old := TMemObj(Sender.LnkObj);
aPt.X:=old.FWin.Width DIV 2-Sender.OfsX; aPt.X := old.FWin.Width DIV 2-Sender.OfsX;
aPt.Y:=old.FWin.Height DIV 2-Sender.OfsY; aPt.Y := old.FWin.Height DIV 2-Sender.OfsY;
nCenter:=MapWinToLonLat(old.FWin,aPt); nCenter := MapWinToLonLat(old.FWin,aPt);
SetCenter(nCenter); SetCenter(nCenter);
end; end;
@ -838,16 +838,15 @@ end;
procedure TMapViewerEngine.DoDrag(Sender: TDragObj); procedure TMapViewerEngine.DoDrag(Sender: TDragObj);
begin begin
if Sender.DragSrc=self then if Sender.DragSrc = self then
Begin
MoveMapCenter(Sender); MoveMapCenter(Sender);
end;
end; end;
procedure TMapViewerEngine.CancelCurrentDrawing; procedure TMapViewerEngine.CancelCurrentDrawing;
var Jobs : TJobArray; var
Jobs: TJobArray;
begin begin
Jobs:=Queue.CancelAllJob(self); Jobs := Queue.CancelAllJob(self);
Queue.WaitForTerminate(Jobs); Queue.WaitForTerminate(Jobs);
end; end;
@ -856,22 +855,21 @@ begin
Redraw(MapWin); Redraw(MapWin);
end; end;
function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String; function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String;
MinZoom : integer;MaxZoom : integer; MinZoom : integer;MaxZoom : integer;
NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr;
GetYStr: TGetValStr; GetZStr: TGetValStr) : TMapProvider; GetYStr: TGetValStr; GetZStr: TGetValStr) : TMapProvider;
var idx :integer; var idx :integer;
Begin Begin
idx:=lstProvider.IndexOf(OpeName); idx := lstProvider.IndexOf(OpeName);
if idx=-1 then if idx = -1 then
Begin begin
result:=TMapProvider.Create(OpeName); Result := TMapProvider.Create(OpeName);
lstProvider.AddObject(OpeName,result); lstProvider.AddObject(OpeName, Result);
end end
else else
result:=TMapProvider(lstProvider.Objects[idx]); Result := TMapProvider(lstProvider.Objects[idx]);
result.AddUrl(Url,NbSvr,MinZoom,MaxZoom,GetSvrStr,GetXStr,GetYStr,GetZStr); Result.AddUrl(Url, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr);
end; end;
procedure TMapViewerEngine.RegisterProviders; procedure TMapViewerEngine.RegisterProviders;
@ -890,7 +888,7 @@ begin
//AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); //AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
//AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); //AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
MapWin.MapProvider:=AddMapProvider('OpenStreetMap Mapnik','http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png',0,19, 3, @getLetterSvr); MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik','http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png',0,19, 3, @getLetterSvr);
AddMapProvider('Open Cycle Map','http://%serv%.tile.opencyclemap.org/cycle/%z%/%x%/%y%.png',0,18,3, @getLetterSvr); AddMapProvider('Open Cycle Map','http://%serv%.tile.opencyclemap.org/cycle/%z%/%x%/%y%.png',0,18,3, @getLetterSvr);
AddMapProvider('Virtual Earth Bing','http://ecn.t%serv%.tiles.virtualearth.net/tiles/r%x%?g=671&mkt=en-us&lbl=l1&stl=h&shading=hill',1,19,8,nil,@GetQuadKey); AddMapProvider('Virtual Earth Bing','http://ecn.t%serv%.tiles.virtualearth.net/tiles/r%x%?g=671&mkt=en-us&lbl=l1&stl=h&shading=hill',1,19,8,nil,@GetQuadKey);
AddMapProvider('Virtual Earth Road','http://r%serv%.ortho.tiles.virtualearth.net/tiles/r%x%.png?g=72&shading=hill',1,19,4,nil,@getQuadKey); AddMapProvider('Virtual Earth Road','http://r%serv%.ortho.tiles.virtualearth.net/tiles/r%x%.png?g=72&shading=hill',1,19,4,nil,@getQuadKey);
@ -900,12 +898,19 @@ begin
AddMapProvider('Ovi Satellite','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/satellite.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); AddMapProvider('Ovi Satellite','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/satellite.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr);
AddMapProvider('Ovi Hybrid','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/hybrid.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); AddMapProvider('Ovi Hybrid','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/hybrid.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr);
AddMapProvider('Ovi Physical','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/terrain.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); AddMapProvider('Ovi Physical','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/terrain.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr);
{
AddMapProvider('Yahoo Normal','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&.intl=en&x=%x%&y=%y%d&z=%d&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //(Z+1]));
AddMapProvider('Yahoo Satellite','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%d&y=%d&z=%d&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
}
end; end;
procedure TMapViewerEngine.DrawTile(const TileId : TTileId;X, Y: integer; TileImg: TLazIntfImage); procedure TMapViewerEngine.DrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TLazIntfImage);
begin begin
if Assigned(FOnDrawTile) then if Assigned(FOnDrawTile) then
FOnDrawTile(TileId,X,Y,TileImg); FOnDrawTile(TileId, X, Y, TileImg);
end; end;
constructor TMapViewerEngine.Create(aOwner: TComponent); constructor TMapViewerEngine.Create(aOwner: TComponent);

173
components/lazmapviewer/source/mvgeonames.pas
View File

@ -30,13 +30,33 @@ type
TStringArray = array of string; TStringArray = array of string;
TResRec = record
Name: String;
Descr: String;
Loc: TRealPoint;
end;
{ TMVGeoNames } { TMVGeoNames }
TMVGeoNames = class(TComponent) TMVGeoNames = class(TComponent)
private private
FLocationName: string; FLocationName: string;
FInResTable: Boolean;
FInDataRows: Boolean;
FNamePending: Boolean;
FLongitudePending: Boolean;
FLatitudePending: Boolean;
FCol: Integer;
FCountry: String;
FSmall: Boolean;
FFirstLocation: TResRec;
FFoundLocation: TResRec;
FOnNameFound: TNameFoundEvent; FOnNameFound: TNameFoundEvent;
function RemoveTag(const str: String): TStringArray; procedure FoundTagHandler(NoCaseTag, ActualTag: string);
procedure FoundTextHandler(AText: String);
function Parse(AStr: PChar): TRealPoint;
// function RemoveTag(const str: String): TStringArray;
public public
function Search(ALocationName: String; function Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint; ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
@ -48,6 +68,13 @@ type
implementation implementation
uses
FastHtmlParser;
const
SEARCH_URL = 'http://geonames.org/search.html?q=%s'; //&country=%s';
function CleanLocationName(x: string): string; function CleanLocationName(x: string): string;
var var
i: Integer; i: Integer;
@ -62,24 +89,122 @@ begin
end; end;
end; end;
{ TMVGeoNames } { TMVGeoNames }
Type procedure TMvGeoNames.FoundTagHandler(NoCaseTag, ActualTag: String);
TResRec = record begin
Name: String; if not FInResTable and (NoCaseTag = '<TABLE CLASS="RESTABLE">') then begin
Descr: String; FInResTable := true;
Loc: TRealPoint; FInDataRows := false;
End; FNamePending := false;
FLatitudePending := false;
FLongitudePending := false;
FSmall := false;
end else
if FInResTable and (NoCaseTag = '</TABLE>') then
FInResTable := false;
if FInResTable then begin
if NoCaseTag = '</TH>' then
FInDataRows := true;
if FInDataRows then begin
if NoCaseTag = '<TR>' then begin
FCol := 0;
with FFoundLocation do begin
Name := ''; Descr := ''; Loc.Lon := 0; Loc.Lat := 0;
end;
end;
if NoCaseTag = '<TD>' then
inc(FCol);
if FCol = 2 then begin
if not FNamePending and (pos('<A HREF=', NoCaseTag) = 1) then
FNamePending := true
else if FNamePending and (NoCaseTag = '</A>') then
FNamePending := false;
if not FLatitudePending and (NoCaseTag = '<SPAN CLASS="LATITUDE">') then
FLatitudePending := true
else if FLatitudePending and (NoCaseTag = '</SPAN>') then
FLatitudePending := false;
if not FLongitudePending and (NoCaseTag = '<SPAN CLASS="LONGITUDE">') then
FLongitudePending := true
else if FLongitudePending and (NoCasetag = '</SPAN>') then
FLongitudePending := false;
end;
if FCol = 3 then
if not FSmall and (NoCaseTag = '<SMALL>') then
FSmall := true
else if FSmall and (NoCaseTag = '</SMALL>') then
FSmall := false;
if NoCaseTag = '</TR>' then begin
if (FFirstLocation.Name = '') then
FFirstLocation := FFoundLocation;
if Assigned(FOnNameFound) and (FFoundLocation.Name <> '') then
with FFoundLocation do
FOnNameFound(Name, Descr, Loc);
end;
end;
end;
end;
procedure TMvGeoNames.FoundTextHandler(AText: String);
var
code: Integer;
begin
if not FInDataRows or (AText = #10) then
exit;
if FNamePending then
FFoundLocation.Name := AText
else if FLatitudePending then
val(AText, FFoundLocation.Loc.Lat, code)
else if FLongitudePending then
val(AText, FFoundLocation.Loc.Lon, code)
else if (FCol = 3) and not FSmall then
FCountry := FCountry + AText
else if FCol = 4 then begin
if FFoundLocation.Descr = '' then
FFoundLocation.Descr := AText
else
FFoundLocation.Descr := FFoundLocation.Descr + ', ' + aText;
if FCountry <> '' then
FFoundLocation.Name := FFoundLocation.Name + ' (' + FCountry + ')';
FCountry := '';
end;
end;
function TMVGeonames.Parse(AStr: PChar): TRealPoint;
var
parser: THtmlParser;
begin
FFirstLocation.Name := '';
parser := THtmlParser.Create(AStr);
try
parser.OnFoundTag := @FoundTagHandler;
parser.OnFoundText := @FoundTextHandler;
parser.Exec;
Result := FFirstLocation.Loc;
finally
parser.Free;
end;
end;
(*
function TMVGeoNames.RemoveTag(Const str : String) : TStringArray; function TMVGeoNames.RemoveTag(Const str : String) : TStringArray;
var iStart,iEnd,i : Integer; var iStart,iEnd,i : Integer;
tmp : String; tmp : String;
lst : TStringList; lst : TStringList;
Begin Begin
SetLength(Result,0); SetLength(Result,0);
tmp:=StringReplace(str,'<br>',#13,[rfReplaceall]); tmp := StringReplace(str,'<br>',#13,[rfReplaceall]);
tmp:=StringReplace(tmp,'&nbsp;',' ',[rfReplaceall]); tmp := StringReplace(tmp,'&nbsp;',' ',[rfReplaceall]);
tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]); tmp := StringReplace(tmp,' ',' ',[rfReplaceall]);
repeat repeat
iEnd:=-1; iEnd:=-1;
iStart:=pos('<',tmp); iStart:=pos('<',tmp);
@ -103,7 +228,7 @@ Begin
end; end;
end; end;
*)
function TMVGeoNames.Search(ALocationName: String; function TMVGeoNames.Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint; ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
const const
@ -131,24 +256,27 @@ var
end; end;
var var
m: TMemoryStream; ms: TMemoryStream;
iRes,i : integer; iRes,i : integer;
lstRes : Array of TResRec; lstRes : Array of TResRec;
iStartDescr : integer; iStartDescr : integer;
lst : TStringArray; lst : TStringArray;
url: String;
begin begin
FLocationName := ALocationName; FLocationName := ALocationName;
m := TMemoryStream.Create; ms := TMemoryStream.Create;
try try
ADownloadEngine.DownloadFile('http://www.geonames.org/search.html?q='+ url := Format(SEARCH_URL, [CleanLocationName(FLocationName)]);
CleanLocationName(FLocationName), m); ADownloadEngine.DownloadFile(url, ms);
m.Position := 0; ms.Position := 0;
SetLength(s, m.Size); SetLength(s, ms.Size);
m.Read(s[1], m.Size); ms.Read(s[1], ms.Size);
finally finally
m.Free; ms.Free;
end; end;
Result := Parse(PChar(s));
(*
Result.Lon := 0; Result.Lon := 0;
Result.Lat := 0; Result.Lat := 0;
SetLength(lstRes, 0); SetLength(lstRes, 0);
@ -174,9 +302,9 @@ begin
iRes := PosEx('<span class="geo"',s,iRes+17); iRes := PosEx('<span class="geo"',s,iRes+17);
end; end;
if length(lstRes)>0 then if Length(lstRes) > 0 then
begin begin
if length(lstRes)>1 then if Length(lstRes) > 1 then
begin begin
Result.Lon := Result.Lon/length(lstRes); Result.Lon := Result.Lon/length(lstRes);
Result.Lat := Result.Lat/length(lstRes); Result.Lat := Result.Lat/length(lstRes);
@ -184,9 +312,10 @@ begin
if Assigned(FOnNameFound) then if Assigned(FOnNameFound) then
for iRes:=low(lstRes) to high(lstRes) do for iRes:=low(lstRes) to high(lstRes) do
begin begin
FOnNameFound(lstRes[iRes].Name,lstRes[iRes].Descr,lstRes[iRes].Loc); FOnNameFound(lstRes[iRes].Name, lstRes[iRes].Descr, lstRes[iRes].Loc);
end; end;
end; end;
*)
end; end;
end. end.

22
components/lazmapviewer/source/mvjobqueue.pas
View File

@ -318,13 +318,13 @@ end;
procedure TjobQueue.InitThreads; procedure TjobQueue.InitThreads;
var i : integer; var i : integer;
begin begin
Jobs:=TObjectList.Create(true); Jobs := TObjectList.Create(true);
Threads:=TObjectList.Create(true); Threads := TObjectList.Create(true);
FEvent:=TEvent.Create(nil,true,false,''); FEvent := TEvent.Create(nil,true,false,'');
FSect:=TCriticalSection.Create; FSect := TCriticalSection.Create;
TerminatedThread := 0; TerminatedThread := 0;
For i:=1 to FNbThread do for i:=1 to FNbThread do
Threads.Add(TQueueThread.Create(self)); Threads.Add(TQueueThread.Create(self));
end; end;
procedure TjobQueue.FreeThreads; procedure TjobQueue.FreeThreads;
@ -476,9 +476,9 @@ end;
constructor TjobQueue.Create(NbThread: integer); constructor TjobQueue.Create(NbThread: integer);
begin begin
waitings:=TStringList.create; waitings := TStringList.create;
FNbThread:=NbThread; FNbThread := NbThread;
FMainThreadId:=GetCurrentThreadId; FMainThreadId := GetCurrentThreadId;
end; end;
destructor TjobQueue.Destroy; destructor TjobQueue.Destroy;
@ -492,9 +492,9 @@ end;
procedure TjobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt); procedure TjobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
begin begin
if UseThreads then if UseThreads then
Application.QueueAsyncCall(aMethod,Data) Application.QueueAsyncCall(aMethod,Data)
else else
AMethod(Data); AMethod(Data);
end; end;