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 d.loadFromFile(openDialog1.fileName); 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:=400; 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 (tXxMa) then xMa:=tX; if ((tI=0) and (i=0)) or (tYyMa) 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.