unit webmapserver;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Graphics, mvengine, mvdrawingengine, mvtypes,
mvmapprovider, IntfGraphics, FileUtil, LazFileUtils, Dialogs;
type
TMapServer = class(TComponent)
private
Width: Integer;
Height: Integer;
Engine: TMapViewerEngine;
DrawingEngine: TMvCustomDrawingEngine;
BuiltinDrawingEngine: TMvCustomDrawingEngine;
protected
procedure DoDrawTile(const TileId: TTileId; X, Y: Integer; TileImg: TLazIntfImage);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetMapProvider(aValue: String);
procedure GetMapImage(Lon, Lat: Double; W, H, Z: Integer; var aBitmap: TBitmap);
end;
implementation
uses
mvde_intfgraphics, mvdlefpc;
constructor TMapServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 300;
Height := 300;
Engine := TMapViewerEngine.Create(self);
Engine.CachePath := SysUtils.GetTempDir(False) + 'cache/';
Engine.CacheOnDisk := true;
Engine.UseThreads := True;
Engine.MapProvider:= 'OpenStreetMap Mapnik';
Engine.OnDrawTile := @DoDrawTile;
Engine.DrawTitleInGuiThread := false;
Engine.DownloadEngine := TMvDEFpc.Create(self);
Engine.DownloadEngine.Name := 'BuiltInDLE';
BuiltinDrawingEngine := TMvIntfGraphicsDrawingEngine.Create(self);
BuiltinDrawingEngine.Name := 'BuiltInDE';
BuiltinDrawingEngine.CreateBuffer(Width, Height);
DrawingEngine := BuiltinDrawingEngine;
end;
destructor TMapServer.Destroy;
begin
if DeleteDirectory(Engine.CachePath, True) then
RemoveDirUTF8(Engine.CachePath);
inherited Destroy;
end;
procedure TMapServer.DoDrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TLazIntfImage);
begin
if Assigned(TileImg) then begin
DrawingEngine.DrawLazIntfImage(X, Y, TileImg);
end
else begin
DrawingEngine.BrushColor := clWhite;
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
end;
procedure TMapServer.SetMapProvider(aValue: String);
begin
try
Engine.MapProvider := aValue;
except
raise;
end;
end;
procedure TMapServer.GetMapImage(Lon, Lat: Double; W, H, Z: Integer;
var aBitmap:TBitmap);
var
LonLat: TRealPoint;
TmpBitmap: TBitmap;
begin
if aBitmap = nil then exit;
Engine.Active := False;
Engine.Zoom := Z;
LonLat.Lon := Lon;
LonLat.Lat := Lat;
Engine.Center := LonLat;
Engine.SetSize(W, H);
DrawingEngine.CreateBuffer(W, H);
Engine.Active := True;
Engine.Jobqueue.WaitAllJobTerminated(Engine);
TmpBitmap := DrawingEngine.SaveToImage(TBitmap) as TBitmap;
Engine.Active := False;
with aBitmap do
begin
if (Width <> W) or (Height <> H) then SetSize(W, H);
Canvas.Draw(0,0,TmpBitmap);
end;
end;
end.