summaryrefslogtreecommitdiff
path: root/unit1.pas
diff options
context:
space:
mode:
Diffstat (limited to 'unit1.pas')
-rw-r--r--unit1.pas399
1 files changed, 148 insertions, 251 deletions
diff --git a/unit1.pas b/unit1.pas
index 38497a6..71311ff 100644
--- a/unit1.pas
+++ b/unit1.pas
@@ -1,4 +1,4 @@
-unit Unit1;
+unit unit1;
{$mode objfpc}{$H+}
@@ -6,46 +6,33 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
- ExtCtrls;
+ ExtCtrls, gpxunit;
type
- tTrkPt = record
- lat,lon,ele,time: string;
- end;
- tTrack = record
- name: string;
- trkPts: array of tTrkPt;
- end;
- tGpxInhalt = record
- kopf: String;
- trks: array of tTrack;
- end;
- tGpxFile = record
- prefix: array of string;
- gpx: array of tGPXInhalt;
- end;
{ 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 FormResize(Sender: TObject);
- procedure ListBox1Click(Sender: TObject);
- procedure ListBox2Click(Sender: TObject);
- procedure ListBox3Click(Sender: TObject);
+ 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
@@ -53,7 +40,7 @@ type
d: tGpxFile;
procedure zeichneGpxs;
procedure zeichneTrks;
- procedure zeichneTrkPts;
+ procedure zeichneTrkpts;
procedure zeichne;
end;
@@ -61,7 +48,7 @@ var
form1: tForm1;
function gibFarbe(i: integer): tColor;
-function mystrtofloat(S: String): extended;
+function myStrToFloat(s: string): extended;
implementation
@@ -83,283 +70,193 @@ begin
result:=farben[i];
end;
-function mystrtofloat(S: String): extended;
+function myStrToFloat(s: string): extended;
begin
- while pos('.',S)>0 do
- S[pos('.',S)]:=',';
- result:=strtofloat(S);
+ while pos(',',s)>0 do
+ s[pos(',',s)]:='.';
+ result:=strToFloat(s);
end;
{ tForm1 }
-procedure tForm1.Button1Click(Sender: TObject);
-var
- f: text;
- s: string;
- m,cnt: integer;
+procedure tForm1.button1Click(sender: tObject);
begin
- if opendialog1.execute then begin
- setLength(D.Prefix,0);
- setLength(D.GPX,0);
- Assignfile(F,openDialog1.fileName);
- Reset(F);
- M:=0;
- cnt:=0;
- s:='';
- while (s<>'') or not eof(F) do begin inc(cnt);
- if s='' then Readln(F,S);
- case M of
- 0:
- if pos('<gpx ',S)>0 then begin
- setLength(D.GPX,length(D.GPX)+1);
- setLength(D.GPX[length(D.GPX)-1].Trks,0);
- delete(S,1,pos('<gpx ',S)+3);
- delete(S,pos('>',S),length(S));
- D.GPX[length(D.GPX)-1].Kopf:=S;
- inc(M);
- end
- else begin
- setLength(D.Prefix,length(D.Prefix)+1);
- D.Prefix[length(D.Prefix)-1]:=S;
- s:='';
- end;
- 1:
- if pos('<trk>',S)>0 then begin inc(cnt);
- setLength(D.GPX[length(D.GPX)-1].Trks,length(D.GPX[length(D.GPX)-1].Trks)+1);
- D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].Name:='';
- setLength(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts,0);
- inc(M);
- end
- else
- dec(M);
- 2:
- if pos('<name>',S)>0 then begin
- delete(S,1,pos('<name>',S)+5);
- delete(S,pos('</name>',S),length(S));
- D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].Name:=S;
- end
- else if pos('<trkseg>',S)>0 then
- inc(M)
- else
- dec(M);
- 3:
- if pos('<trkpt ',S)>0 then begin
- setLength(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts,
- length(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts)+1);
- with D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts[
- length(D.GPX[length(D.GPX)-1].Trks[length(D.GPX[length(D.GPX)-1].Trks)-1].TrkPts)-1] do begin
- delete(S,1,pos('lat="',S)+4);
- lat:=copy(S,1,pos('"',S)-1);
- delete(S,1,pos('lon="',S)+4);
- lon:=copy(S,1,pos('"',S)-1);
- if eof(F) then exit;
- readln(F,S);
- delete(S,1,pos('<ele>',S)+4);
- ele:=copy(S,1,pos('</ele>',S)-1);
- if eof(F) then exit;
- readln(F,S);
- delete(S,1,pos('<time>',S)+5);
- time:=copy(S,1,pos('</time>',S)-1);
- end;
- end
- else if pos('</trkseg>',S)>0 then
- dec(M);
- end{of Case};
- end;
- Closefile(F);
- end;
- ZeichneGPXs;
- messagedlg('ok ('+inttostr(cnt)+')',mtinformation,[mbOk],0);
+ 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);
-var
- F: text;
- I,J,K: Integer;
+procedure tForm1.button2Click(sender: tObject);
begin
- if Savedialog1.Execute then begin
- Assignfile(F,Savedialog1.FileName);
- Rewrite(F);
- for I:=0 to length(D.Prefix)-1 do
- Writeln(F,D.Prefix[I]);
- for I:=0 to length(D.GPX)-1 do begin
- writeln(F,'<gpx'+D.GPX[I].Kopf+'>');
- for J:=0 to length(D.GPX[I].Trks)-1 do begin
- writeln(F,' <trk>');
- while pos('<',D.GPX[I].Trks[J].Name)>0 do
- D.GPX[I].Trks[J].Name[pos('<',D.GPX[I].Trks[J].Name)]:='-';
- while pos('>',D.GPX[I].Trks[J].Name)>0 do
- D.GPX[I].Trks[J].Name[pos('>',D.GPX[I].Trks[J].Name)]:='+';
- writeln(F,' <name>'+D.GPX[I].Trks[J].Name+'</name>');
- writeln(F,' <trkseg>');
- for K:=0 to length(D.GPX[I].Trks[J].TrkPts)-1 do begin
- writeln(F,' <trkpt lat="'+D.GPX[I].Trks[J].TrkPts[K].lat+
- '" lon="'+D.GPX[I].Trks[J].TrkPts[K].lon+'">');
- writeln(F,' <ele>'+D.GPX[I].Trks[J].TrkPts[K].ele+'</ele>');
- writeln(F,' <time>'+D.GPX[I].Trks[J].TrkPts[K].time+'</time>');
- writeln(F,' </trkpt>');
- end;
- writeln(F,' </trkseg>');
- writeln(F,' </trk>');
- end;
- writeln(F,'</gpx>');
- end;
- Closefile(F);
- end;
+ if saveDialog1.execute then
+ d.saveToFile(saveDialog1.fileName);
end;
-procedure tForm1.Button3Click(Sender: TObject);
+procedure tForm1.button3Click(sender: tObject);
var
- I: Integer;
+ 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+'>';
+ 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;
+ zeichneTrks;
end;
-procedure tForm1.Button4Click(Sender: TObject);
+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;
+ 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.FormResize(Sender: TObject);
+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;
+ listBox3.height:=form1.clientHeight-listBox3.top;
+ zeichne;
end;
-procedure tForm1.ListBox1Click(Sender: TObject);
+procedure tForm1.listBox1Click(sender: tObject);
begin
- ZeichneTRKs;
+ zeichneTrks;
end;
-procedure tForm1.ListBox2Click(Sender: TObject);
+procedure tForm1.listBox2Click(sender: tObject);
begin
- ZeichneTRKPTs;
+ zeichneTrkpts;
end;
-procedure tForm1.ListBox3Click(Sender: TObject);
+procedure tForm1.listBox3Click(sender: tObject);
begin
- Zeichne;
+ 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;
+ 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;
+ 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;
+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;
+ 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;
+ 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
+ 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;
+ 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
+ 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
+ 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));
+ 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;
+ 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
+ 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;
+ 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));
+ 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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-28 09:37:26 +0000