WebOSMaps ScreenShot functionality

Thanks for the fast response, Bart.



I've tried this with my own App first, but have now replicated the problem within the WebOSMaps demo. The following code is attached to a button I added to the standard demo. I did try adding ProcessMessages with only partial success (see image). The code uses recursion to parse a quadtree, creating a map file at each level, and then generating four tiles from it, and so on until the maximum "depth of zoom" is reached. For the purposes of the demo version, I have stripped out the quadtree functionality, replacing it with simple calculations to define the centre of each map tile and zoomlevel.



Even with ProcessMessages none of the files is a complete image.



Cheers, Paul



procedure TFrmMain.BGenerateClick(Sender: TObject);



function GenerateActiveMap (Lat, Lon : Double; Zoom, MaxZoom : Integer; FilePath : String) : Boolean;

var

n : Integer;

LatNew, LonNew : Double;

FileName : String;

NewMap : Char;

Graphic: TGraphic;



begin

with WebOSMaps1 do begin

    MapPanTo(Lat, Lon);

    MapOptions.ZoomMap := Zoom;

    // Application.ProcessMessages;

    Graphic := WebOSMaps1.ScreenShot(itPng);

    FileName := ChangeFileExt (ExtractFileName (FilePath), '');

    if Trim(FileName) = '' then

      FilePath := ExtractFilePath (FilePath) + 'index.png';

    try

      Graphic.SaveToFile(FilePath);

    finally

      Graphic.Free;

    end;

end;

if Zoom >= MaxZoom then

    Exit;

for n := 1 to 4 do begin

    NewMap := Char ($60 + n);

    case n of

      1: begin

        LatNew := Lat + 90 / (Zoom + 1);

        LonNew := Lon - 180 / (Zoom + 1);

      end;

      2: begin

        LatNew := Lat + 90 / (Zoom + 1);

        LonNew := Lon + 180 / (Zoom + 1);

      end;

      3 : begin

        LatNew := Lat - 90 / (Zoom + 1);

        LonNew := Lon + 180 / (Zoom + 1);

      end;

      4 : begin

        LatNew := Lat - 90 / (Zoom + 1);

        LonNew := Lon - 180 / (Zoom + 1);

      end;

    end;

    GenerateActiveMap (LatNew, LonNew, Zoom + 1, MaxZoom, ExtractFilePath (FilePath) + FileName + NewMap + '.png');

end;

end; {GenerateActiveMap}



var

MaxZoom : Integer;



begin

MaxZoom := 5;

with SavePictureDialog1 do begin

    if Execute then begin

      GenerateActiveMap (0.00, 0.00, 1, MaxZoom, ExtractFilePath (FileName));

    end;

end;

end;





Image Link