From 841f3e321ff8b49e1408b14abead47bc291edeb8 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Mon, 25 Sep 2017 10:39:11 +0200 Subject: =?UTF-8?q?l=C3=A4uft=20soweit?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .gitignore | 1 + gps_schneidetisch.lpi | 11 +- gps_schneidetisch.lpr | 10 +- gps_schneidetisch.lps | 100 +++++++------ unit1.lfm | 46 +++--- unit1.pas | 399 +++++++++++++++++++------------------------------- 6 files changed, 244 insertions(+), 323 deletions(-) diff --git a/.gitignore b/.gitignore index fdced0f..378cca4 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +*.gpx *.bmp *.png *.bak diff --git a/gps_schneidetisch.lpi b/gps_schneidetisch.lpi index a4de879..12f5a6e 100644 --- a/gps_schneidetisch.lpi +++ b/gps_schneidetisch.lpi @@ -32,7 +32,7 @@ - + @@ -40,10 +40,14 @@ - + + - + + + + @@ -53,6 +57,7 @@ + diff --git a/gps_schneidetisch.lpr b/gps_schneidetisch.lpr index 2c9e591..f1e729e 100644 --- a/gps_schneidetisch.lpr +++ b/gps_schneidetisch.lpr @@ -7,15 +7,15 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, Unit1 + Forms, unit1, gpxunit { you can add units after this }; {$R *.res} begin - RequireDerivedFormResource:=True; - Application.Initialize; - Application.CreateForm(TForm1, Form1); - Application.Run; + requireDerivedFormResource:=true; + application.initialize; + application.createForm(tForm1,form1); + application.run; end. diff --git a/gps_schneidetisch.lps b/gps_schneidetisch.lps index 943e1b5..65c9eba 100644 --- a/gps_schneidetisch.lps +++ b/gps_schneidetisch.lps @@ -3,26 +3,25 @@ - + - - - - - + + + + - + + - - - - + + + @@ -33,127 +32,144 @@ + + + + + + + + + + + + + + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - + + - + diff --git a/unit1.lfm b/unit1.lfm index 9f8193f..9459406 100644 --- a/unit1.lfm +++ b/unit1.lfm @@ -1,86 +1,88 @@ -object Form1: TForm1 - Left = 1690 +object form1: Tform1 + Left = 437 Height = 597 - Top = 180 + Top = 199 Width = 854 - Caption = 'Form1' + Caption = 'form1' ClientHeight = 597 ClientWidth = 854 + OnCreate = FormCreate + OnDestroy = FormDestroy OnResize = FormResize LCLVersion = '1.6.4.0' - object Button1: TButton + object button1: TButton Left = 8 Height = 25 Top = 8 Width = 75 Caption = 'Laden' - OnClick = Button1Click + OnClick = button1Click TabOrder = 0 end - object Button2: TButton + object button2: TButton Left = 88 Height = 25 Top = 8 Width = 75 Caption = 'Speichern' - OnClick = Button2Click + OnClick = button2Click TabOrder = 1 end - object ListBox1: TListBox + object listBox1: TListBox Left = 0 Height = 152 Top = 40 Width = 344 ItemHeight = 0 - OnClick = ListBox1Click - ScrollWidth = 340 + OnClick = listBox1Click + ScrollWidth = 342 TabOrder = 2 TopIndex = -1 end - object ListBox2: TListBox + object listBox2: TListBox Left = 0 Height = 144 Top = 192 Width = 344 ItemHeight = 0 - OnClick = ListBox2Click - ScrollWidth = 340 + OnClick = listBox2Click + ScrollWidth = 342 TabOrder = 3 TopIndex = -1 end - object ListBox3: TListBox + object listBox3: TListBox Left = 0 Height = 256 Top = 336 Width = 344 ItemHeight = 0 - OnClick = ListBox3Click - ScrollWidth = 340 + OnClick = listBox3Click + ScrollWidth = 342 TabOrder = 4 TopIndex = -1 end - object Image1: TImage + object image1: TImage Left = 344 Height = 90 Top = 0 Width = 90 end - object Button3: TButton + object button3: TButton Left = 168 Height = 25 Top = 8 Width = 75 Caption = 'Teilen' - OnClick = Button3Click + OnClick = button3Click TabOrder = 5 end - object Button4: TButton + object button4: TButton Left = 248 Height = 25 Top = 8 Width = 75 Caption = 'Löschen' - OnClick = Button4Click + OnClick = button4Click TabOrder = 6 end object SaveDialog1: TSaveDialog 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('0 then begin - setLength(D.GPX,length(D.GPX)+1); - setLength(D.GPX[length(D.GPX)-1].Trks,0); - delete(S,1,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('',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('',S)>0 then begin - delete(S,1,pos('',S)+5); - delete(S,pos('',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('',S)>0 then - inc(M) - else - dec(M); - 3: - if pos('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('',S)+4); - ele:=copy(S,1,pos('',S)-1); - if eof(F) then exit; - readln(F,S); - delete(S,1,pos('',S)-1); - end; - end - else if pos('',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,''); - for J:=0 to length(D.GPX[I].Trks)-1 do begin - writeln(F,' '); - 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,' '+D.GPX[I].Trks[J].Name+''); - writeln(F,' '); - for K:=0 to length(D.GPX[I].Trks[J].TrkPts)-1 do begin - writeln(F,' '); - writeln(F,' '+D.GPX[I].Trks[J].TrkPts[K].ele+''); - writeln(F,' '); - writeln(F,' '); - end; - writeln(F,' '); - writeln(F,' '); - end; - writeln(F,''); - 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 (txxMa) then xMa:=tx; - if ((TI=0) and (I=0)) or (tyyMa) then yMa:=ty; + 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 + 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. -- cgit v1.2.3