Serveur de tuiles distant

procedure TForm1.FormCreate(Sender: TObject);
begin

// create tile server ( unit uECNativeTileServer )
FMapServer := TNativeMapServer.Create(nil);
FMapServer.OnLoadTile := doOnLoadTile;
FMapServer.TileServer := tsOSM;

// create WebSocket server
server := TIdWebsocketServer.Create(Self);
server.SocketIO.OnSocketIOMsg := doMessage;

end;


// request tile from client : ^Tile|x|y|z
procedure TForm1.doMessage(const ASocket: ISocketIOContext; const aText:string; const aCallback: ISocketIOCallback) ;
var Text:string;
sxStream:TMemoryStream;
ix,iy,iz,isz:integer;
begin

TThread.synchronize(nil,
procedure
begin

Text := aText;

if pos('^Tile',text)>0 then
begin
StrToken(text,'|');

ix:=StrToIntDef(StrToken(text,'|'),0);
iy:=StrToIntDef(StrToken(text,'|'),0);
iz:=StrToIntDef(StrToken(text,'|'),0);
sxStream:=TMemoryStream.Create;

// request tile
if FMapServer.GetStreamTile(sxStream,ix,iy,iz) then
begin
// if tile is ready send to client
ASocket.Send('^Tile|'+inttostr(ix)+'|'+inttostr(iy)+'|'+inttostr(iz)+'|'+EncodeStreamTo64(sxStream));
end;

sxStream.Free;
end;

end);
end;


// tile is ready now, send to clients
procedure TForm1.doOnLoadTile(sender: TObject; const x, y, z, t: integer);
var TileStream: TMemoryStream;
begin

TThread.synchronize(nil,
procedure
begin

// send response : ^Tile|x|y|z|Base64-Stream-Data-Tile
server.SendMessageToAll('^Tile|'+inttostr(x)+'|'+inttostr(y)+'|'+inttostr(z)+'|'+EncodeStreamTo64(TileStream));

end);


end;


// connect / deconnect server
procedure TForm1.btConnectClick(Sender: TObject);
begin

if not Server.Active then
begin
Server.DefaultPort:=StrtoIntDef(edPortServer.Text, 8080);
end;
Server.Active:=not Server.Active;
if Server.Active then btConnect.Caption:='Stop server' else btConnect.Caption:='Start server';

end;

// set cache
procedure TForm1.ckCacheClick(Sender: TObject);
begin
if ckCache.Checked then
begin
FMapServer.LocalCache:=edCache.Text;
end else
begin
FMapServer.LocalCache:='';
end;
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if CanClose then
begin
FMapServer.Free;
end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin

// manual management tiles as stream
map.TileServerInfo.getTileStream := getTileStream;
// the name will be uses as subdirectory in cache
map.TileServerInfo.Name := 'MyMAP';
// important to specify a manual management tiles
map.TileServer := tsOwnerDraw;


// create WebSocket clients for communication with server
client := TidHTTPWebSocketClient.Create(self);
client.SocketIOCompatible := true;
client.SocketIO.OnSocketIOMsg := doMessage;


end;


// asks for a tile
procedure TForm2.getTileStream(const ThreadIndex:integer;var TileStream: TMemoryStream;
const x, y, z: integer);
begin

// send request to the server : ^Tile|x|y|z
client.SocketIO.Send('^Tile|' + inttostr(x) + '|' + inttostr(y) + '|' + inttostr(z));

end;



// response from server, get tile : ^Tile|x|y|z|Base64-Stream-Data-Tile
procedure TForm2.doMessage(const ASocket: ISocketIOContext; const aText: string;
const aCallback: ISocketIOCallback);
var
Text: string;
sxStream: TMemoryStream;
ix, iy, iz: integer;
begin


Text := aText;

if pos('^Tile', Text) > 0 then
begin
StrToken(Text, '|');
ix := StrToIntDef(StrToken(Text, '|'), 0);
iy := StrToIntDef(StrToken(Text, '|'), 0);
iz := StrToIntDef(StrToken(Text, '|'), 0);
sxStream := TMemoryStream.Create;
if Decode64ToStream(Text, sxStream) then
begin
map.AddStreamTile(sxStream, ix, iy, iz);
end;
sxStream.Free;
end;


end;



// connect / deconnect from server
procedure TForm2.btConnectClick(Sender: TObject);
begin

if not client.Connected then
begin
client.Host := edIPServer.Text;
client.Port := StrToIntDef(edPortServer.Text, 8080);
client.Connect;

map.invalidate;
end
else
begin
client.Disconnect(false);
client2.Disconnect(false);
end;

if client.Connected then btConnect.Caption:='Stop client' else btConnect.Caption:='Start client';

end;

// set cache
procedure TForm2.ckCacheClick(Sender: TObject);
begin
if ckCache.Checked then
begin
Map.LocalCache:=edCache.Text;
end else
begin
Map.LocalCache:='';
end;
end;