HAM Radio 1/HamRadio.cdr/math/daylite/ui.pas

Pascal/Delphi Source File | 1989-07-17 | 5.3 KB | 208 lines

unit UI;

interface

  uses Globals,Calculate;

  procedure InitInputs(var Lat,Long,Zone:Float;
                       var theYear:Longint; var theMonth,theDay:integer);

  function GetInputs(var Lat,Long,Zone:Float;
                     var theYear:Longint; var theMonth,theDay:integer)
                     :Boolean;

  procedure ShowResults(var Day:DayTime);

implementation

  uses DOS,CRT,Forms;


  type
       Sexidecimal = record
         d,m,s: longint;
         end;

  procedure Float2Sex(n:Float;var sex:Sexidecimal);
    begin with sex do begin
      d := trunc(n);
        n := n - d;
      n := n * 60;
        m := trunc(n);
        n := n - m;
      s := round(n*60);
    end end;

  type
       Place = record
         yyyy,mm,dd:LongInt;
         La,Lo:Sexidecimal;
         Z:Real;
         end;

  const Calgary : Place = (yyyy:1989;
                           mm:6;
                           dd:23;
                           La:(d:51;m:02;s:26);
                           Lo:(d:114;m:3;s:24);
                           Z:6.0
                           );

  var F: Form;
      P: Place;

  function dd(n:integer):string;
    var s:string[2];
    begin
      str(n,s);
      if length(s)=1 then
        s := '0'+s;
      dd := ':'+s;
    end;

  function HHMMSS(hours:float):string;
    var
      h : longint;
      m,s: integer;
      v : string;
    begin
      Dec2Sex(hours+1/7200,h,m,s);
      str(h,v);
      HHMMSS := v+dd(m)+dd(s);
    end;

  function HHMM(hours:float):string;
    var
      h : longint;
      m,s: integer;
      v : string;
    begin
      Dec2Sex(hours+1/120,h,m,s);
      str(h,v);
      HHMM := v+dd(m);
    end;

  procedure WriteHeader;
    var i : integer;
    begin
      Window(1,1,80,25);
      Color(BackColor);
      ClrScr;
      Color(ForeColor);
      GotoXY(1,1);ClrEol;
      GotoXY(1,25);ClrEol;
      GotoXY(27,25);Write('F2-Calculate   Esc-Quit');
      GotoXY(27,1);Write('Sunrise/Sunset Calculator');
    end;


  procedure InitInputs(var Lat,Long,Zone:Float;
                       var theYear:Longint; var theMonth,theDay:integer);
    var y,m,d,dayOfWeek: word;
    begin
      P := Calgary;
      with P do begin
        Lat  := Sex2Dec(La.d,La.m,La.s);
        Long := Sex2Dec(Lo.d,Lo.m,Lo.s);
        Zone := Z;
        DOS.GetDate(y,m,d,dayOfWeek);
        yyyy := y;
        mm   := m;
        dd   := d;
        theYear := yyyy;
        theMonth:= mm;
        theDay  := dd;
      end;
      WriteHeader;
    end;


  function GetInputs(var Lat,Long,Zone:Float;
                     var theYear:Longint; var theMonth,theDay:integer)
                     :Boolean;
    var ok:boolean;
        code : char;
    begin
      Window(1,1,80,25);
      F.Init(22,3,59,11);
      F.Add(New(FIntPtr, Init( 3, 2, ' Year ', -99999999,99999999)));
      F.Add(New(FIntPtr, Init(18, 2, ' Month ', 1,12)));
      F.Add(New(FIntPtr, Init(27, 2, ' Day ', 1,31)));
      F.Add(New(FIntPtr, Init(3, 4, ' Latitude  - Deg:', 0, 359)));
      F.Add(New(FIntPtr, Init(23, 4, ' Min:', 0, 59)));
      F.Add(New(FIntPtr, Init(30, 4, ' Sec:', 0, 59)));
      F.Add(New(FIntPtr, Init(3, 6, ' Longitude - Deg:', 0, 359)));
      F.Add(New(FIntPtr, Init(23, 6, ' Min:', 0, 59)));
      F.Add(New(FIntPtr, Init(30, 6, ' Sec:', 0, 59)));
      F.Add(New(FRealPtr, Init(3, 8, ' Time Zone ', 5, 2)));

      with P do begin
        Float2Sex(Lat,La);
        Float2Sex(long,Lo);
        Z    := Zone;
        yyyy := theYear;
        mm   := theMonth;
        dd   := theDay;
      end;
      GetInputs := False;
      repeat
        F.Put(P);
        F.Show(True);
        code := F.Edit;
        if code in [CSave,CEsc] then begin
          F.Get(P);
          with P do begin
            ok := ValidDate(yyyy,mm,dd);
            if not ok then begin
              yyyy := theYear;
              mm   := theMonth;
              dd   := theDay;
            end;
          end;
         end
      until ok;
      F.Done;
      if code=CSave then with P do begin
        Lat  := Sex2Dec(La.d,La.m,La.s);
        Long := Sex2Dec(Lo.d,Lo.m,Lo.s);
        Zone := Z;
        theYear  := yyyy;
        theMonth := mm;
        theDay   := dd;
      end;
      GetInputs := (code=CSave);
    end;

  procedure TimeWindow;
    begin
      Window(22,12,59,25);
      GotoXY(1,1);
      Color(ForeColor);
    end;

  procedure WriteTime(prompt:string;t:float);
    var i:integer;
    begin
      for i := 24 downto length(prompt) do prompt[i] := ' ';
      prompt[0] := #24;
      ClrEol;
      GotoXY(4,whereY);
      Writeln(prompt,HHMM(t):5);
    end;

  procedure ShowResults(var Day:DayTime);
    begin
      TimeWindow;
      WriteLn;
      WriteTime('Astronomical Dawn : ',Day.Astronomical.Dawn);
      WriteTime('Nautical Dawn : ',    Day.Nautical.Dawn);
      WriteTime('Civil Dawn : ',       Day.Civil.Dawn);
      WriteTime('Sunrise : ',          Day.Actual.Dawn);
      WriteLn;
      WriteTime('Sunset  : ',          Day.Actual.Dusk);
      WriteTime('Civil Dusk : ',       Day.Civil.Dusk);
      WriteTime('Nautical Dusk : ',    Day.Nautical.Dusk);
      WriteTime('Astronomical Dusk : ',Day.Astronomical.Dusk);
    end;

end.