commfunc.pas

testlonglat GOOGLE卫星图片计算的DELPHI测试程序

unit CommFunc;

interface
uses
  SysUtils, Variants, Classes, StdCtrls, math, ExtCtrls, ComCtrls;
type
  TRet=record
    longmin :double;
    latmin:double;
    longmax:double;
    latmax:double;
    long:double;
    lat:double;
  end;
  TRowCol=record
    Row :integer;
    Col: integer;
  end;
function SplitString(const Source,ch:string):TStringList;
function GetDownUrl(PicUrl:string):string;
function NormalToMercator(y:double):double;
function MercatorToNormal(y:double):double;
function GetCoordinatesFromAddress(str:string):TRet;
function GetNextTileX(addr:string; nforward:integer):string;
function GetNextTileY(addr:string; nforward:integer):string;
function GetQuadtreeAddress(zoom:integer;long, lat:double):string;
//function GetQuadtreeXY(zoom:integer;long, lat:double):TRowCol;
function GetQuadtreeXY(str:string):TRowCol;
implementation

function SplitString(const Source,ch:string):TStringList;
var
  temp:String;
  i:Integer;
begin
  Result:=TStringList.Create;
  if Source=''
  then exit;
  temp:=Source;
  i:=pos(ch,Source);
  while i<>0 do
  begin
     Result.add(copy(temp,0,i-1));
     Delete(temp,1,i);
     i:=pos(ch,temp);
  end;
  Result.add(temp);
end;

function GetDownUrl(PicUrl:string):string;
var
  temp:TStringList;
  i:Integer;
begin
  temp:=TStringList.Create;
  temp:=SplitString(PicUrl,'|');
  if temp.Count>0 then
    result:=temp[temp.Count-1]
  else
    result:='';
end;

function NormalToMercator(y:double):double;
begin
   y :=y - 0.5;
   y :=y * 2 * PI;
   y := exp(y * 2);
   y := (y-1)/(y+1);
   y := ArcSin(y);
   y := y * -180/PI;
   result:=y;
end;

function MercatorToNormal(y:double):double;
begin
   y := -y * PI / 180;
   y := sin(y);
   y := (1+y)/(1-y);
   y := 0.5 * log10(y);
   y :=y * 1.0 / (2 * PI);
   y := y + 0.5;
   result:=y;
end;

//计算图片边和中心点经纬度
function GetCoordinatesFromAddress(str:string):TRet;
var
   x,y,scale:double;
   c:string;
   ret:TRet;
begin
   x:=0.0;
   y:=0.0;
   scale:=1.0;
   str:=LowerCase(str);
   str:=copy(str,2,length(str)); // skip the first character
   while (length(str)>0) do begin
     scale :=scale * 0.5;
     c := str[1]; // remove first character
     if (c = 'r') or (c ='s') then x:=x + scale;
     if (c='t') or (c ='s') then y:=y + scale;
     str := copy(str,2,length(str));
   end;
   ret.longmin := (x - 0.5) * 360;
   ret.latmin := NormalToMercator(y);
   ret.longmax := (x + scale - 0.5) * 360;
   ret.latmax := NormalToMercator(y + scale);
   ret.long := (x + scale * 0.5 - 0.5) * 360;
   ret.lat := NormalToMercator(y + scale * 0.5);
   result:=ret;
end;

function GetNextTileX(addr:string; nforward:integer):string;
var
  parent,last:string;
begin
	if addr = '' then begin
    result:=addr;
    exit;
  end;
	parent := copy(addr,1,length(addr)-1);
	last := addr[length(addr)];

	if (last = 'q') then begin
		 last := 'r';
		 if nforward=0 then parent:=GetNextTileX(parent, nforward);
	end
  else begin
	   if (last = 'r') then begin
		   last := 'q';
	   	 if nforward<>0 then parent:=GetNextTileX(parent, nforward);
	   end
     else begin
       if (last = 's') then begin
		     last := 't';
		     if nforward<>0 then parent:=GetNextTileX(parent, nforward);
	     end
       else begin
          if last = 't' then begin
		        last := 's';
		        if nforward=0 then parent:=GetNextTileX(parent, nforward);
	        end;
       end;
    end;
  end;
	result:=parent + last;
end;

function GetNextTileY(addr:string; nforward:integer):string;
var
  parent,last:string;
begin
	if addr= '' then begin
     result:=addr;
     exit;
  end;

	parent := copy(addr,1,length(addr)-1);
	last := addr[length(addr)];

	if last = 'q'  then begin
	  last := 't';
		if nforward=0 then parent := GetNextTileY(parent, nforward);
	end
	else begin
     if last = 'r' then begin
		    last := 's';
		    if nforward=0 then parent := GetNextTileY(parent, nforward);
     end
	   else begin
        if last = 's' then begin
      		last := 'r';
		      if nforward<>0 then parent := GetNextTileY(parent, nforward);
	      end
	      else begin
          if last = 't' then begin
		        last := 'q';
		        if nforward<>0 then parent:= GetNextTileY(parent, nforward);
	        end;
        end;
     end;
  end;
	result:=parent + last;
end;

{
function rad(d:double):double;
begin
    result:=d * 3.1415926535897 / 180.0;
end;

function GetDistance(lat1,lng1, lat2, lng2:double):double;
var
    radLat1,radLat2,a,b,s:double;
begin
    radLat1 := rad(lat1);
    radLat2 := rad(lat2);
    a := radLat1 - radLat2;
    b := rad(lng1) - rad(lng2);
    s := 2 * asin(sqrt(pow(sin(a/2), 2) + cos(radLat1)*cos(radLat2)*pow(sin(b/2),2)));
    s := s * 6378.137 * 1000;
    result:=s;
end;
}

//根据经纬度和图屋序号计算qrst
function GetQuadtreeAddress(zoom:integer;long, lat:double):string;
var
  x,y:double;
  quad,lookup:string;
  t1,t2,tt:integer;
begin
  x := (180.0 + long) / 360.0;
  y := -lat * PI / 180; // convert to radians
  y := 0.5 * ln((1+sin(y))/(1 - sin(y)));
  y :=y * 1.0/(2 * PI);
  y := y + 0.5;
  quad := 't';
  lookup := 'qrts';
  while zoom>0 do begin
    x:=x - floor(x);
    y:=y - floor(y);
    if x >= 0.5 then
      t1:=1
    else
      t1:=0;
    if y >= 0.5 then
      t2:=2
    else
      t2:=0;
    tt:=t1+t2;
    quad := quad + lookup[tt+1];
    x:=x * 2;
    y:=y * 2;
    dec(zoom);
  end;
  result:=quad;
end;

{//根据经纬度和图屋序号计算图片行列
function GetQuadtreeXY(zoom:integer;long, lat:double):TRowCol;
var
  level:integer;
  RowCol:TRowCol;
  StartRow,StartCol:extended;
  x,y:double;
  quad,lookup:string;
  t1,t2,tt:integer;
begin
  x := (180.0 + long) / 360.0;
  y := -lat * PI / 180; // convert to radians
  y := 0.5 * ln((1+sin(y))/(1 - sin(y)));
  y :=y * 1.0/(2 * PI);
  y := y + 0.5;
  quad := 't';
  lookup := 'qrts';
  StartRow:=0;
  StartCol:=0;
  while zoom>0 do begin
    x:=x - floor(x);
    y:=y - floor(y);
    if x >= 0.5 then
      t1:=1
    else
      t1:=0;
    if y >= 0.5 then
      t2:=2
    else
      t2:=0;
    tt:=t1+t2;
    quad := quad + lookup[tt+1];
    x:=x * 2;
    y:=y * 2;
    dec(zoom);
  end;
  result:=RowCol;
end;
}

//根据经纬度和图屋序号计算图片行列
function GetQuadtreeXY(str:string):TRowCol;
var
  level,i:integer;
  RowCol:TRowCol;
  StartRow,StartCol:extended;
  c:string;
begin
  StartRow:=1;
  StartCol:=1;
  level:=length(str);
  for i:=2 to level do begin
     StartRow:=(StartRow-1)*2;
     StartCol:=(StartCol-1)*2;
     StartRow:=StartRow+1;
     StartCol:=StartCol+1;
     c := str[i];
     if c='r' then begin
        StartCol:=StartCol+1;
     end;
     if c='s' then begin
        StartRow:=StartRow+1;
        StartCol:=StartCol+1;
     end;
     if c='t' then begin
        StartRow:=StartRow+1;
     end;
  end;
  RowCol.Row:=round(StartRow);
  RowCol.Col:=round(StartCol);
  result:=RowCol;
end;
end.