The 15th Avenue Journal

Geographic to Grid - UTM Map Coordinates

2011-08-23T21:07:00.007+10:00

This is a demo delphi program to convert Geographic coordinates into UTM Grid coordinates and vice versa. Reference Formulae : http://www.epsg.org/

GeoGrid.zip contains the project source and release executable compiled in Delphi XE

Project Downloads

2011-08-21T15:16:00.003+10:00

StringGrid2CSV- Project to demonstate export and import of data in CSV format.
GeoGrid - Project to demonstrate Geographic and Grid conversions.

StringGrid to CSV

2011-08-21T14:19:00.011+10:00

This is a demo delphi 2010 project to show export and import of CSV files.




Project Code: StringGrid2CSV

unit mainform;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, ComCtrls, ExtCtrls, StdCtrls, ToolWin, Grids;

type

 TForm1 = class(TForm)

   Panel1: TPanel;

   Panel2: TPanel;

   Splitter1: TSplitter;

   StringGrid1: TStringGrid;

   Memo1: TMemo;

   ToolBar1: TToolBar;

   ToolButton1: TToolButton;

   btnImport: TToolButton;

   ToolButton2: TToolButton;

   ToolButton3: TToolButton;

   btnFillDefault: TToolButton;
procedure FormCreate(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure btnFillDefaultClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure btnImportClick(Sender: TObject);
private
{ Private declarations }
procedure ClearStringGrid(AStringGrid: TStringGrid; IncludeHeader: Boolean);
public
{ Public declarations }
end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

 btnFillDefault.Click;
end;

procedure TForm1.ClearStringGrid(AStringGrid: TStringGrid;

 IncludeHeader: Boolean);
var

 i: Integer;
begin
for i := 0to AStringGrid.RowCount - 1do
if (IncludeHeader or (i <> 0)) then

     AStringGrid.Rows[i].Clear
end;

Function ExportSG2CSV(Grid: TStringGrid; Memo: TMemo;

 FileName: String): Boolean;
Var

 CSV: TStrings;

 i: Integer;
begin

 CSV := TStringList.Create;
Try
For i := 0To Grid.RowCount - 1Do

     CSV.Add(Grid.Rows[i].CommaText);


   Memo.Lines := CSV;

   CSV.SaveToFile(FileName);

   Result := True;
Finally

   CSV.Free;
End;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin

 ExportSG2CSV(StringGrid1, Memo1, 'File1.csv');
end;

Procedure LoadCSVtoGrid(Grid: TStringGrid; FileName: String; Memo: TMemo);
var

 FileStringsList: TStringList;

 RowStringsList: TStringList;

 i: Integer;
begin

 FileStringsList := TStringList.Create;

 RowStringsList := TStringList.Create;
try

    FileStringsList.LoadFromFile(FileName);
//FileStringsList.Assign(Memo.Lines);

   Grid.RowCount := FileStringsList.Count;
for i := 0to FileStringsList.Count - 1do
begin

     RowStringsList.Clear;

     RowStringsList.CommaText := FileStringsList[i];

     Grid.Rows[i].Assign(RowStringsList);
end;
finally

   FileStringsList.Free;

   RowStringsList.Free;
end;
end;

procedure TForm1.btnImportClick(Sender: TObject);
begin

 LoadCSVtoGrid(StringGrid1, 'File1.csv', Memo1);
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin

 ClearStringGrid(StringGrid1, True);
end;

procedure TForm1.btnFillDefaultClick(Sender: TObject);
var

 i, J, K: Integer;
begin

 K := 0;
with StringGrid1 do
for i := 0to ColCount - 1do
for J := 0to RowCount - 1do
begin

       K := K + 1;

       Cells[i, J] := Format('%*.*d', [2, 2, K]) + ' Col ' + IntToStr(i)

         + ' Row ' + IntToStr(J);
end;
end;

end.

Title Case

2011-08-20T07:42:00.002+10:00

// uses sysutils
function TitleCase(const s: string): string;
var
i: integer;
begin
if s = '' then
Result := ''
else
begin
Result := Uppercase(s[1]);
for i := 2 to Length(s) do
if s[i - 1] = ' ' then
Result := Result + Uppercase(s[i])
else
Result := Result + Lowercase(s[i]);
end;
end;

Famous Delphi Links

2011-08-19T07:30:00.054+10:00

// The 15th Ave - Top Ten

About Delphi - Zarko Gajic Delphi Guide

CodeGearGuru - Delphi Video Tutorials and Book Reviews

Delphi3000 - Delphi community for knowledge exchange
Delphi Basics - Help and Reference for the fundamentals
Delphi Dabbler - Free Programs, Delphi Components, Tutorials & more
Delphi Feeds - Feeds from blogs, newsgroups and other Delphi sites
DelphiForFun - Delphi tutorials by example
Marco Cantu - Delphi Development, Blogs, Books & more
Swiss Delphi Center - Developers Knowledge Base
TeamB Blogs - Embarcadero TeamB Blogs

Get Filesize in Bytes

2011-08-18T21:38:00.005+10:00

// uses sysutils
function pwGetFileSize(const FName: string): Int64;

var

SearchRec: TSearchRec;

begin

if FindFirst(ExpandFileName(FName), faAnyFile, SearchRec) = 0 then

begin

Result := SearchRec.Size;

FindClose(SearchRec);

end

else Result := -1;

end;

Geodetic Conversions and Transformations Unit

2011-08-18T16:35:00.002+10:00

Unit UGeodesy;

// Developed by Peter Walker, used for SeaNav Program dated 20110818

interface

{Geo to Grid - Redfearn's Formula}

Procedure CalcEN(Lat,Long,Cm,a,f,ko,EFO,NFO :extended;

Var East,North,Conv1Deg,PSF: Extended);

{Grid to Geo - Redfearn's Formula}

procedure CalcLatLon(East,North,Cm,a,f,ko,EFO,NFO: extended ;

Var LatDeg,LongDeg,convDeg,PSF: extended);

{transformations coord frame}

Procedure CalcXYZ1(Lat1,Lon1,Ht1,a1,f1: extended ; var X1,Y1,Z1 : extended);

Procedure CalcXYZ2(X1,Y1,Z1,Dx,Dy,Dz,Rx,Ry,Rz,Sc: extended ;

var X2,Y2,Z2 : extended);

{transformations position vector}

Procedure CalcXYZ2pv(X1,Y1,Z1,Dx,Dy,Dz,Rx,Ry,Rz,Sc: extended ;

var X2,Y2,Z2 : extended);

Procedure CalcLatLon2(X2,Y2,Z2,a2,f2: extended; Var LatDeg2,LonDeg2,Ht2: extended);

{Molodensky}

procedure CalcDelta(Gf1,Ga1,Lat1Deg,Lon1Deg,Ht1,dx,dy,dz,da,df : extended;

var dLatDeg,dLonDeg,dHt2 : extended);

implementation

Uses Math;

{Geo to Grid}

Procedure CalcEN(Lat,Long,Cm,a,f,ko,EFO,NFO :extended;

Var East,North,Conv1Deg,PSF: extended);

var

e2,S,C,v,w,latr,vp,t,p,m,A0,A2,A4,A6,

ETerm1, ETerm2, ETerm3, ETerm4,NTerm1, NTerm2, NTerm3, NTerm4,

CTerm1, CTerm2, CTerm3, CTerm4 : extended;

begin

{Formula use Lat, Long, CM}

latr := DegToRad(lat);

e2 := 2*f-SQR(f);

v := a / Power((1-e2*sqr(sin(latr))),(1/2));

p := a * (1-e2)/power(1-e2*Sqr(sin(latR)),3/2);

w := DegToRad(Long-cm);

vp := v/p;

t := tan(Latr);

A0 := 1-e2/4-3*e2*e2/64-5*e2*e2*e2/256;

A2 := (3/8)*(e2+e2*e2/4+15*e2*e2*e2/128);

A4 := (15/256)*(e2*e2+3*e2*e2*e2/4);

A6 := 35*e2*e2*e2/3072;

m := a*(A0*latr-A2*sin(2*latR)+A4*sin(4*latR)-A6*sin(6*latR));

c := cos(latr);

s := sin(latr);

{Formula 4.5}

ETerm1 := v*w*c;

ETerm2 := v*w*w*w/6*c*c*c*(vp-t*t);

ETerm3 := v*(w*w*w*w*w/120*c*c*c*c*c*

(4*vp*vp*vp*(1-6*t*t)+vp*vp*(1+8*t*t)-vp*(2*t*t)+t*t*t*t));

ETerm4 := v*(w*w*w*w*w*w*w/5040)*c*c*c*c*c*c*c*

(61-479*t*t+179*t*t*t*t-t*t*t*t*t*t);

NTerm1 := v*s*(w*w/2)*c;

NTerm2 := v*s*(w*w*w*w/24)*c*c*c*

(4*vp*vp+vp-t*t) ;

NTerm3 := v*s*(w*w*w*w*w*w/720)*c*c*c*c*c*

(8*vp*vp*vp*vp*(11-24*t*t)-28*vp*vp*vp*(1-6*t*t)+

vp*vp*(1-32*t*t)-vp*(2*t*t)+t*t*t*t);

NTerm4 := v*s*(w*w*w*w*w*w*w*w/40320)*c*c*c*c*c*c*c*

(1385-3111*t*t+543*t*t*t*t-t*t*t*t*t*t);

East := ko * (ETERM1+ETERM2+ETERM3+ETERM4);

North := ko * (m + NTERM1+NTERM2+NTERM3+NTERM4);

East := East + EFO;

North := North + NFO;

CTerm1 := -s*w;

CTerm2 := -s*(w*w*w/3)*c*c*(2*vp*vp-vp);

CTerm3 := -s*(w*w*w*w*w/15)*c*c*c*c*

(vp*vp*vp*vp*(11-24*t*t)-vp*vp*vp*(11-36*t*t)+

2*vp*vp*(1-7*t*t)+vp*t*t);

Conv1Deg := CTerm1 + Cterm2 + CTerm3;

Conv1Deg := RadToDeg(Conv1Deg);{*180/pi;}

PSF := ko*(1+(w*w/2)*c*c*vp +

(w*w*w*w/24)*c*c*c*c*(4*vp*vp*vp*(1-6*t*t)+vp*vp*(1+24*t*t)-4*vp*t*t)+

(w*w*w*w*w*w/720)*c*c*c*c*c*c*(61-148*t*t+16*t*t*t*t));

end;

{conversions}

procedure CalcLatLon(East,North,CM,a,f,ko,EFO,NFO: extended ;

Var LatDeg,LongDeg,convDeg,PSF: extended);

var

ED, ND, m ,n, G, O, LATD, sec,e2,

PD,VD,TD,VP,x,z,LATR,w,CTERM1,CTERM2,CTERM3, ED2, KOPV, y, y2 : extended;

begin

ED := East - EFO;

ND := North - NFO;

m := ND / ko ;

n := f / (2-f);

G := a*(1-n)*(1-SQR(n))*(1+(9/4)*sqr(n)+(225/64)*sqr(n)*sqr(n))*(pi/180);

O := (m*PI)/(G*180);

LATD := O+((3*n/2)-(27*n*n*n/32))*sin(2*O)

+((21*n*n/16)-(55*n*n*n*n/32))*sin(4*O)

+(151*n*n*n/96)*sin(6*O)

+(1097*n*n*n*n/512)*sin(8*O);

LATDEG := LATD*180/pi;

sec := 1/cos(latd);

TD := sin((latD))/cos((latD));

e2 := 2*f-SQR(f);

PD := a * (1-e2)/power(1-e2*Sqr(sin(latd)),3/2);

VD := a / Power((1-e2*sqr(sin(latd))),(1/2));

vp := vd/pd;

x := ED/(ko*vd);

z := TD/(ko*PD);

LATR := LATD - z * x * ED/2

+ z *(x*x*x*ED/24)*(-4*vp*vp+9*vp*(1-TD*TD)+12*TD*TD)

- z *(x*x*x*x*x*ED/720)*(8*vp*vp*vp*vp*(11-24*td*td)-12

*vp*vp*vp*(21-71*td*td)

+15*vp*vp*(15-98*td*td+15*td*td*td*td)+180*vp*(5*td*td-3

*td*td*td*td)+360*td*td*td*td)

+ z *(x*x*x*x*x*x*x*ED/40320)*

(1385+3633*td*td+4095*td*td*td*td+1575*td*td*td*td*td*td);

LATDEG := LATR * 180 /PI;

{long}

w := sec * x

-sec*x*x*x/6*(vp+2*td*td)

+sec*x*x*x*x*x/120*(-4*vp*vp*vp*(1-6*td*td)+vp*vp*(9-68*td*td)

+72*vp*td*td+24*td*td*td*td)

-sec*x*x*x*x*x*x*x/5040*(61+662*td*td+1320*td*td*td*td+720

*td*td*td*td*td*td);

LONGDEG := w * 180 / PI + cm;

CTerm1 := -td*x;

CTerm2 := td*x*x*x/3*(-2*vp*vp+3*vp+td*td);

CTerm3 := -td*x*x*x*x*x/15*(vp*vp*vp*vp*(11-24*td*td)-3*vp*vp*vp

*(8-23*td*td)+5*vp*vp*(3-14*td*td)+30*vp*td*td+3*

td*td*td*td);

{CTerm4 := }

convDeg := CTerm1 + Cterm2 + CTerm3;

convDeg := convDeg*180/pi;

{Point Scale Factor}

y := Ed/(ko*sqrt(pd*vd));

y2 := y*y;

PSF := ko*(1+ y2/2 +

y2*y2/24*(4*vp*(1-6*td*td)-3*(1-16*td*td)-24*td*td/vp)+

y2*y2*y2/720);

end;

{Transformations} {lat1 and lon1 in degrees}

Procedure CalcXYZ1(Lat1,Lon1,Ht1,a1,f1: extended ; var X1,Y1,Z1 : extended);

var

rLat1,rLon1: extended;

e2, sLat, cLat, sLon, cLon, SinSqrLat, v : extended;

begin

rLat1 := DegToRad(Lat1);

rLon1 := DegToRad(Lon1) ;

e2 := 2*f1-Sqr(f1); {e2 = Sqr(e)} {b := a*(1-f);}

sLat := sin(rLat1);

cLat := cos(rLat1);

sLon := sin(rLon1);

cLon := cos(rLon1);

SinSqrLat := sLat * sLat;

v := a1 / sqrt(1-e2*SinSqrLat);

{ Lat Lon Ht to Cartesians Ht = N + h }

X1 := (v + Ht1) * cLat * cLon;

Y1 := (v + Ht1) * cLat * sLon;

Z1 := (v * (1-e2) + Ht1) * sLat;

end;

Procedure CalcXYZ2(X1,Y1,Z1,Dx,Dy,Dz,Rx,Ry,Rz,Sc: extended ;

var X2,Y2,Z2 : extended);

begin

Rx := DegToRad((Rx * 10e-5)/3600);

Ry := DegToRad((Ry * 10e-5)/3600);

Rz := DegToRad((Rz * 10e-5)/3600);

Sc := 1 + Sc*1e-6;

X2 := Dx + (Sc) * ((1*X1) + (Rz*Y1) + (-Ry*Z1));

Y2 := Dy + (Sc) * ((-Rz*X1) + (1*Y1) + (Rx*Z1));

Z2 := Dz + (Sc) * ((Ry*X1) + (-Rx*Y1) + (1*Z1));

end;

Procedure CalcXYZ2pv(X1,Y1,Z1,Dx,Dy,Dz,Rx,Ry,Rz,Sc: extended ;

var X2,Y2,Z2 : extended);

begin

Rx := DegToRad((Rx * 10e-5)/3600);

Ry := DegToRad((Ry * 10e-5)/3600);

Rz := DegToRad((Rz * 10e-5)/3600);

Sc := 1 + Sc*1e-6;

X2 := Dx + (Sc) * ((1*X1) + (-Rz*Y1) + (Ry*Z1));

Y2 := Dy + (Sc) * ((Rz*X1) + (1*Y1) + (-Rx*Z1));

Z2 := Dz + (Sc) * ((-Ry*X1) + (Rx*Y1) + (1*Z1));

end;

Procedure CalcLatLon2(X2,Y2,Z2,a2,f2: extended; Var LatDeg2,LonDeg2,Ht2: extended);

var

b2,e2,ed2, Lat2, Lon2,P2, Theta,sinTheta,cosTheta,

Sin3Theta, Cos3Theta,v,SinSqrLat : extended;

Begin

{Params sys 2}

b2 := a2*(1-f2);

e2 := 2*f2-Sqr(f2);

ed2 := e2 + (e2*e2) / (1-e2);

P2 := Sqrt(Sqr(X2)+Sqr(Y2)); {(X2^2 + Y2^2)^1/2}

if p2 = 0 then exit;

Theta := DegToRad(ArcTan2(( P2 * b2),(Z2*a2)));

sinTheta := Sin(Theta);

CosTheta := Cos(Theta);

Sin3Theta := sinTheta * sinTheta * sinTheta;

Cos3Theta := cosTheta * cosTheta * cosTheta;

Lat2 := ArcTan2((P2-e2*a2*Cos3Theta),(Z2+ed2*b2*Sin3Theta));

LatDeg2 := Lat2;

Lon2 := ArcTan2(X2,Y2);

LonDeg2 := Lon2;

SinSqrLat := Sin(RadToDeg(Lat2)) * Sin(RadToDeg(Lat2));

v := a2 / sqrt(1-e2*SinSqrLat);

Ht2 := p2/cos(RadToDeg(Lat2))-v;

End;

function Power1(y,x:extended):extended;

Var

negY : Boolean;

YX : extended;

begin

{ Raise y to the power of x }

negY := false;

if y < 0 then

begin

negY := true;

y := abs(y);

end;

if y = 0 then y := 1e-20;

YX := Exp(Ln(y) * x );

if NegY then YX := -(YX);

Result := YX;

end;

{Molodensky}

procedure CalcDelta(Gf1,Ga1,Lat1Deg,Lon1Deg,Ht1,dx,dy,dz,da,df : extended;

var dLatDeg,dLonDeg,dHt2 : extended);

var

Lat,Long,e2,slat,clat,slon,clon,ssqlat, adb, rn, rm, tlat, tlon,th : extended;

begin

{da := -da; df := -df;}

Lat := DegToRad(Lat1Deg);

Long := DegToRad(Lon1Deg);

e2 := 2*Gf1-sqr(Gf1);

slat := sin(Lat);

clat := cos(Lat);

slon := sin(Long);

clon := cos(Long);

ssqlat := slat * slat;

adb := 1/(1-Gf1);

rn := Ga1 / sqrt(1- e2 * ssqlat);

rm := Ga1 * (1- e2) /

power1( (1- e2 * ssqlat), 1.5 );

tlat := -dx * slat * clon - dy * slat * slon +

dz * clat;

tlat := tlat + da * (rn * e2 * slat * clat)

/ Ga1;

tlat := tlat + df * (rm * adb + rn / adb) * slat * clat;

tlat := tlat / (rm + Ht1);

tlon := (-dx * slon + dy * clon) /

((rn + Ht1) * clat);

th := dx * clat * clon + dy * clat * slon +

dz * slat;

th := th - da * Ga1 / rn + df * rn *

ssqlat / adb;

dLatDeg := RadToDeg(tlat);

dLonDeg := RadToDeg(tlon);

dHt2 := th;

end;

end.

Iterate Table

2011-08-18T08:32:00.003+10:00

// uses DB

procedure TForm1.ToolButton1Click(Sender: TObject);

var

i: integer;

begin

with Table1 do

begin

DisableControls;

try

First;

while not Table1.EOF do

begin

// your code here, process record

Next;

Application.ProcessMessages;

end;

finally

EnableControls;

end;

end; // with Table1 do

end;

Run On Startup

2011-08-17T17:21:00.004+10:00

// uses TRegistry

procedure SetRunOnStartup(sProgTitle, sCmdLine: string;

RunType: TRunOnStartupAction);

var

reg: TRegIniFile;

sStartupRegKey: string;

begin

try

sStartupRegKey := 'Software\Microsoft\Windows\CurrentVersion\Run';

reg := TRegIniFile.Create('');

reg.RootKey := HKEY_CURRENT_USER; //works for win7

if RunType = rsRunOnce then

reg.WriteString(sStartupRegKey + 'Once'#0, sProgTitle, sCmdLine)

else if RunType = rsRunAllways then

reg.WriteString(sStartupRegKey + #0, sProgTitle, sCmdLine)

else

reg.DeleteKey(sStartupRegKey + #0, sProgTitle);

reg.Free;

except

ShowMessage('Error!');

end;

procedure TForm1.ToolButton1Click(Sender: TObject);

begin

SetRunOnStartup(Application.Title, Application.ExeName, rsRunAllways);

Showmessage('Program will run on windows startup!');

end;

procedure TForm1.ToolButton2Click(Sender: TObject);

begin

SetRunOnStartup(Application.Title, Application.ExeName, rsRunNever);

Showmessage('Program will NOT run on windows startup!');

end;

Escape Process

2011-08-17T17:04:00.002+10:00

// Press Esc to break out of a process

Application.ProcessMessages;

If GetKeyState(VK_Escape) and 128 = 128 then

begin

if MessageDlg('Stop process?',

mtConfirmation, [mbYes, mbNo], 0) = mrYes then

begin

break;

end;

Format Bytes

2011-08-17T16:35:00.006+10:00

// Return a formatted string from bytes

function FormatByteSize(const bytes: Longint): string;

const

B = 1; // byte

KB = 1024 * B; // kilobyte

MB = 1024 * KB; // megabyte

GB = 1024 * MB; // gigabyte

begin

if bytes > GB then

result := FormatFloat('#.## GB', bytes / GB)

else if bytes > MB then

result := FormatFloat('#.## MB', bytes / MB)

else if bytes > KB then

result := FormatFloat('#.## KB', bytes / KB)

else

result := FormatFloat('#.## bytes', bytes);

end;