1. Calculating Easter date
  2. Daynumber
  3. Algorithm or equation for determining sunrise/set and moonrise/set (BASIC)
  4. Date format
  5. DateSer Function[UPD]
  6. Automatic Year in a date edit[NEW]

Calculating Easter date

From: Joe Nodeland <joe_nodeland@sunshine.net>


function TtheCalendar.CalcEaster:String;
var B,D,E,Q:Integer;
    GF:String;
begin
 B:=225-11*(Year Mod 19);
 D:=((B-21)Mod 30)+21;
 If D>48 then Dec(D);
 E:=(Year+(Year Div 4)+D+1)Mod 7;
 Q:=D+7-E;
 If Q<32 then begin
  If ShortDateFormat[1]='d' then 
Result:=IntToStr(Q)+'/3/'+IntToStr(Year)
  else Result:='3/'+IntToStr(Q)+'/'+IntToStr(Year);
 end
 else begin
  If ShortDateFormat[1]='d' then
Result:=IntToStr(Q-31)+'/4/'+IntToStr(Year)
  else Result:='4/'+IntToStr(Q-31)+'/'+IntToStr(Year);
 end;
 {calc good friday}
 If Q<32 then begin
  If ShortDateFormat[1]='d' then  GF:=IntToStr(Q-2)+'/3/'+IntToStr(Year)
  else GF:='3/'+IntToStr(Q-2)+'/'+IntToStr(Year);
 end
 else begin
  If ShortDateFormat[1]='d' then
GF:=IntToStr(Q-31-2)+'/4/'+IntToStr(Year)
  else GF:='4/'+IntToStr(Q-31-2)+'/'+IntToStr(Year);
 end;

end;

Daynumber

From: johan@lindgren.pp.se

Someone asked for a function to return the daynumber.

This is my routines for such.


unit datefunc;

interface
function checkdate (date : string) :boolean;
function Date2julian (date : string) : longint;
function Julian2date (julian : longint) : string;
function DayOfTheWeek (date : string) :string;
function idag  : string;

implementation
uses
  sysutils;

function idag () : string;
{Retrieves the current date and returns it in the form YYYYMMDD to be used
in the other functions in this unit.}
var
  Year, Month, Day: Word;
 begin
  DecodeDate(Now, Year, Month, Day);
  result := IntToStr(year)+ IntToStr(Month) +IntToStr(day);
end;

function Date2julian (date : string) : longint;
{Assumes the date in format  YYYYMMDD.
If you have another format. Make a routine to
convert it first.}
var
   month,day,year:integer;
   ta,tb,tc : longint;
begin
   month := strtoint(copy(date,5,2));
   day := strtoint(copy(date,7,2));
   year := strtoint(copy(date,1,4));
   if month > 2 then
     month := month - 3
   else
     begin
       month := month + 9;
       year := year - 1;
     end;
   ta := 146097 * (year div 100) div 4;
   tb := 1461 * (year MOD 100) div 4;
   tc := (153 * month + 2) div 5 + day + 1721119;
   result := ta + tb + tc
end;

function mdy2date (month, day, year : integer) : string;
var
  y,m,d : string;
begin
   y := '000'+inttostr(year);
   y := copy(y,length(y)-3,4);
   m := '0'+inttostr(month);
   m := copy(m,length(m)-1,2);
   d := '0'+inttostr(day);
   d := copy(d,length(d)-1,2);
   result := y+m+d;

end;


function Julian2date (julian : longint) : string;
{Takes a value and returns a date in the form YYYYMMDD}
var
  x,y,d,m : longint;
  month,day,year : integer;
begin
   x := 4 * julian - 6884477;
   y := (x div 146097) * 100;
   d := (x MOD 146097) div 4;
   x := 4 * d + 3;
   y := (x div 1461) + y;
   d := (x MOD 1461) div 4 + 1;
   x := 5 * d - 3;
   m := x div 153 + 1;
   d := (x MOD 153) div 5 + 1;
  if m < 11 then
    month := m + 2
  else
    month := m - 10;
  day := d;
  year := y + m div 11;
  result := mdy2date(month, day, year);
end;



function checkdate (date : string) :boolean;
{Date must be in the form YYYYMMDD.}
var
  julian : longint;
  test : string;
begin
{First convert the datestring to julian single format.
This will always produce a value.}
julian := Date2julian(date);
{Then convert the value to a date.
This will always be a valid date. But if it is not the same
as date that was not a valid date.}
test := Julian2date(julian);

if date = test then
  result := true
else
  result := false;
end;

function DayOfTheWeek (date : string) :string;
{Takes a date in the form YYYYMMDD
Returns the weekday.}
var
  julian : longint;
begin
julian :=  (Date2julian(date)) MOD 7;
  case julian of
    0 : result := 'Monday';
    1 : result := 'Tuesday';
    2 : result := 'Wednesday';
    3 : result := 'Thursday';
    4 : result := 'Friday';
    5 : result := 'Saturday';
    6 : result := 'Sunday';
  end;
end;


end.

Algorithm or equation for determining sunrise/set and moonrise/set (BASIC)

From: ksudar@erols.com (Karl Sudar)

Here is a BASIC program I found.. maybe someone can port it to pascal?

(let me know about it, rdb@ktibv.nl)


10 '         Sunrise-Sunset
20 GOSUB 300
30 INPUT "Lat, Long (deg)";B5,L5
40 INPUT "Time zone (hrs)";H
50 L5=L5/360: Z0=H/24
60 GOSUB 1170: T=(J-2451545)+F
70 TT=T/36525+1: ' TT = centuries
80 '               from 1900.0
90 GOSUB 410: T=T+Z0
100 '
110 '       Get Sun's Position
120 GOSUB 910: A(1)=A5: D(1)=D5
130 T=T+1
140 GOSUB 910: A(2)=A5: D(2)=D5
150 IF A(2)<A(1) THEN A(2)=A(2)+P2
160 Z1=DR*90.833: ' Zenith dist.
170 S=SIN(B5*DR): C=COS(B5*DR)
180 Z=COS(Z1): M8=0: W8=0: PRINT
190 A0=A(1): D0=D(1)
200 DA=A(2)-A(1): DD=D(2)-D(1)
210 FOR C0=0 TO 23
220 P=(C0+1)/24
230 A2=A(1)+P*DA: D2=D(1)+P*DD
240 GOSUB 490
250 A0=A2: D0=D2: V0=V2
260 NEXT
270 GOSUB 820: '  Special msg?
280 END
290 '
300 '        Constants
310 DIM A(2),D(2)
320 P1=3.14159265: P2=2*P1
330 DR=P1/180: K1=15*DR*1.0027379
340 S$="Sunset at  "
350 R$="Sunrise at "
360 M1$="No sunrise this date"
370 M2$="No sunset this date"
380 M3$="Sun down all day"
390 M4$="Sun up all day"
400 RETURN
410 '     LST at 0h zone time
420 T0=T/36525
430 S=24110.5+8640184.813*T0
440 S=S+86636.6*Z0+86400*L5
450 S=S/86400: S=S-INT(S)
460 T0=S*360*DR
470 RETURN
480 '
490 '  Test an hour for an event
500 L0=T0+C0*K1: L2=L0+K1
510 H0=L0-A0: H2=L2-A2
520 H1=(H2+H0)/2: '  Hour angle,
530 D1=(D2+D0)/2: '  declination,
540 '                at half hour
550 IF C0>0 THEN 570
560 V0=S*SIN(D0)+C*COS(D0)*COS(H0)-Z
570 V2=S*SIN(D2)+C*COS(D2)*COS(H2)-Z
580 IF SGN(V0)=SGN(V2) THEN 800 
590 V1=S*SIN(D1)+C*COS(D1)*COS(H1)-Z
600 A=2*V2-4*V1+2*V0: B=4*V1-3*V0-V2
610 D=B*B-4*A*V0: IF D<0 THEN 800
620 D=SQR(D)
630 IF V0<0 AND V2>0 THEN PRINT R$;
640 IF V0<0 AND V2>0 THEN M8=1
650 IF V0>0 AND V2<0 THEN PRINT S$;
660 IF V0>0 AND V2<0 THEN W8=1
670 E=(-B+D)/(2*A)
680 IF E>1 OR E<0 THEN E=(-B-D)/(2*A)
690 T3=C0+E+1/120: ' Round off
700 H3=INT(T3): M3=INT((T3-H3)*60)
710 PRINT USING "##:##";H3;M3;
720 H7=H0+E*(H2-H0)
730 N7=-COS(D1)*SIN(H7)
740 D7=C*SIN(D1)-S*COS(D1)*COS(H7)
750 AZ=ATN(N7/D7)/DR
760 IF D7<0 THEN AZ=AZ+180
770 IF AZ<0 THEN AZ=AZ+360
780 IF AZ>360 THEN AZ=AZ-360
790 PRINT USING ",  azimuth ###.#";AZ
800 RETURN
810 '
820 '   Special-message routine
830 IF M8=0 AND W8=0 THEN 870
840 IF M8=0 THEN PRINT M1$
850 IF W8=0 THEN PRINT M2$
860 GOTO 890
870 IF V2<0 THEN PRINT M3$
880 IF V2>0 THEN PRINT M4$
890 RETURN
900 '
910 '   Fundamental arguments
920 '     (Van Flandern &
930 '     Pulkkinen, 1979)
940 L=.779072+.00273790931*T
950 G=.993126+.0027377785*T
960 L=L-INT(L): G=G-INT(G)
970 L=L*P2: G=G*P2
980 V=.39785*SIN(L)
990 V=V-.01000*SIN(L-G)
1000 V=V+.00333*SIN(L+G)
1010 V=V-.00021*TT*SIN(L)
1020 U=1-.03349*COS(G)
1030 U=U-.00014*COS(2*L)
1040 U=U+.00008*COS(L)
1050 W=-.00010-.04129*SIN(2*L)
1060 W=W+.03211*SIN(G)
1070 W=W+.00104*SIN(2*L-G)
1080 W=W-.00035*SIN(2*L+G)
1090 W=W-.00008*TT*SIN(G)
1100 '
1110 '    Compute Sun's RA and Dec
1120 S=W/SQR(U-V*V)
1130 A5=L+ATN(S/SQR(1-S*S))
1140 S=V/SQR(U):D5=ATN(S/SQR(1-S*S))
1150 R5=1.00021*SQR(U)
1160 RETURN
1165 '
1170 '     Calendar --> JD
1180 INPUT "Year, Month, Day";Y,M,D
1190 G=1: IF Y<1583 THEN G=0
1200 D1=INT(D): F=D-D1-.5
1210 J=-INT(7*(INT((M+9)/12)+Y)/4)
1220 IF G=0 THEN 1260
1230 S=SGN(M-9): A=ABS(M-9)
1240 J3=INT(Y+S*INT(A/7))
1250 J3=-INT((INT(J3/100)+1)*3/4)
1260 J=J+INT(275*M/9)+D1+G*J3
1270 J=J+1721027+2*G+367*Y
1280 IF F>=0 THEN 1300
1290 F=F+1: J=J-1
1300 RETURN
1310 '
1320 '   This program by Roger W. Sinnott calculates the times of sunrise
1330 '   and sunset on any date, accurate to the minute within several
1340 '   centuries of the present.  It correctly describes what happens in the 
1350 '   arctic and antarctic regions, where the Sun may not rise or set on
1360 '   a given date.  Enter north latitudes positive, west longitudes
1370 '   negative.  For the time zone, enter the number of hours west of
1380 '   Greenwich (e.g., 5 for EST, 4 for EDT).  The calculation is
1390 '   discussed in Sky & Telescope for August 1994, page 84.

Date format

From: Martin Brooks <martin@image-data.com>

 
I have a very urgent problem i am currently working on a college project
 where i have to check the validity of dates entered into a maskedit in
 this format - __/__/____ e.g. 12/12/1997.
 
Ages ago, I did a very silly date encoder/decoder that did check that a date was valid. See code below.


function CheckDateFormat(SDate:string):string;
var
  IDateChar:string;
  x,y:integer;
begin
  IDateChar:='.,\/';
  for y:=1 to length(IDateChar) do
  begin
    x:=pos(IDateChar[y],SDate);
    while x>0 do
    begin
      Delete(SDate,x,1);
      Insert('-',SDate,x);
      x:=pos(IDateChar[y],SDate);
    end;
  end;
  CheckDateFormat:=SDate;
end;


function DateEncode(SDate:string):longint;
var
  year,month,day:longint;
  wy,wm,wd:longint;
  Dummy:TDateTime;
  Check:integer;
begin
  DateEncode:=-1;
  SDate:=CheckDateFormat(SDate);
  Val(Copy(SDate,1,pos('-',SDate)-1),day,check);
  Delete(Sdate,1,pos('-',SDate));
  Val(Copy(SDate,1,pos('-',SDate)-1),month,check);
  Delete(SDate,1,pos('-',SDate));
  Val(SDate,year,check);
  wy:=year;
  wm:=month;
  wd:=day;
  try
    Dummy:=EncodeDate(wy,wm,wd);
  except
    year:=0;
    month:=0;
    day:=0;
  end;
  DateEncode:=(year*10000)+(month*100)+day;
end;

DateSer Function[UPD]

From: "Damir Bulic - Ramayana" <damir.bulic@zg.tel.hr>

Hi, this is a source of a function DateSer I wrote, because I worked in VB before, and this was a very useful function. Delphi unfortunately doesn't have it. Use it in a form of

    DecodeDate(Date,y,m,d);
    NewDate:=DateSer(y-4,m+254,d+1234);
or something like that....

 function DateSer(y,m,d: Integer): TDateTime;
const
   mj: array[1..12] of Integer=(31,28,31,30,31,30,31,31,30,31,30,31);
var
 add: Integer;
begin
 while(true) do begin
  y:=y+(m-1) div 12;
  m:= (m-1) mod 12 +1;
  if m<=0 then begin
     Inc(m,12);
	 Dec(y);
  end;
  if  ((y mod 4 = 0) and
      ((y mod 100<>0) or (y mod 400=0)))
	  and (m=2) then
     add:=1 //add one day in February
  else
    add:=0;
  if (d>0) and (d<=(mj[m]+add)) then break;
  if d>0 then begin Dec(d,mj[m]+add); Inc(m); end
  else begin Inc(d,mj[m]+add); Dec(m); end;
 end;
 Result:=EncodeDate(y,m,d);
end;

Automatic Year in a date edit[NEW]

"Henk Schreij" <schreij@daxis.nl>

Als je een Datumveld intypt in een Database, dan kun je het jaartal weglaten, omdat de computer die voor je invult met het huidige jaar. Kan zoiets ook in een gewoon Edit-veld?

Het antwoord is ja, dat kan met:


PROCEDURE TForm1.Edit1Exit(Sender: TObject);
BEGIN
  IF Edit1.Text<>'' THEN BEGIN
    TRY
      StrToDate(Edit1.Text);
    EXCEPT
      Edit1.SetFocus;
      MessageBeep(0);
      raise Exception.Create('"'+Edit1.Text
      +'" is no valid Date');
    END{try};
    Edit1.Text:=DateToStr(StrToDate(Edit1.Text));
  END{if};
END;

Met deze code accepteert hij alleen geldige datums, en weigert bij een foute datum naar een volgend Edit-veld te gaan. De < DateToStr(StrToDate(Edit1.Text)) > zorgt ervoor dat als je de dag en maand hebt ingevuld (bijv. 5-12) er automatisch het jaar wordt ingevuld.
Please email me and tell me if you liked this page.