unit WMMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, ExtCtrls,jpeg;

type
  TForm1 = class(TForm)
    Button2: TButton;
    StringGrid1: TStringGrid;
    Button3: TButton;
    Edit1: TEdit;
    Image2: TImage;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Panel1: TPanel;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
    MappingMode : Integer;
    procedure ClearCanvas;

  end;

var
  Form1: TForm1;
  counter : integer;

implementation

{$R *.DFM}

 function nextcomma(s:string;i:integer):integer;
var
j:integer;
begin
 j:=i+1;
 while (j<length(s))and(s[j]<>':') do inc(j);
 if (j<=length(s))and(s[j]=':') then result:=j
 else result:=-1;
end;
 {
function nextcolan(s:string;i:integer):integer;     //version 1   gives entire string
var
j:integer;
begin
 j:=i+1;
 while ((j<length(s))and ((s[j]<>',') or((j<length(s))and(s[j]<>';')))) do inc(j);
 if ((j<=length(s))and ((s[j]=',') or ((j<=length(s))and(s[j]=';'))))then result:=j
 else result:=-1;
end;
     }
function nextcolan(s:string;i:integer):integer;     //version 2   gives substring with problems
var
j:integer;
begin
 j:=i+1;
 while ((j<length(s))and(s[j]<>',')) do inc(j);
 if ((j<=length(s))and(s[j]=','))then result:=j
 else result:=-1;
end;

 {
function nextcolan(s:string;i:integer):integer;     //version 3   gives substring with problems
var
j:integer;
begin
 j:=i+1;
 while ((j<length(s))and(s[j]<>',')) do inc(j);
 if ((j<=length(s))and(s[j]=';'))then result:=j      //note ; instead of ,
 else result:=-1;
end;
 }

function GetFirstV(s:string;var i:integer):string; // first value in a line
begin
 i:=nextcomma(s,1);
 if (i<>-1) then result:=copy(s,1,i-1)
 else result:='';
end;

 function GetFirstV2(s:string;var i:integer):string; // first value in a line
begin
 i:=nextcolan(s,1);
 if (i<>-1) then result:=copy(s,1,i-1)
 else result:='';
end;

function GetNextV(s:string;var i:integer):string; // next value in a line
var j:integer;
begin
 j:=i;
 i:=nextcomma(s,j);
 if (i<>-1) then result:=copy(s,j+1,i-j-1)
 else result:=copy(s,j+1,length(s)-j);
end;

function GetNextV2(s:string;var i:integer):string; // next value in a line
var j:integer;
begin
 j:=i;
 i:=nextcolan(s,j);
 if (i<>-1) then result:=copy(s,j+1,i-j-1)
 else result:=copy(s,j+1,length(s)-j);
end;

function StripDelimiters(S: string):string;
var
  i: Integer;
begin
  i := Length(S);
  while (Length(S) <= i) and (Length(S) > 0) and ((S[i] = ';') or (S[i] = ',')) do begin
    Delete(S,i,1);
    Dec(i);
  end;
  StripDelimiters := S;
end;

{
 firstvalue:=GetFirstV(mystring,i);
 if (firstvalue<>'') then begin
  nextvalue:=GetNextV(mystring,i);
  while (nextvalue<>'') do begin    // a for loop may do
   nextvalue:=GetNextV(mystring,i);
   ..

  end;
 end;
           }

 function Sgn (X: Real): Real;
  begin
        if abs(x) > x then
          result := -1.0
        else if abs(x)  = x then
        result := 1.0;
  end;





procedure TForm1.ClearCanvas;
begin
        with Canvas do
        begin
          Brush.Style := bsSolid;
          Brush.Color := clWhite;
          FillRect(ClipRect);
        end;
end;





procedure TForm1.Button2Click(Sender: TObject);

var
        Infile : TextFile;
        InString, fname : string;
         c : integer;
        filerow :integer;
begin
   filerow := 0;
   c := 0 ;
  fname :='worldmap.dat';
  // fname :='map3.dat';
   AssignFile(InFile,fname);
   Reset(InFile);

        begin
        while not Eof(Infile) do
           begin
           Readln(Infile, Instring);
           with StringGrid1 do
           begin
             Cells[0,c] := Copy(Instring,1,5);
             Cells[1,c] := Copy(Instring,9,12);
           end;
           c:= c+1;
           filerow := c-1;
        end;
end;
CloseFile(InFile);
StringGrid1.RowCount:= filerow;

 
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  I : integer;
  mapdatacount, mda : integer;
  xValue, xValue2, yValue: integer;
  xValueSt, xValue2St, yValueSt, yValue2St : string;

  multiplier:real;

begin
  Button2Click(sender);  //load the digital map file
  //ClearCanvas;
  SetMapMode(Canvas.Handle, MM_ISOTROPIC);

  Canvas.Brush.Color := clwhite;
  SetWindowExtEx(Canvas.Handle, 500, 500, nil);
  SetViewportExtEx(CAnvas.Handle, ClientWidth, ClientHeight,nil);
 // SetViewportExtEx(Canvas.Handle, ClientWidth, 200,nil);
 // SetViewportOrgEx(Canvas.Handle, ClientWidth div 2, ClientHeight div 2,nil);
  SetViewportOrgEx(Canvas.Handle, ClientWidth div 4, ClientHeight div 4,nil);
  //Canvas.Rectangle(0,0,250,50);  //left,top,width, height
  // Canvas.Rectangle(-240,-190,220,40);   //white background for map
  //1st number is left position
  mapdatacount := StringGrid1.rowcount;

  mda := mapdatacount;
  For I := 1 to mda -6 do
      begin
      edit1.text := inttostr(i);
      xValuest := trim(StringGrid1.Cells[1,I]);
      XVALUE2st :=trim(StringGrid1.Cells[1,I]);
      yValuest :=trim(StringGrid1.Cells[0,I]);
      YValue2st:=trim(StringGrid1.Cells[0,I]);

      delete(xValuest,pos('.',xValuest),5);   //drop the decimal sign
      delete(xValue2st,pos('.',xValue2st),5);
      delete(yValuest,pos('.',yValuest),5);
      delete(yValue2st,pos('.',yValue2st),5);

      if (xValuest = '') or (xValuest = '-') then  //ignore internal delimiters
        xValuest := '0';
      if (xValue2St = '')or (xValue2st = '-')then
        xValue2St := '0';
      if( yValuest = '')or (yValuest = '-')then
        yValuest := '0';
      if (yValue2St = '')or (yValue2st = '-')then
        yValue2St := '0';

     if CheckBox1.checked = true then multiplier :=1.5
      else multiplier :=1;

     // if CheckBox1.checked = true then Canvas.Rectangle(-280,-110,220,40)
     // else  Canvas.Rectangle(-240,-190,220,40);

     //change map coordinates to screen coordinates
      xValue2:= (strtoint(xValuest)-160);  //change 160+/- to shift left/right
      xValue:= round(strtoint(xValuest)*multiplier) ; //-160)* multiplier;
      //change the 'center' of the map coordidnates
      if xValue2 < Round((180-160)) then     //change 160+/- to shift left/right
        begin
        xValue := Round(xValue + (360));
        if CheckBox1.checked = true then XValue := xValue +180;

        end;

       if CheckBox1.checked = true then XValue := xValue -270;

      yvalue := -((strtoint(yValuest)))+200; //200 shifts up or down form
      if CheckBox1.checked = true then yValue := -((strtoint(yValuest)*2))+200;

      Canvas.ellipse(xValue , yValue,xvalue+2,yValue+2);

      end;

end;



procedure TForm1.Button4Click(Sender: TObject);

var
  Bitmap: TBitmap;
  MyRect, MyOther: TRect;
begin

  MyRect := Rect(10,10,1500,1500);

  MyOther := Rect(10,111,1500, 1501);
//  MyOther := Rect(10,111,100, 201);

  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('wdb2.bmp');
 // Form1.Canvas.BrushCopy(MyRect, Bitmap, MyRect, clBlack);
  Form1.Canvas.CopyRect(MyOther,Bitmap.Canvas,MyRect);
  Bitmap.Free;
end;


procedure TForm1.Button5Click(Sender: TObject);
var
fudge:real;
long:integer;
lat:integer;
equat:integer;
begin
fudge := 1.1;  //to adjust for bit map stretch
long := round(180*fudge);
lat:= round(90*fudge);
equat:= round(360*fudge);

  Image2.Picture.Bitmap.canvas.pen.color := clRed;  //longitude
  long := round(long);
  Image2.Picture.Bitmap.canvas.moveto(long,0);
  Image2.Picture.Bitmap.canvas.lineto(long,long);
  Image2.Picture.Bitmap.canvas.pen.color := clBlue;   //latitude
  Image2.Picture.Bitmap.canvas.moveto(0,lat);
  Image2.Picture.Bitmap.canvas.lineto(equat,lat);

 end;

procedure TForm1.Button6Click(Sender: TObject);

begin
        //draws simple grid on bitmap
     Image2.Picture.Bitmap.canvas.pen.color := clRed;
     Image2.Picture.Bitmap.canvas.moveto(400,0);
     Image2.Picture.Bitmap.canvas.lineto(400,400);
     Image2.Picture.Bitmap.canvas.pen.color := clBlue;
     Image2.Picture.Bitmap.canvas.moveto(0,200);
     Image2.Picture.Bitmap.canvas.lineto(800,200);

end;

procedure TForm1.Button7Click(Sender: TObject);
var
 long, lat ,long2,lat2: integer;
 longr, latr,longr2,latr2 ,longr3: real;

begin
 
  //code to draw on bit map
  longr := strtofloat(edit4.text);  // get longitude from edit box
  latr := strtofloat(edit3.text);
  longr := (longr*(-1.111))+200;    //factors determined by experiment
  latr := (latr*(-1.116666)) +100;
  long := strtoint(floattostr(Round(longr)));
  lat := strtoint(floattostr(Round(latr)));

  //code to draw on digital map
  longr2 := strtofloat(edit4.text);
  latr2 := -strtofloat(edit3.text);
  longr3 := -(longr2*(1))+360;
   if longr2 < Round((181)) then     
        begin
          longr2 := -Round(longr2 - (90));
        if CheckBox1.checked = true then longr3 := Round(longr3 * 1.5 - (270))


        end;


  latr2 := (latr2*(1)) +200;
  if CheckBox1.checked = true then latr2:= (latr2*(2))-200 ;

  long2 := strtoint(floattostr(Round(longr3))); //canvas is fussy about this being an integer
  lat2 := strtoint(floattostr(Round(latr2)));

  //draw on bitmap
  Image2.Picture.Bitmap.canvas.pen.color:=clBlue; //plot in blue
  Image2.Picture.Bitmap.canvas.Ellipse(long-7,lat-6,long-2+4,lat-1+4);
  //draw on digital map
  canvas.pen.color := clBlue;
   Canvas.ellipse(long2-4,lat2-4,long2+4,lat2+4);
   // equatiion should beCanvas.ellipse(long2,lat2,long2,lat2+5);
   // but factors added to center plotted ellipse
    canvas.pen.color := clBlack;    //change plot color back to black
end;






procedure TForm1.Button1Click(Sender: TObject);
begin
        Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        Image2.Picture.LoadFromFile('wmap.bmp');//load the map bitmap file (400x200 pixels)
end;

end.


