Umapalbum.pas

{***************************************************************************}
{ TMS Map Album demo                                                        }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2026                                               }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit Umapalbum;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VCL.TMSFNCTypes, VCL.TMSFNCUtils,
  VCL.TMSFNCGraphics, VCL.TMSFNCGraphicsTypes, VCL.TMSFNCMapsCommonTypes,
  Vcl.StdCtrls, VCL.TMSFNCCustomControl, VCL.TMSFNCWebBrowser, VCL.TMSFNCMaps,
  Vcl.ExtCtrls, Vcl.ComCtrls;

type
  TMapAlbumForm = class(TForm)
    Panel1: TPanel;
    TMSFNCMaps1: TTMSFNCMaps;
    openImage: TOpenDialog;
    btnAddPhotos: TButton;
    btnAddRoutes: TButton;
    openRoute: TOpenDialog;
    btnClear: TButton;
    ColorDialog1: TColorDialog;
    clrPanel: TPanel;
    pbLoading: TProgressBar;
    procedure btnAddPhotosClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnAddRoutesClick(Sender: TObject);
    procedure clrPanelClick(Sender: TObject);
    procedure TMSFNCMaps1MapInitialized(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Coords: TTMSFNCMapsBoundsRec;
  end;

var
  MapAlbumForm: TMapAlbumForm;

implementation

{$R *.dfm}

uses
  jpeg, System.NetEncoding, EXIF4D;


function JpegToBase64(const AJpegFileName: string; Width: integer): string;
var
  Src: TJPEGImage;
  DstBmp: TBitmap;
  DstJpg: TJPEGImage;
  OutStream: TMemoryStream;
  NewHeight: Integer;
  NewWidth: Integer;
begin
  Src := TJPEGImage.Create;
  DstBmp := TBitmap.Create;
  DstJpg := TJPEGImage.Create;
  OutStream := TMemoryStream.Create;

  NewWidth := Width;

  try
    Src.LoadFromFile(AJpegFileName);

    if Src.Width <= 0 then
      raise Exception.Create('Invalid JPEG width.');

    NewHeight := Round(Src.Height * NewWidth / Src.Width);

    DstBmp.SetSize(NewWidth, NewHeight);
    DstBmp.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), Src);

    DstJpg.Assign(DstBmp);
    DstJpg.CompressionQuality := 85;
    DstJpg.SaveToStream(OutStream);

    OutStream.Position := 0;

    Result :=
      'data:image/jpeg;base64,' +
      TNetEncoding.Base64.EncodeBytesToString(
        OutStream.Memory,
        OutStream.Size
      );
  finally
    OutStream.Free;
    DstJpg.Free;
    DstBmp.Free;
    Src.Free;
  end;
end;

function AddImageOnMap(Map: TTMSFNCMaps; fname: string; idx: integer; var Coords: TTMSFNCMapsBoundsRec): boolean;
var
  img: TAdvCloudExifImage;
  m: TTMSFNCMapsMarker;
  lon,lat: double;
begin
  Result := false;

  img := TAdvCloudExifImage.Create(MapAlbumForm);

  try
    img.AutoLoad := false;
    img.FileName := fname;
    img.LoadData;

    if img.HasGPSData then
    begin
      lon := img.Longitude;
      lat := img.Latitude;

      outputdebugstring(pchar(Format('%.6f //  %.6f',[img.Longitude, img.Latitude])));

      if Coords.NorthEast.Longitude = 200 then
        Coords.NorthEast.Longitude := lon;
      if Coords.NorthEast.Latitude = 200 then
        Coords.NorthEast.Latitude := lat;
      if Coords.SouthWest.Longitude = 200 then
        Coords.SouthWest.Longitude := lon;
      if Coords.SouthWest.Latitude = 200 then
        Coords.SouthWest.Latitude := lat;

      if img.Longitude > Coords.NorthEast.Longitude then
        Coords.NorthEast.Longitude := lon;

      if img.Longitude < Coords.SouthWest.Longitude then
        Coords.SouthWest.Longitude := lon;

      if img.Latitude > Coords.NorthEast.Latitude then
        Coords.NorthEast.Latitude := lat;

      if img.Latitude < Coords.SouthWest.Latitude then
        Coords.SouthWest.Latitude := lat;

      Result := true;
      m := Map.AddMarker(lat,lon);
      m.IconURL := JpegToBase64(fname, 240);
    end;
  finally
    img.Free;
  end;
end;

procedure ClearCoords(var Coords: TTMSFNCMapsBoundsRec);
begin
  // set coords outside valid range to indicate it is uninitialized
  Coords.NorthEast.Longitude := 200;
  Coords.NorthEast.Latitude := 200;
  Coords.SouthWest.Longitude := 200;
  Coords.SouthWest.Latitude := 200;
end;

procedure TMapAlbumForm.btnAddPhotosClick(Sender: TObject);
var
  i: integer;
  res,hasgps: boolean;
begin
  if openImage.Execute and (openImage.Files.Count > 0) then
  begin
    hasgps := false;
    pbLoading.Max := openImage.Files.Count;

    for i := 0 to openImage.Files.Count - 1 do
    begin
      pbLoading.Position := i + 1;

      res := AddImageOnMap(TMSFNCMaps1, openImage.Files[i], i, Coords);
      if res then
        hasgps := true;
    end;

    pbLoading.Position := 0;

    if not hasgps then
    begin
      ShowMessage('Sorry, no images with GPS data found');
    end
    else
    begin
      if (Coords.NorthEast.Longitude <> 200) then
      begin
        if (Coords.NorthEast.Longitude = Coords.SouthWest.Longitude) and
           (Coords.NorthEast.Latitude = Coords.SouthWest.Latitude) then
             TMSFNCMaps1.SetCenterCoordinate(Coords.NorthEast)
        else
          TMSFNCMaps1.ZoomToBounds(Coords.NorthEast, Coords.SouthWest);
      end;
    end;

  end;
end;

procedure TMapAlbumForm.btnAddRoutesClick(Sender: TObject);
begin
  if openRoute.Execute then
  begin
    TMSFNCMaps1.LoadGPXFromFile(openRoute.FileName, true, true, 3, clrPanel.Color);
  end;
end;

procedure TMapAlbumForm.btnClearClick(Sender: TObject);
begin
  TMSFNCMaps1.ClearMarkers;
  TMSFNCMaps1.ClearPolylines;
end;

procedure TMapAlbumForm.FormCreate(Sender: TObject);
begin
  ClearCoords(Coords);
end;

procedure TMapAlbumForm.TMSFNCMaps1MapInitialized(Sender: TObject);
begin
  btnAddPhotos.Enabled := true;
  btnAddRoutes.Enabled := true;
  btnClear.Enabled := true;
end;

procedure TMapAlbumForm.clrPanelClick(Sender: TObject);
begin
  if colordialog1.Execute then
  begin
    clrPanel.Color := ColorDialog1.Color;
  end;
end;

end.