pid:integer;

lat,lon:double;

end;

type geolat=record

pid:integer;

lat:double;

end;

type geolon=record

pid:integer;

lat:double;

lon:double;

oid:integer;

end;

type geoobj=record

objtype:string;

objkind:integer;

objname:string;

end;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Button2: TButton;

Button3: TButton;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

ProgressBar1: TProgressBar;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Button7: TButton;

Image1: TImage;

Button8: TButton;

Button9: TButton;

Button10: TButton;

Button11: TButton;

Button12: TButton;

Button13: TButton;

ADOConnection1: TADOConnection;

ADOQuery1: TADOQuery;

DBGrid1: TDBGrid;

DataSource1: TDataSource;

CheckListBox1: TCheckListBox;

Button14: TButton;

Button15: TButton;

ADOQuery2: TADOQuery;

DataSource2: TDataSource;

DBGrid2: TDBGrid;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure Button15Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

ptlat:array[0..40000000]of geolat;

ptlon:array[0..40000000]of geolon;

gomas:array[0..5000000]of geoobj;

wrkpt:array[0..200000]of integer;

npt,nob,nwrkpt:integer;

maxlat,maxlon,minlat,minlon:double;

implementation

{$R *.dfm}

procedure objcf(objkind:integer;objtype:string;c:tcanvas);

begin

//

//canvas.pen.style

c.Pen.Color:=clwhite;

c.Brush.Color:=clwhite;

c.Pen.Style:=pssolid;

c.Pen.Width:=1;

if objkind=1 then begin

if(objtype='0x28')or(objtype='0x3e')

or(objtype='0x46')or(objtype='0x44')

or(objtype='0x43')or(objtype='0x42')

or(objtype='0x40')or(objtype='0x3d')

or(objtype='0x3c')or(objtype='0x1f')

or(objtype='0x3b')or(objtype='0x3f')

or(objtype='0x47')

then begin c.Pen.Color:=clblue;c.Brush.Color:=clblue;end;

if(objtype='0x1')

then begin c.Pen.Color:=clbtnface;c.Brush.Color:=clbtnface;end;

if(objtype='0x2')

then begin c.Pen.Color:=clsilver;c.Brush.Color:=clsilver;end;

if(objtype='0x3')

then begin c.Pen.Color:=rgb(100,0,100);c.Brush.Color:=rgb(100,0,100);end;

if(objtype='0x17')

then begin c.Pen.Color:=cllime;c.Brush.Color:=cllime;end;

if(objtype='0x1a')

then begin c.Pen.Color:=clgreen;c.Brush.Color:=clgreen;end;

if(objtype='0x4f')

then begin c.Pen.Color:=rgb(128,255,128);c.Brush.Color:=rgb(128,255,128);end;

if(objtype='0x4e')

then begin c.Pen.Color:=rgb(100,255,100);c.Brush.Color:=rgb(128,255,128);end;

if(objtype='0x50')

then begin c.Pen.Color:=rgb(100,255,100);c.Brush.Color:=rgb(100,255,100);end;

if(objtype='0xc')

then begin c.Pen.Color:=rgb(100,100,100);c.Brush.Color:=rgb(100,100,100);end;

if(objtype='0x8')or(objtype='0x13')

or(objtype='0x17')or(objtype='0xa')

then begin c.Pen.Color:=rgb(150,150,100);c.Brush.Color:=rgb(150,150,100);end;

end;

if objkind=0 then begin

if(objtype='0x26')or(objtype='0x1f')

or(objtype='0x18')

then begin c.Pen.Color:=clblue;c.Brush.Color:=clwhite;end;

if(objtype='0x4')

then begin c.Pen.Width:=2; c.Pen.Color:=clblack;c.Brush.Color:=clwhite;end;

if(objtype='0x1')

then begin c.Pen.Style:=psinsideframe; c.Pen.Width:=3;c.Pen.Color:=tcolor($009090);c.Brush.Color:=clwhite;end;

if(objtype='0x2')

then begin c.Pen.Width:=2;c.Pen.Color:=tcolor($000000);c.Brush.Color:=clwhite;end;

if(objtype='0x3')

then begin c.Pen.Width:=2;c.Pen.Color:=tcolor($900000);c.Brush.Color:=clwhite;end;

if(objtype='0x15')

then begin c.Pen.Width:=2;c.Pen.Color:=tcolor($900000);c.Brush.Color:=clwhite;end;

if(objtype='0x6')

then begin c.Pen.Color:=tcolor($900000);c.Brush.Color:=clwhite;end;

if(objtype='0x7')

then begin c.Pen.Color:=tcolor($aa0000);c.Brush.Color:=clwhite;end;

if(objtype='0x9')

then begin c.Pen.Color:=tcolor($aaaaaa);c.Brush.Color:=clwhite;end;

if(objtype='0x27')

then begin c.Pen.Color:=tcolor($0000ff);c.Brush.Color:=clwhite;end;

if(objtype='0x10f13')

then begin c.Pen.Style:=psdash; c.Pen.Color:=tcolor($0000ff);c.Brush.Color:=clwhite;end;

end;

//form1.Memo1.Lines.Append(objkind+objtype);

end;

procedure quicksort(var a: array of integer; Lo,Hi: integer);

procedure sort(l,r: integer);

var

i,j,x,y: integer;

begin

i:=l; j:=r; x:=a[(l+r) DIV 2];

repeat

while a[i]<x do i:=i+1;

while x<a[j] do j:=j-1;

if i<=j then

begin

if a[i] <> a[j] then BEGIN y:=a[i]; a[i]:=a[j]; a[j]:=y; END;

i:=i+1; j:=j-1;

end;

until i>j;

if l<j then sort(l,j);

if i<r then sort(i,r);

end;

begin {quicksort};

sort(Lo,Hi);

end;

function latgt(lat:double):integer;

var i,j:integer;

begin

i:=0;

j:=npt;

repeat

if ptlat[i+((j-i)div 2)].lat<lat then i:=i+((j-i)div 2) else j:=j-((j-i)div 2);

until((ptlat[i].lat<=lat)and(ptlat[i+1].lat>lat))or((j-i)<2);

latgt:=i;

end;

function longt(lon:double):integer;

var i,j:integer;

begin

i:=0;

j:=npt;

repeat

if ptlon[i+((j-i)div 2)].lon<lon then i:=i+((j-i)div 2) else j:=j-((j-i)div 2);

until((ptlon[i].lon<=lon)and(ptlon[i+1].lon>lon))or(j-i<2);

longt:=i;

end;

procedure TForm1.Button1Click(Sender: TObject);

var f:textfile; s,s1,s2:string;i:integer;d,newobj:integer;gp:geopoint;

begin

assignfile(f,'d:\gps\Ukraine.mp');

reset(f);

npt:=0;

nob:=0;

newobj:=0;

repeat

readln(f,s);

if pos('[END]',s)>0 then begin

newobj:=1;

nob:=nob+1;

end;

if pos('Type',s)>0 then begin

delete(s,1,5);

gomas[nob].objtype:=s;

newobj:=1;

end;

if pos('Label',s)>0 then begin

delete(s,1,6);

gomas[nob].objname:=s;

//newobj:=1;

end;

{if pos('[POLYLINE]',s)>0 then begin

gomas[nob].objkind:=0;

end;}

if pos('[POLYLINE]',s)>0 then begin

gomas[nob].objkind:=0;

newobj:=1;

end;

if pos('[POLYGON]',s)>0 then begin

gomas[nob].objkind:=1;

newobj:=1;

end;

if pos('[POI]',s)>0 then begin

gomas[nob].objkind:=2;

newobj:=1;

end;

if(pos('Data',s)>0){and(newobj=1)} then

begin

if newobj=0 then begin

gomas[nob+1]:=gomas[nob];

nob:=nob+1;

end;

repeat

delete(s,1,pos('(',s));

s1:=s;

s2:=s;

delete(s1,pos(',',s1),length(s1)-pos(',',s1)+1);

delete(s2,1,pos(',',s2));

delete(s2,pos(')',s2),length(s2)-pos(')',s2)+1);

val(s1,ptlat[npt].lat,i);

val(s2,ptlon[npt].lon,i);

ptlon[npt].lat:=ptlat[npt].lat;

ptlat[npt].pid:=npt;

ptlon[npt].oid:=nob;

ptlon[npt].pid:=npt;

npt:=npt+1;

until pos('(',s)=0;

newobj:=0;

end;

until eof(f);

closefile(f);

memo1.Lines.Append(inttostr(npt));

button4.Click;

end;

procedure TForm1.Button2Click(Sender: TObject);

var i,j:integer;gp:geolat;gl:geolon;

begin

progressbar1.Max:=npt;

for i:=0 to npt-1 do

begin

for j:=i to npt do

begin

if ptlat[i].lat>ptlat[j].lat then begin

gp:=ptlat[i];

ptlat[i]:=ptlat[j];

ptlat[j]:=gp;

end;

{if ptlon[i].lon>ptlon[j].lon then begin

gl:=ptlon[i];

ptlon[i]:=ptlon[j];

ptlon[j]:=gl;

end;}

end;

progressbar1.Position:=i;

end;

memo1.Lines.Append('Indexing complete');

end;

procedure TForm1.Button3Click(Sender: TObject);

var

ptlatmin,ptlatmax,ptlonmin,ptlonmax,i,j,k:integer;dlat,dlon:double;

begin

minlat:=strtofloat(edit1.text);

minlon:=strtofloat(edit2.text);

maxlat:=strtofloat(edit3.text);

maxlon:=strtofloat(edit4.text);

dlat:=maxlat-minlat;

dlon:=maxlon-minlon;

minlat:=minlat-(dlat/2);

minlon:=minlon-(dlon/2);

maxlat:=maxlat+(dlat/2);

maxlon:=maxlon+(dlon/2);

ptlatmin:=latgt(minlat);

//ptlonmin:=longt(minlon);

ptlatmax:=latgt(maxlat);

//ptlonmax:=longt(maxlon);

memo1.Lines.Append(inttostr(ptlatmin));

memo1.Lines.Append(inttostr(ptlonmin));

memo1.Lines.Append(inttostr(ptlatmax));

memo1.Lines.Append(inttostr(ptlonmax));

k:=0;

nwrkpt:=0;

for i:=ptlatmin to ptlatmax do

if(ptlon[ptlat[i].pid].lon>=minlon)and(ptlon[ptlat[i].pid].lon<maxlon) then

begin

wrkpt[nwrkpt]:=ptlat[i].pid;

nwrkpt:=nwrkpt+1;

end;

quicksort(wrkpt,0,nwrkpt);

{for i:=0 to nwrkpt-1 do

for j:=i to nwrkpt do if wrkpt[i]>wrkpt[j] then begin

k:=wrkpt[i];wrkpt[i]:=wrkpt[j];wrkpt[j]:=k;

end;}

minlat:=minlat+(dlat/2);

minlon:=minlon+(dlon/2);

maxlat:=maxlat-(dlat/2);

maxlon:=maxlon-(dlon/2);

button7.Click;

memo1.Lines.Append(inttostr(nwrkpt));

//memo1.Lines.Append(inttostr(ptlon[j].pid)+':'+inttostr(ptlat[i].pid));

end;

procedure TForm1.Button5Click(Sender: TObject);

var flat:file of geolat;flon:file of geolon;i:integer;

begin

assignfile(flat,'c:\ptlat.ix');

assignfile(flon,'c:\ptlon.ix');

rewrite(flat);

rewrite(flon);

for i:=0 to npt-1 do begin

write(flat,ptlat[i]);

write(flon,ptlon[i]);

end;

closefile(flat);

closefile(flon);

end;

procedure TForm1.Button4Click(Sender: TObject);

var flat:file of geolat;flon:file of geolon;i:integer;

begin

assignfile(flat,'c:\ptlat.ix');

//assignfile(flon,'c:\ptlon.ix');

reset(flat);

//reset(flon);

npt:=0;

repeat

read(flat,ptlat[npt]);

//read(flon,ptlon[npt]);

npt:=npt+1;

until eof(flat);

closefile(flat);

//closefile(flon);

button14.Click;

button15.Click;

button3.Click;

end;

procedure TForm1.Button6Click(Sender: TObject);

var i:integer;

begin

for i:=0 to npt do memo1.Lines.Append(floattostr(ptlat[i].lat));

end;

procedure arrow(c:tcanvas;x,y:integer;course:double;color:integer);

begin

c.Pen.Color:=tcolor($0f0f0f);

c.Brush.Color:=color;

c.MoveTo(round(sin(course/180*pi)*5)+x,round(cos(course/180*pi)*5)+y);

c.lineTo(round(sin((course+160)/180*pi)*5)+x,round(cos((course+160)/180*pi)*5)+y);

c.lineTo(round(sin((course+180)/180*pi)*3)+x,round(cos((course+180)/180*pi)*3)+y);

c.lineTo(round(sin((course-160)/180*pi)*5)+x,round(cos((course-160)/180*pi)*5)+y);

c.LineTo(round(sin(course/180*pi)*5)+x,round(cos(course/180*pi)*5)+y);

c.FloodFill(x,y,c.Pen.Color,fsborder);

end;

procedure TForm1.Button7Click(Sender: TObject);

var i,np,cx,cy:integer;kx,ky,lat,lon,course:double;pc,bc:tcolor;

points:array[0..100000]of tpoint;

begin

image1.Canvas.Brush.Color:=rgb(250,245,220);

image1.Canvas.Rectangle(0,0,image1.Width,image1.Height);

kx:=image1.Width/(maxlat-minlat);

ky:=image1.Height/(maxlon-minlon);

for i:=1 to nwrkpt do begin

if(ptlon[wrkpt[i]].oid<>ptlon[wrkpt[i-1]].oid)then begin

if gomas[ptlon[wrkpt[i-1]].oid].objkind=1 then

image1.Canvas.Polygon(slice(points,np+1));

objcf(gomas[ptlon[wrkpt[i]].oid].objkind,gomas[ptlon[wrkpt[i]].oid].objtype,image1.Canvas);

{image1.canvas.pen.color:=pc;

image1.canvas.brush.color:=bc;}

np:=0;

points[np].X:=round(((ptlon[wrkpt[i]].lon)-minlon)*ky);

points[np].Y:=image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx);

end else

np:=np+1;

points[np].X:=round(((ptlon[wrkpt[i]].lon)-minlon)*ky);

points[np].Y:=image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx);

end;

image1.Canvas.Pen.Width:=2;

for i:=1 to nwrkpt do begin

if(ptlon[wrkpt[i]].oid<>ptlon[wrkpt[i-1]].oid)then begin

if gomas[ptlon[wrkpt[i-1]].oid].objkind=0 then

image1.Canvas.Polyline(slice(points,np+1));

{if gomas[ptlon[wrkpt[i-1]].oid].objkind=1 then

image1.Canvas.Polygon(slice(points,np+1));}

if gomas[ptlon[wrkpt[i-1]].oid].objkind=2 then

begin

image1.Canvas.Brush.Color:=clred;

image1.Canvas.Ellipse(round(((ptlon[wrkpt[i]].lon)-minlon)*ky)-5,

image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx)-5,

round(((ptlon[wrkpt[i]].lon)-minlon)*ky)+5,

image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx)+5);

//image1.Canvas.TextFlags:=

SetBkMode(image1.Canvas.Handle, TRANSPARENT);

image1.Canvas.TextOut(round(((ptlon[wrkpt[i]].lon)-minlon)*ky),image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx),gomas[ptlon[wrkpt[i]].oid].objname);

end;

objcf(gomas[ptlon[wrkpt[i]].oid].objkind,gomas[ptlon[wrkpt[i]].oid].objtype,image1.Canvas);

{image1.canvas.pen.color:=pc;

image1.canvas.brush.color:=bc;}

np:=0;

points[np].X:=round(((ptlon[wrkpt[i]].lon)-minlon)*ky);

points[np].Y:=image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx);

end else

np:=np+1;

points[np].X:=round(((ptlon[wrkpt[i]].lon)-minlon)*ky);

points[np].Y:=image1.Height-round(((ptlon[wrkpt[i]].lat)-minlat)*kx);

end;

//

np:=dbgrid2.DataSource.DataSet.Recordcount;

for i:=1 to np do

begin

dbgrid2.DataSource.DataSet.Recno:=i;

lat:=dbgrid2.Fields[0].AsFloat;

lon:=dbgrid2.Fields[1].AsFloat;

cx:=round((lat-minlon)*ky);

cy:=image1.Height-round((lon-minlat)*kx);

course:=dbgrid2.Fields[2].AsFloat;

arrow(image1.Canvas,cx,cy,course,clgreen);

//image1.Canvas.Ellipse(cx-5,cy-5,cx+5,cy+5);

//image1.Canvas.MoveTo();

end;

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

edit2.Text:=floattostr(minlon-((maxlon-minlon)/10));

edit4.Text:=floattostr(maxlon-((maxlon-minlon)/10));

button3.Click;

end;

procedure TForm1.Button11Click(Sender: TObject);

begin

edit2.Text:=floattostr(minlon+((maxlon-minlon)/10));

edit4.Text:=floattostr(maxlon+((maxlon-minlon)/10));

button3.Click;

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

edit1.Text:=floattostr(minlat+((maxlat-minlat)/10));

edit3.Text:=floattostr(maxlat+((maxlat-minlat)/10));

button3.Click;

end;

procedure TForm1.Button10Click(Sender: TObject);

begin

edit1.Text:=floattostr(minlat-((maxlat-minlat)/10));

edit3.Text:=floattostr(maxlat-((maxlat-minlat)/10));

button3.Click;

end;

procedure TForm1.Button12Click(Sender: TObject);

begin

edit2.Text:=floattostr(minlon+((maxlon-minlon)/10));

edit4.Text:=floattostr(maxlon-((maxlon-minlon)/10));

edit1.Text:=floattostr(minlat+((maxlat-minlat)/10));

edit3.Text:=floattostr(maxlat-((maxlat-minlat)/10));

button3.Click;

end;

procedure TForm1.Button13Click(Sender: TObject);

begin

edit2.Text:=floattostr(minlon-((maxlon-minlon)/10));

edit4.Text:=floattostr(maxlon+((maxlon-minlon)/10));

edit1.Text:=floattostr(minlat-((maxlat-minlat)/10));

edit3.Text:=floattostr(maxlat+((maxlat-minlat)/10));

button3.Click;

end;

procedure TForm1.Button14Click(Sender: TObject);

var i,l:integer;

begin

checklistbox1.Items.Clear;

dbgrid1.DataSource.DataSet.FindLast;

l:=dbgrid1.DataSource.DataSet.RecNo;

//dbgrid1.:=2;

for i:=1 to l do begin

dbgrid1.DataSource.DataSet.RecNo:=i;

//dbgrid1.Fields.AsString

checklistbox1.Items.Append(dbgrid1.Fields[0].asstring);

end;

end;

procedure TForm1.Button15Click(Sender: TObject);

begin

adoquery2.Close;

adoquery2.SQL.Text:='select positionX,positionY,course from navdata where vehicleid=52252';

adoquery2.Open;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

button1.Click;

end;

end.

Размещено на Allbest.ru