aqui esta el codigo completo la compilacion original fue hecha en delphi Xe5 luego la compile en Xe6 en ambas versiones Funcionaba perfectamente y ahora en Xe7 que no se por que se queda con la pantalla negra
Código Delphi
[-]
unit LocationDemoUnit;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.StdCtrls,
FMX.ListBox, FMX.Layouts, System.Sensors, FMX.MobilePreview,Google.Maps,
System.Rtti, FMX.Edit, FMX.DateTimeCtrls, FMX.Grid, FireDAC.Stan.Intf,
FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
Data.DB, FireDAC.Comp.Client,System.IOUtils, FireDAC.Stan.Param, FireDAC.DatS,
FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Stan.ExprFuncs, FireDAC.FMXUI.Wait,
FireDAC.Comp.UI, FireDAC.Phys.SQLite, FireDAC.Comp.DataSet, Data.Bind.EngExt,
Fmx.Bind.DBEngExt, System.Bindings.Outputs, Fmx.Bind.Editors,
Data.Bind.Components, Data.Bind.DBScope, FireDAC.Phys.SQLiteDef, FMX.Calendar,
FMX.Controls.Presentation, System.Sensors.Components, FMX.WebBrowser;
type
TForm1 = class(TForm)
LocationSensor1: TLocationSensor;
Line2: TLine;
Panel2: TPanel;
StyleBook1: TStyleBook;
BDGps: TFDConnection;
tbl_datos: TFDTable;
FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink;
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
Timer1: TTimer;
BindSourceDB1: TBindSourceDB;
BindingsList1: TBindingsList;
BindSourceDB2: TBindSourceDB;
cons_velocidad: TFDQuery;
Panel5: TPanel;
Label7: TLabel;
txt_latitud: TEdit;
Panel6: TPanel;
Label2: TLabel;
txt_longitud: TEdit;
Panel7: TPanel;
Label3: TLabel;
Switch1: TSwitch;
Panel8: TPanel;
Label1: TLabel;
txt_hasta: TTimeEdit;
Panel1: TPanel;
Label4: TLabel;
Panel9: TPanel;
Label8: TLabel;
Panel10: TPanel;
Panel11: TPanel;
Label9: TLabel;
txt_desde: TTimeEdit;
Label5: TLabel;
txt_calendario: TCalendar;
WebBrowser1: TWebBrowser;
procedure LocationSensor1LocationChanged(Sender: TObject; const OldLocation,
NewLocation: TLocationCoord2D);
procedure Switch1Switch(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure txt_calendarioChange(Sender: TObject);
procedure txt_hastaClosePicker(Sender: TObject);
private
FGeocoder: TGeocoder;
procedure OnGeocodeReverseEvent(const Address: TCivicAddress);
public
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Switch1Switch(Sender: TObject);
begin
LocationSensor1.Active := Switch1.IsChecked;
Timer1.Enabled:= Switch1.IsChecked;
end;
procedure TForm1.txt_hastaClosePicker(Sender: TObject);
var
Map: TGoogleMap;
a:Integer;
begin
a:=0;
Map:=TGoogleMap.Create;
try
Map.MapFormat:=mfPNG32;
Map.MapType:=mtRoadmap;
Map.Paths.Add(TMapPath.Create);
Map.Paths.Last.ColorAlpha:=255;
Map.Paths.Last.Color:=TColorRec.Blue;
Map.Paths.Last.Weight:=2;
while not tbl_datos.Eof do
begin
if (tbl_datos.FieldValues['HORA']>= TimeToStr(txt_desde.Time)) and (tbl_datos.FieldValues['HORA']<= TimeToStr(txt_hasta.Time)) and (tbl_datos.FieldValues['FECHA'] = DateToStr(txt_calendario.Date)) then
begin
a:=a+1;
Map.Paths.Last.PathData.Add(TMapPoint.Create(tbl_datos.FieldValues['LATITUD'],tbl_datos.FieldValues['LONGITUD']));
WebBrowser1.Navigate(Map.URL);
end;
tbl_datos.Next;
end;
finally
tbl_datos.First;
Map.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
if LocationSensor1.Sensor.Speed > 1 then
begin
if (txt_latitud.Text <> '') and (txt_longitud.Text <> '') then
begin
tbl_datos.Insert;
tbl_datos.FieldByName('FECHA').Value:=DateToStr(Date);
tbl_datos.FieldByName('HORA').Value:=TimeToStr(Time);
tbl_datos.FieldByName('LATITUD').Value:= FormatFloat(',.000000',LocationSensor1.Sensor.Latitude);
tbl_datos.FieldByName('LONGITUD').Value:= FormatFloat(',.000000',LocationSensor1.Sensor.Longitude);
tbl_datos.Post;
end;
end;
except
ShowMessage('Error en Guardar los Datos');
end;
end;
procedure TForm1.txt_calendarioChange(Sender: TObject);
var
Map: TGoogleMap;
a:Integer;
begin
a:=0;
Map:=TGoogleMap.Create;
try
Map.MapFormat:=mfPNG32;
Map.MapType:=mtRoadmap;
Map.Paths.Add(TMapPath.Create);
Map.Paths.Last.ColorAlpha:=255;
Map.Paths.Last.Color:=TColorRec.Blue;
Map.Paths.Last.Weight:=2;
while not tbl_datos.Eof do
begin
if tbl_datos.FieldValues['FECHA'] = DateToStr(txt_calendario.Date) then
begin
a:=a+1;
Map.Paths.Last.PathData.Add(TMapPoint.Create(tbl_datos.FieldValues['LATITUD'],tbl_datos.FieldValues['LONGITUD']));
WebBrowser1.Navigate(Map.URL);
end;
tbl_datos.Next;
end;
finally
tbl_datos.First;
Map.Free;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
BDGps.Params.Values['Database'] := TPath.Combine(TPath.GetSharedDocumentsPath, '/sdcard/BdCoordenadas.db');
try begin
BDGps.Connected := True;
tbl_datos.Active:= True
end;
except
on E: EDatabaseError do
ShowMessage('Error en la Conexion' + E.Message);
end;
end;
procedure TForm1.LocationSensor1LocationChanged(Sender: TObject;
const OldLocation, NewLocation: TLocationCoord2D);
var
URLString: String;
LLatitude, LLongitude : string;
LSettings: TFormatSettings;
LDecSeparator : Char;
begin
LDecSeparator := FormatSettings.DecimalSeparator;
LSettings := FormatSettings;
try
FormatSettings.DecimalSeparator := '.';
txt_latitud.Text := Format('%2.6f', [NewLocation.Latitude]);
txt_longitud.Text := Format('%2.6f', [NewLocation.Longitude]);
finally
FormatSettings.DecimalSeparator := LDecSeparator;
end;
end;