You've already forked lazarus-ccr
lazMapViewer: Activate GeoNames component in demo.
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
@ -297,6 +297,54 @@ object MainForm: TMainForm
|
||||
OnClick = BtnSearchClick
|
||||
TabOrder = 7
|
||||
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
|
||||
object MapView: TMapView
|
||||
Left = 0
|
||||
@ -315,6 +363,7 @@ object MainForm: TMainForm
|
||||
OnMouseMove = MapViewMouseMove
|
||||
end
|
||||
object GeoNames: TMVGeoNames
|
||||
OnNameFound = GeoNamesNameFound
|
||||
left = 520
|
||||
top = 288
|
||||
end
|
||||
|
||||
@ -5,8 +5,9 @@ unit Main;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
|
||||
ComCtrls, mvgeonames, mvMapViewer;
|
||||
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, StdCtrls, ComCtrls,
|
||||
mvGeoNames, mvMapViewer, mvTypes;
|
||||
|
||||
type
|
||||
|
||||
@ -14,7 +15,9 @@ type
|
||||
|
||||
TMainForm = class(TForm)
|
||||
BtnSearch: TButton;
|
||||
BtnGoTo: TButton;
|
||||
CbDoubleBuffer: TCheckBox;
|
||||
CbFoundLocations: TComboBox;
|
||||
CbLocations: TComboBox;
|
||||
CbProviders: TComboBox;
|
||||
CbUseThreads: TCheckBox;
|
||||
@ -22,6 +25,7 @@ type
|
||||
GbCenterCoords: TGroupBox;
|
||||
InfoCenterLatitude: TLabel;
|
||||
InfoCenterLongitude: TLabel;
|
||||
Label8: TLabel;
|
||||
LblCenterLatitude: TLabel;
|
||||
LblPositionLongitude: TLabel;
|
||||
LblPositionLatitude: TLabel;
|
||||
@ -34,19 +38,26 @@ type
|
||||
GeoNames: TMVGeoNames;
|
||||
Panel1: TPanel;
|
||||
ZoomTrackBar: TTrackBar;
|
||||
procedure BtnGoToClick(Sender: TObject);
|
||||
procedure BtnSearchClick(Sender: TObject);
|
||||
procedure CbDoubleBufferChange(Sender: TObject);
|
||||
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
|
||||
ARect: TRect; State: TOwnerDrawState);
|
||||
procedure CbProvidersChange(Sender: TObject);
|
||||
procedure CbUseThreadsChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure GeoNamesNameFound(const AName: string; const ADescr: String;
|
||||
const ALoc: TRealPoint);
|
||||
procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
procedure MapViewZoomChange(Sender: TObject);
|
||||
procedure ZoomTrackBarChange(Sender: TObject);
|
||||
|
||||
private
|
||||
procedure ClearFoundLocations;
|
||||
procedure UpdateDropdownWidth(ACombobox: TCombobox);
|
||||
procedure UpdateLocationHistory(ALocation: String);
|
||||
|
||||
public
|
||||
@ -63,7 +74,13 @@ implementation
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
IniFiles, mvTypes;
|
||||
LCLType, IniFiles, Math;
|
||||
|
||||
type
|
||||
TLocationParam = class
|
||||
Descr: String;
|
||||
Loc: TRealPoint;
|
||||
end;
|
||||
|
||||
const
|
||||
MAX_LOCATIONS_HISTORY = 50;
|
||||
@ -82,22 +99,72 @@ end;
|
||||
|
||||
procedure TMainForm.BtnSearchClick(Sender: TObject);
|
||||
begin
|
||||
MapView.Center := GeoNames.Search(CbLocations.Text, MapView.DownloadEngine);
|
||||
{
|
||||
// MapView.Center := GeoNames.Search(CbLocations.Text, MapView.DownloadEngine);
|
||||
|
||||
ClearFoundLocations;
|
||||
GeoNames.LocationName := CbLocations.Text;
|
||||
GeoNames.ListLocations(MapView.DownloadEngine);
|
||||
// GeoNames.LocationName := CbLocations.Text;
|
||||
GeoNames.Search(CbLocations.Text, MapView.DownloadEngine);
|
||||
// GeoNames.ListLocations(MapView.DownloadEngine);
|
||||
//CbFoundLocations.Text := CbFoundLocations.Items[0];
|
||||
UpdateDropdownWidth(CbFoundLocations);
|
||||
}
|
||||
UpdateLocationHistory(CbLocations.Text);
|
||||
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);
|
||||
begin
|
||||
MapView.DoubleBuffered := CbDoubleBuffer.Checked;
|
||||
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);
|
||||
begin
|
||||
MapView.MapProvider := CbProviders.Text;
|
||||
@ -108,6 +175,18 @@ begin
|
||||
MapView.UseThreads := CbUseThreads.Checked;
|
||||
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);
|
||||
begin
|
||||
ForceDirectories(HOMEDIR + 'cache/');
|
||||
@ -134,12 +213,22 @@ begin
|
||||
MapView.Active := true;
|
||||
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;
|
||||
X, Y: Integer);
|
||||
var
|
||||
rPt: TRealPoint;
|
||||
begin
|
||||
rPt := MapView.ScreenToLonLat(Point(X, Y));
|
||||
(*
|
||||
p := MapView.GetMouseMapPixel(X, Y);
|
||||
LblZoom.Caption := Format('Pixel: %d:%d', [p.X, p.Y]);
|
||||
@ -147,6 +236,8 @@ begin
|
||||
Label3.Caption := Format('Tile: %d:%d', [p.X, p.Y]);
|
||||
r := mv.GetMouseMapLongLat(X, Y);
|
||||
*)
|
||||
|
||||
rPt := MapView.ScreenToLonLat(Point(X, Y));
|
||||
InfoPositionLongitude.Caption := Format('%.6f°', [rPt.Lon]);
|
||||
InfoPositionLatitude.Caption := Format('%.6f°', [rPt.Lat]);
|
||||
|
||||
@ -207,6 +298,33 @@ begin
|
||||
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);
|
||||
var
|
||||
idx: Integer;
|
||||
|
||||
@ -37,7 +37,7 @@ type
|
||||
|
||||
TMVDEFPC = class(TMvCustomDownloadEngine)
|
||||
protected
|
||||
procedure DownloadFile(const Url: string; str: TStream); override;
|
||||
procedure DownloadFile(const Url: string; AStream: TStream); override;
|
||||
{$IF FPC_FullVersion >= 30101}
|
||||
published
|
||||
property UseProxy;
|
||||
@ -56,7 +56,7 @@ uses
|
||||
|
||||
{ TMVDEFPC }
|
||||
|
||||
procedure TMVDEFPC.DownloadFile(const Url: string; str: TStream);
|
||||
procedure TMVDEFPC.DownloadFile(const Url: string; AStream: TStream);
|
||||
var
|
||||
http: TFpHttpClient;
|
||||
begin
|
||||
@ -73,8 +73,8 @@ begin
|
||||
http.Proxy.Password := ProxyPassword;
|
||||
end;
|
||||
{$ENDIF}
|
||||
http.Get(Url, str);
|
||||
str.Position := 0;
|
||||
http.Get(Url, AStream);
|
||||
AStream.Position := 0;
|
||||
finally
|
||||
http.Free;
|
||||
end;
|
||||
|
||||
@ -40,7 +40,7 @@ implementation
|
||||
|
||||
procedure TMvCustomDownloadEngine.DownloadFile(const Url: string; AStream: TStream);
|
||||
begin
|
||||
|
||||
// to be overridden...
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -80,8 +80,7 @@ Type
|
||||
function GetUseThreads: Boolean;
|
||||
function GetWidth: integer;
|
||||
function GetZoom: integer;
|
||||
function IsValidTile(const aWin: TMapWindow; const aTile: TTIleId
|
||||
): boolean;
|
||||
function IsValidTile(const aWin: TMapWindow; const aTile: TTIleId): boolean;
|
||||
procedure MoveMapCenter(Sender: TDragObj);
|
||||
procedure SetActive(AValue: boolean);
|
||||
procedure SetCacheOnDisk(AValue: Boolean);
|
||||
@ -687,43 +686,46 @@ begin
|
||||
Result:=Inttostr(Id.X)+'.'+inttostr(Id.Y)+'.'+inttostr(Id.Z);
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.evDownload(Data : TObject;Job : TJob);
|
||||
var Id : TTileId;
|
||||
Url : String;
|
||||
Env : TEnvTile;
|
||||
MapO : TMapProvider;
|
||||
FStream : TMemoryStream;
|
||||
Begin
|
||||
Env:=TEnvTile(Data);
|
||||
Id:=Env.Tile;
|
||||
MapO:=Env.Win.MapProvider;
|
||||
procedure TMapViewerEngine.evDownload(Data: TObject; Job: TJob);
|
||||
var
|
||||
Id: TTileId;
|
||||
Url: String;
|
||||
Env: TEnvTile;
|
||||
MapO: TMapProvider;
|
||||
lStream: TMemoryStream;
|
||||
begin
|
||||
Env := TEnvTile(Data);
|
||||
Id := Env.Tile;
|
||||
MapO := Env.Win.MapProvider;
|
||||
if Assigned(MapO) then
|
||||
Begin
|
||||
if not(Cache.InCache(MapO,Id)) then
|
||||
Begin
|
||||
begin
|
||||
if not Cache.InCache(MapO, Id) then
|
||||
begin
|
||||
if Assigned(FDownloadEngine) then
|
||||
begin
|
||||
Url:=MapO.GetUrlForTile(Id);
|
||||
Url := MapO.GetUrlForTile(Id);
|
||||
if Url<>'' then
|
||||
begin
|
||||
FStream:=TMemoryStream.Create;
|
||||
Try
|
||||
Try
|
||||
FDownloadEngine.DownloadFile(Url,Fstream);
|
||||
Cache.Add(MapO,Id,FStream);
|
||||
lStream := TMemoryStream.Create;
|
||||
try
|
||||
try
|
||||
FDownloadEngine.DownloadFile(Url, lStream);
|
||||
Cache.Add(MapO, Id, lStream);
|
||||
except
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(FStream);
|
||||
FreeAndNil(lStream);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Job.Cancelled then
|
||||
Exit;
|
||||
|
||||
if DrawTitleInGuiThread then
|
||||
Queue.QueueAsyncCall(@TileDownloaded,PtrInt(Env))
|
||||
Queue.QueueAsyncCall(@TileDownloaded, PtrInt(Env))
|
||||
else
|
||||
TileDownloaded(PtrInt(Env));
|
||||
end;
|
||||
@ -754,17 +756,17 @@ end;
|
||||
|
||||
function TMapViewerEngine.GetYahooSvr(id: integer): String;
|
||||
Begin
|
||||
Result:=inttostr(id+1);
|
||||
Result := IntToStr(id+1);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetYahooY(const Tile : TTileId): string;
|
||||
Begin
|
||||
Result :=inttostr( - (Tile.Y - (1 shl Tile.Z) div 2) - 1);
|
||||
Result := IntToStr( -(Tile.Y - (1 shl Tile.Z) div 2) - 1);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetYahooZ(const Tile : TTileId): string;
|
||||
Begin
|
||||
result:=inttostr(Tile.Z+1);
|
||||
result := IntToStr(Tile.Z+1);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetQuadKey(const Tile : TTileId): string;
|
||||
@ -788,39 +790,37 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Type
|
||||
|
||||
{ TMemObj }
|
||||
|
||||
type
|
||||
TMemObj = Class
|
||||
private
|
||||
FWin : TMapWindow;
|
||||
public
|
||||
constructor Create(const aWin : TMapWindow);
|
||||
End;
|
||||
|
||||
{ TMemObj }
|
||||
end;
|
||||
|
||||
constructor TMemObj.Create(const aWin: TMapWindow);
|
||||
begin
|
||||
FWin:=aWin;
|
||||
FWin := aWin;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMapViewerEngine.MoveMapCenter(Sender: TDragObj);
|
||||
var old : TMemObj;
|
||||
nCenter : TRealPoint;
|
||||
Job : TJob;
|
||||
aPt : TPoint;
|
||||
var
|
||||
old: TMemObj;
|
||||
nCenter: TRealPoint;
|
||||
Job: TJob;
|
||||
aPt: TPoint;
|
||||
Begin
|
||||
if Sender.LnkObj=nil then
|
||||
Begin
|
||||
Sender.LnkObj:=TMemObj.Create(MapWin);
|
||||
begin
|
||||
Sender.LnkObj := TMemObj.Create(MapWin);
|
||||
end;
|
||||
old:=TMemObj(Sender.LnkObj);
|
||||
aPt.X:=old.FWin.Width DIV 2-Sender.OfsX;
|
||||
aPt.Y:=old.FWin.Height DIV 2-Sender.OfsY;
|
||||
nCenter:=MapWinToLonLat(old.FWin,aPt);
|
||||
old := TMemObj(Sender.LnkObj);
|
||||
aPt.X := old.FWin.Width DIV 2-Sender.OfsX;
|
||||
aPt.Y := old.FWin.Height DIV 2-Sender.OfsY;
|
||||
nCenter := MapWinToLonLat(old.FWin,aPt);
|
||||
SetCenter(nCenter);
|
||||
end;
|
||||
|
||||
@ -838,16 +838,15 @@ end;
|
||||
|
||||
procedure TMapViewerEngine.DoDrag(Sender: TDragObj);
|
||||
begin
|
||||
if Sender.DragSrc=self then
|
||||
Begin
|
||||
if Sender.DragSrc = self then
|
||||
MoveMapCenter(Sender);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.CancelCurrentDrawing;
|
||||
var Jobs : TJobArray;
|
||||
var
|
||||
Jobs: TJobArray;
|
||||
begin
|
||||
Jobs:=Queue.CancelAllJob(self);
|
||||
Jobs := Queue.CancelAllJob(self);
|
||||
Queue.WaitForTerminate(Jobs);
|
||||
end;
|
||||
|
||||
@ -856,22 +855,21 @@ begin
|
||||
Redraw(MapWin);
|
||||
end;
|
||||
|
||||
|
||||
function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String;
|
||||
MinZoom : integer;MaxZoom : integer;
|
||||
NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr;
|
||||
GetYStr: TGetValStr; GetZStr: TGetValStr) : TMapProvider;
|
||||
var idx :integer;
|
||||
Begin
|
||||
idx:=lstProvider.IndexOf(OpeName);
|
||||
if idx=-1 then
|
||||
Begin
|
||||
result:=TMapProvider.Create(OpeName);
|
||||
lstProvider.AddObject(OpeName,result);
|
||||
idx := lstProvider.IndexOf(OpeName);
|
||||
if idx = -1 then
|
||||
begin
|
||||
Result := TMapProvider.Create(OpeName);
|
||||
lstProvider.AddObject(OpeName, Result);
|
||||
end
|
||||
else
|
||||
result:=TMapProvider(lstProvider.Objects[idx]);
|
||||
result.AddUrl(Url,NbSvr,MinZoom,MaxZoom,GetSvrStr,GetXStr,GetYStr,GetZStr);
|
||||
Result := TMapProvider(lstProvider.Objects[idx]);
|
||||
Result.AddUrl(Url, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr);
|
||||
end;
|
||||
|
||||
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/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('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);
|
||||
@ -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 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('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;
|
||||
|
||||
procedure TMapViewerEngine.DrawTile(const TileId : TTileId;X, Y: integer; TileImg: TLazIntfImage);
|
||||
procedure TMapViewerEngine.DrawTile(const TileId: TTileId; X, Y: integer;
|
||||
TileImg: TLazIntfImage);
|
||||
begin
|
||||
if Assigned(FOnDrawTile) then
|
||||
FOnDrawTile(TileId,X,Y,TileImg);
|
||||
FOnDrawTile(TileId, X, Y, TileImg);
|
||||
end;
|
||||
|
||||
constructor TMapViewerEngine.Create(aOwner: TComponent);
|
||||
|
||||
@ -30,13 +30,33 @@ type
|
||||
|
||||
TStringArray = array of string;
|
||||
|
||||
TResRec = record
|
||||
Name: String;
|
||||
Descr: String;
|
||||
Loc: TRealPoint;
|
||||
end;
|
||||
|
||||
|
||||
{ TMVGeoNames }
|
||||
|
||||
TMVGeoNames = class(TComponent)
|
||||
private
|
||||
FLocationName: string;
|
||||
FInResTable: Boolean;
|
||||
FInDataRows: Boolean;
|
||||
FNamePending: Boolean;
|
||||
FLongitudePending: Boolean;
|
||||
FLatitudePending: Boolean;
|
||||
FCol: Integer;
|
||||
FCountry: String;
|
||||
FSmall: Boolean;
|
||||
FFirstLocation: TResRec;
|
||||
FFoundLocation: TResRec;
|
||||
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
|
||||
function Search(ALocationName: String;
|
||||
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
|
||||
@ -48,6 +68,13 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
FastHtmlParser;
|
||||
|
||||
const
|
||||
SEARCH_URL = 'http://geonames.org/search.html?q=%s'; //&country=%s';
|
||||
|
||||
|
||||
function CleanLocationName(x: string): string;
|
||||
var
|
||||
i: Integer;
|
||||
@ -62,24 +89,122 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TMVGeoNames }
|
||||
|
||||
Type
|
||||
TResRec = record
|
||||
Name: String;
|
||||
Descr: String;
|
||||
Loc: TRealPoint;
|
||||
End;
|
||||
procedure TMvGeoNames.FoundTagHandler(NoCaseTag, ActualTag: String);
|
||||
begin
|
||||
if not FInResTable and (NoCaseTag = '<TABLE CLASS="RESTABLE">') then begin
|
||||
FInResTable := true;
|
||||
FInDataRows := false;
|
||||
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;
|
||||
var iStart,iEnd,i : Integer;
|
||||
tmp : String;
|
||||
lst : TStringList;
|
||||
Begin
|
||||
SetLength(Result,0);
|
||||
tmp:=StringReplace(str,'<br>',#13,[rfReplaceall]);
|
||||
tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]);
|
||||
tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]);
|
||||
tmp := StringReplace(str,'<br>',#13,[rfReplaceall]);
|
||||
tmp := StringReplace(tmp,' ',' ',[rfReplaceall]);
|
||||
tmp := StringReplace(tmp,' ',' ',[rfReplaceall]);
|
||||
repeat
|
||||
iEnd:=-1;
|
||||
iStart:=pos('<',tmp);
|
||||
@ -103,7 +228,7 @@ Begin
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
*)
|
||||
function TMVGeoNames.Search(ALocationName: String;
|
||||
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
|
||||
const
|
||||
@ -131,24 +256,27 @@ var
|
||||
end;
|
||||
|
||||
var
|
||||
m: TMemoryStream;
|
||||
ms: TMemoryStream;
|
||||
iRes,i : integer;
|
||||
lstRes : Array of TResRec;
|
||||
iStartDescr : integer;
|
||||
lst : TStringArray;
|
||||
url: String;
|
||||
begin
|
||||
FLocationName := ALocationName;
|
||||
m := TMemoryStream.Create;
|
||||
ms := TMemoryStream.Create;
|
||||
try
|
||||
ADownloadEngine.DownloadFile('http://www.geonames.org/search.html?q='+
|
||||
CleanLocationName(FLocationName), m);
|
||||
m.Position := 0;
|
||||
SetLength(s, m.Size);
|
||||
m.Read(s[1], m.Size);
|
||||
url := Format(SEARCH_URL, [CleanLocationName(FLocationName)]);
|
||||
ADownloadEngine.DownloadFile(url, ms);
|
||||
ms.Position := 0;
|
||||
SetLength(s, ms.Size);
|
||||
ms.Read(s[1], ms.Size);
|
||||
finally
|
||||
m.Free;
|
||||
ms.Free;
|
||||
end;
|
||||
|
||||
Result := Parse(PChar(s));
|
||||
(*
|
||||
Result.Lon := 0;
|
||||
Result.Lat := 0;
|
||||
SetLength(lstRes, 0);
|
||||
@ -174,9 +302,9 @@ begin
|
||||
iRes := PosEx('<span class="geo"',s,iRes+17);
|
||||
end;
|
||||
|
||||
if length(lstRes)>0 then
|
||||
if Length(lstRes) > 0 then
|
||||
begin
|
||||
if length(lstRes)>1 then
|
||||
if Length(lstRes) > 1 then
|
||||
begin
|
||||
Result.Lon := Result.Lon/length(lstRes);
|
||||
Result.Lat := Result.Lat/length(lstRes);
|
||||
@ -184,9 +312,10 @@ begin
|
||||
if Assigned(FOnNameFound) then
|
||||
for iRes:=low(lstRes) to high(lstRes) do
|
||||
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.
|
||||
|
||||
@ -318,12 +318,12 @@ end;
|
||||
procedure TjobQueue.InitThreads;
|
||||
var i : integer;
|
||||
begin
|
||||
Jobs:=TObjectList.Create(true);
|
||||
Threads:=TObjectList.Create(true);
|
||||
FEvent:=TEvent.Create(nil,true,false,'');
|
||||
FSect:=TCriticalSection.Create;
|
||||
Jobs := TObjectList.Create(true);
|
||||
Threads := TObjectList.Create(true);
|
||||
FEvent := TEvent.Create(nil,true,false,'');
|
||||
FSect := TCriticalSection.Create;
|
||||
TerminatedThread := 0;
|
||||
For i:=1 to FNbThread do
|
||||
for i:=1 to FNbThread do
|
||||
Threads.Add(TQueueThread.Create(self));
|
||||
end;
|
||||
|
||||
@ -476,9 +476,9 @@ end;
|
||||
|
||||
constructor TjobQueue.Create(NbThread: integer);
|
||||
begin
|
||||
waitings:=TStringList.create;
|
||||
FNbThread:=NbThread;
|
||||
FMainThreadId:=GetCurrentThreadId;
|
||||
waitings := TStringList.create;
|
||||
FNbThread := NbThread;
|
||||
FMainThreadId := GetCurrentThreadId;
|
||||
end;
|
||||
|
||||
destructor TjobQueue.Destroy;
|
||||
|
||||
Reference in New Issue
Block a user