diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index 3fdc92cfa..77818ca71 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/components/lazmapviewer/example/main.lfm @@ -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 diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas index 9fd1b5472..e9e4119a0 100644 --- a/components/lazmapviewer/example/main.pas +++ b/components/lazmapviewer/example/main.pas @@ -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,8 +236,10 @@ 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]); + InfoPositionLatitude.Caption := Format('%.6f°', [rPt.Lat]); rPt := MapView.Center; InfoCenterLongitude.Caption := Format('%.6f°', [rPt.Lon]); @@ -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; diff --git a/components/lazmapviewer/source/mvdlefpc.pas b/components/lazmapviewer/source/mvdlefpc.pas index b22b3122e..dfc1b3fc3 100644 --- a/components/lazmapviewer/source/mvdlefpc.pas +++ b/components/lazmapviewer/source/mvdlefpc.pas @@ -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; diff --git a/components/lazmapviewer/source/mvdownloadengine.pas b/components/lazmapviewer/source/mvdownloadengine.pas index 62afc1951..c02b3a9c1 100644 --- a/components/lazmapviewer/source/mvdownloadengine.pas +++ b/components/lazmapviewer/source/mvdownloadengine.pas @@ -40,7 +40,7 @@ implementation procedure TMvCustomDownloadEngine.DownloadFile(const Url: string; AStream: TStream); begin - + // to be overridden... end; end. diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 5bab188e9..952e56599 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -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,45 +686,48 @@ 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; - if Assigned(MapO) then - Begin - if not(Cache.InCache(MapO,Id)) then - Begin - if Assigned(FDownloadEngine) then - begin - Url:=MapO.GetUrlForTile(Id); - if Url<>'' then - begin - FStream:=TMemoryStream.Create; - Try - Try - FDownloadEngine.DownloadFile(Url,Fstream); - Cache.Add(MapO,Id,FStream); - except - end; - finally - FreeAndNil(FStream); - end; - end; - end; - end; - end; - if Job.Cancelled then - Exit; - if DrawTitleInGuiThread then - Queue.QueueAsyncCall(@TileDownloaded,PtrInt(Env)) - else - TileDownloaded(PtrInt(Env)); +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 + if Assigned(FDownloadEngine) then + begin + Url := MapO.GetUrlForTile(Id); + if Url<>'' then + begin + lStream := TMemoryStream.Create; + try + try + FDownloadEngine.DownloadFile(Url, lStream); + Cache.Add(MapO, Id, lStream); + except + end; + finally + FreeAndNil(lStream); + end; + end; + end; + end; + end; + + if Job.Cancelled then + Exit; + + if DrawTitleInGuiThread then + Queue.QueueAsyncCall(@TileDownloaded, PtrInt(Env)) + else + TileDownloaded(PtrInt(Env)); end; procedure TMapViewerEngine.TileDownloaded(Data: PtrInt); @@ -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 } - TMemObj = Class - private - FWin : TMapWindow; - public - constructor Create(const aWin : TMapWindow); - End; - -{ TMemObj } +type + TMemObj = Class + private + FWin : TMapWindow; + public + constructor Create(const aWin : TMapWindow); + 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); diff --git a/components/lazmapviewer/source/mvgeonames.pas b/components/lazmapviewer/source/mvgeonames.pas index a39634c84..5d5d7c18c 100644 --- a/components/lazmapviewer/source/mvgeonames.pas +++ b/components/lazmapviewer/source/mvgeonames.pas @@ -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 = '') then begin + FInResTable := true; + FInDataRows := false; + FNamePending := false; + FLatitudePending := false; + FLongitudePending := false; + FSmall := false; + end else + if FInResTable and (NoCaseTag = '
') then + FInResTable := false; + if FInResTable then begin + if NoCaseTag = '' then + FInDataRows := true; + + if FInDataRows then begin + if NoCaseTag = '' then begin + FCol := 0; + with FFoundLocation do begin + Name := ''; Descr := ''; Loc.Lon := 0; Loc.Lat := 0; + end; + end; + + if NoCaseTag = '' then + inc(FCol); + + if FCol = 2 then begin + if not FNamePending and (pos('') then + FNamePending := false; + + if not FLatitudePending and (NoCaseTag = '') then + FLatitudePending := true + else if FLatitudePending and (NoCaseTag = '') then + FLatitudePending := false; + + if not FLongitudePending and (NoCaseTag = '') then + FLongitudePending := true + else if FLongitudePending and (NoCasetag = '') then + FLongitudePending := false; + end; + + if FCol = 3 then + if not FSmall and (NoCaseTag = '') then + FSmall := true + else if FSmall and (NoCaseTag = '') then + FSmall := false; + + if NoCaseTag = '' 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,'
',#13,[rfReplaceall]); - tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]); - tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]); + tmp := StringReplace(str,'
',#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('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. diff --git a/components/lazmapviewer/source/mvjobqueue.pas b/components/lazmapviewer/source/mvjobqueue.pas index ac806fcff..dbff3ab24 100644 --- a/components/lazmapviewer/source/mvjobqueue.pas +++ b/components/lazmapviewer/source/mvjobqueue.pas @@ -318,13 +318,13 @@ 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 - Threads.Add(TQueueThread.Create(self)); + for i:=1 to FNbThread do + Threads.Add(TQueueThread.Create(self)); end; procedure TjobQueue.FreeThreads; @@ -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; @@ -492,9 +492,9 @@ end; procedure TjobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt); begin if UseThreads then - Application.QueueAsyncCall(aMethod,Data) + Application.QueueAsyncCall(aMethod,Data) else - AMethod(Data); + AMethod(Data); end;