diff options
Diffstat (limited to 'unit1.pas')
| -rw-r--r-- | unit1.pas | 366 |
1 files changed, 366 insertions, 0 deletions
diff --git a/unit1.pas b/unit1.pas new file mode 100644 index 0000000..38497a6 --- /dev/null +++ b/unit1.pas @@ -0,0 +1,366 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls; + +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); + 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); +var + f: text; + s: string; + m,cnt: integer; +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); +end; + +procedure tForm1.Button2Click(Sender: TObject); +var + F: text; + I,J,K: Integer; +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; +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.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. + |