path: root/unit1.pas

unit unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, gpxunit;

type

  { tForm1 }

  tForm1 = class(tForm)
    button1: tButton;
    button2: tButton;
    button3: tButton;
    button4: tButton;
    image1: tImage;
    listBox1: tListBox;
    listBox2: tListBox;
    listBox3: tListBox;
    openDialog1: tOpenDialog;
    saveDialog1: tSaveDialog;
    procedure button1Click(sender: tObject);
    procedure button2Click(sender: tObject);
    procedure button3Click(sender: tObject);
    procedure button4Click(sender: tObject);
    procedure formCreate(sender: tObject);
    procedure formDestroy(sender: tObject);
    procedure formResize(sender: tObject);
    procedure listBox1Click(sender: tObject);
    procedure listBox2Click(sender: tObject);
    procedure listBox3Click(sender: tObject);
  private
    { private declarations }
  public
    { public declarations }
    d: tGpxFile;
    procedure zeichneGpxs;
    procedure zeichneTrks;
    procedure zeichneTrkpts;
    procedure zeichne;
  end;

var
  form1: tForm1;

function gibFarbe(i: integer): tColor;
function myStrToFloat(s: string): extended;

implementation

uses
  math;

{$R *.lfm}

var
  farben: array of tColor;

function gibFarbe(i: integer): tColor;
begin
  randomize;
  while i>=length(farben) do begin
    setLength(farben,length(farben)+1);
    farben[length(farben)-1]:=random($1000000);
  end;
  result:=farben[i];
end;

function myStrToFloat(s: string): extended;
begin
  while pos(',',s)>0 do
    s[pos(',',s)]:='.';
  result:=strToFloat(s);
end;

{ tForm1 }

procedure tForm1.button1Click(sender: tObject);
begin
  if openDialog1.execute then
    if d.loadFromFile(openDialog1.fileName) then
      messageDlg('Erfolg! '+inttostr(length(d.gpx)),mtInformation,[mbOk],0)
    else
      messageDlg('Misserfolg!',mtInformation,[mbOk],0);
  zeichneGpxs;
end;

procedure tForm1.button2Click(sender: tObject);
begin
  if saveDialog1.execute then
    d.saveToFile(saveDialog1.fileName);
end;

procedure tForm1.button3Click(sender: tObject);
var
  i: integer;
begin
  if listBox1.itemIndex<0 then exit;
  if listBox2.itemIndex<0 then exit;
  if listBox3.itemIndex<0 then exit;
  with d.gpx[listBox1.itemIndex] do begin
    setLength(trks,length(trks)+1);
    for i:=length(trks)-1 downto listBox2.itemIndex+1 do
      trks[i]:=trks[i-1];
    setLength(trks[listBox2.itemIndex].trkPts,listBox3.itemIndex+1);
    trks[listBox2.itemIndex].name:=trks[listBox2.itemIndex].name+'<';
    with trks[listBox2.itemIndex+1] do begin
      for i:=listBox3.itemIndex to length(trkPts)-1 do
        trkPts[i-listBox3.itemIndex]:=trkPts[i];
      setLength(trkPts,length(trkPts)-listBox3.itemIndex);
      name:=name+'>';
    end;
  end;
  zeichneTrks;
end;

procedure tForm1.button4Click(sender: tObject);
var
  i: integer;
begin
  if listBox1.itemIndex<0 then exit;
  if listBox2.itemIndex<0 then exit;
  with d.gpx[listBox1.itemIndex] do begin
    for i:=listBox2.itemIndex+1 to length(trks)-1 do
      trks[i-1]:=trks[i];
    setLength(trks,length(trks)-1);
    zeichneTrks;
  end;
end;

procedure tForm1.formCreate(sender: tObject);
begin
  d:=tGpxFile.create;
end;

procedure tForm1.formDestroy(sender: tObject);
begin
  d.free;
end;

procedure tForm1.formResize(sender: tObject);
begin
  listBox3.height:=form1.clientHeight-listBox3.top;
  zeichne;
end;

procedure tForm1.listBox1Click(sender: tObject);
begin
  zeichneTrks;
end;

procedure tForm1.listBox2Click(sender: tObject);
begin
  zeichneTrkpts;
end;

procedure tForm1.listBox3Click(sender: tObject);
begin
  zeichne;
end;

procedure tForm1.zeichneGpxs;
var
  i: integer;
begin
  listBox1.items.clear;
  for i:=0 to length(d.gpx)-1 do
    listBox1.items.add(d.gpx[i].kopf);
  zeichneTrks;
end;

procedure tForm1.zeichneTrks;
var
  i: integer;
begin
  listBox2.items.clear;
  if listBox1.itemIndex>=0 then
    for i:=0 to length(d.gpx[listBox1.itemIndex].trks)-1 do
      listBox2.items.add(d.gpx[listBox1.itemIndex].trks[i].name);
  zeichneTrkpts;
end;

procedure tForm1.zeichneTrkpts;
var
  i: integer;
begin
  listBox3.items.clear;
  if (listBox1.itemIndex>=0) and (listBox2.itemIndex>=0) then
    for i:=0 to length(d.gpx[listBox1.itemIndex].trks[listBox2.itemIndex].trkPts)-1 do
      listBox3.items.add(d.gpx[listBox1.itemIndex].trks[listBox2.itemIndex].trkPts[i].lat+' '+
                         d.gpx[listBox1.itemIndex].trks[listBox2.itemIndex].trkPts[i].lon+' '+
                         d.gpx[listBox1.itemIndex].trks[listBox2.itemIndex].trkPts[i].time+' '+
                         d.gpx[listBox1.itemIndex].trks[listBox2.itemIndex].trkPts[i].ele);
  zeichne;
end;

procedure tForm1.zeichne;
var
  i,tI:    integer;
  xMi,xMa,
  yMi,yMa,
  tX,tY:   extended;
begin
  image1.free;
  image1:=tImage.create(form1);
  image1.parent:=form1;
  image1.left:=344;
  image1.top:=0;
  image1.width:=form1.clientWidth-image1.left;
  image1.height:=form1.clientHeight-image1.top;
  image1.canvas.rectangle(-10,-10,image1.width+10,image1.height+10);
  if listBox1.itemIndex<0 then exit;
  xMi:=0;
  xMa:=0;
  yMi:=0;
  yMa:=0;
  for tI:=0 to listBox2.items.count-1 do
   for i:=0 to length(d.gpx[listBox1.itemIndex].trks[tI].trkPts)-1 do
    with d.gpx[listBox1.itemIndex].trks[tI].trkPts[i] do
     begin
      tX:=myStrToFloat(lon);
      tY:=myStrToFloat(lat);
      if ((tI=0) and (i=0)) or (tX<xMi) then xMi:=tX;
      if ((tI=0) and (i=0)) or (tX>xMa) then xMa:=tX;
      if ((tI=0) and (i=0)) or (tY<yMi) then yMi:=tY;
      if ((tI=0) and (i=0)) or (tY>yMa) then yMa:=tY;
     end;
  xMa:=(image1.width-4)/max(1e-10,xMa-xMi);
  yMi:=(image1.height-4)/max(1e-10,yMa-yMi);
  for tI:=0 to listBox2.items.count-1 do
   begin
    image1.canvas.pen.width:=1+2*byte(tI=listBox2.itemIndex);
    image1.canvas.pen.color:=gibFarbe(tI);
    for i:=0 to length(d.gpx[listBox1.itemIndex].trks[tI].trkPts)-1 do
     with d.gpx[listBox1.itemIndex].trks[tI].trkPts[i] do
      begin
       tX:=2+(myStrToFloat(lon)-xMi)*xMa;
       tY:=2+(yMa-myStrToFloat(lat))*yMi;
       if i=0 then image1.canvas.moveTo(round(tX),round(tY))
              else image1.canvas.lineTo(round(tX),round(tY));
      end;
    image1.canvas.pen.width:=1;
    image1.canvas.pen.color:=$000000;
   end;
  if listBox2.itemIndex<0 then exit;
  if listBox3.itemIndex<0 then exit;
  with d.gpx[listBox1.itemIndex].trks[listBox2.itemIndex].trkPts[listBox3.itemIndex] do
   begin
    tX:=2+(myStrToFloat(lon)-xMi)*xMa;
    tY:=2+(yMa-myStrToFloat(lat))*yMi;
   end;
  image1.canvas.moveTo(round(tX),round(tY)-4);
  image1.canvas.lineTo(round(tX),round(tY)+5);
  image1.canvas.moveTo(round(tX)-4,round(tY));
  image1.canvas.lineTo(round(tX)+5,round(tY));
end;

end.