Mega Code Archive
Date-time
<![CDATA[
see also CalendarDates.txt
*************************************************************
procedure TSeatBookings.SetDate(dateString: String);
{set date values in the 'date' and 'time' labels on both the main form}
{and the 'make or edit booking' (user input) form... we'll use these}
{values later for one thing or another...}
var
len: Integer;
longDate, dayString, monthString, yearString: String;
tempInt: Integer;
begin
{extract 'day' characters...}
dayString := Copy(dateString, 1, 2);
{extract the month characters}
monthString := Copy(dateString, 4, 2);
{extract the year characters}
yearString := Copy(dateString, 7, 2);
tempInt := StrToInt(monthString);
monthString := MakeMonthString(tempInt);
longDate := dayString + ' ' + monthString + ' ' + yearString;
len := Length(dateString);
if len < 5 then
begin
MakeOrEditBForm.DateLabel.Caption := 'Date???';
UserInterface.DateLabel.Caption := 'Date???';
end
else
begin
MakeOrEditBForm.DateLabel.Caption := dateString;
UserInterface.DateLabel.Caption := longDate;
end;
end;
procedure TSeatBookings.SetTime(timeString: String);
var
len: Integer;
begin
len := Length(timeString);
if len < 5 then
begin
MakeOrEditBForm.TimeLabel.Caption := 'Time???';
UserInterface.TimeLabel.Caption := 'Time';
end
else
begin
if ((timeString[1] = 'M') or (timeString[1] = 'm')) then
begin
MakeOrEditBForm.TimeLabel.Caption := 'Matinee';
UserInterface.TimeLabel.Caption := 'Matinee';
end
else
begin
MakeOrEditBForm.TimeLabel.Caption := 'Evening';
UserInterface.TimeLabel.Caption := 'Evening';
end;
end;
end;
function TSeatBookings.GetTodayDate(redundant: Integer): String;
{use Delphi date functions to create a string holding the current date in}
{this kind of format: 01JAN98 -the coding is easier if we use both the Now()}
{function which returns the above value as 111998, and the Date() function}
{which returns the above value as 01/01/98...}
{THIS FUNCTION IS NOT USED IN THE CURRENT IMPLEMENTATION}
{-BUT IT MIGHT BE USEFUL LATER...}
var
dateStringOne: String;
dateStringTwo: String;
dayString: String;
monthString: String;
yearString: String;
present: TDateTime;
year, month, day: Word;
begin
present:= Now;
DecodeDate(present, year, month, day);
monthString := MakeMonthString(month);
dateStringOne := DateToStr(Date);
dayString := dateStringOne[1] + dateStringOne[2];
yearString := dateStringOne[7] + dateStringOne[8];
dateStringTwo := dayString + monthString + yearString;
Result := dateStringTwo;
end;
*****************************************************************************************
METHOD TO CALCULATE SOMEONE'S EXACT AGE
>I would like to calculate someones exact age.
>
>Does anybody already have a method for that ?
>
>TIA
>
>Ciao !
>Rowdy Rabouw
Here is some code that I use. I'm not sure whose source helped me put it
together, Most likely someone from this list.
I have an TEdit Box for a date input and two labels that get the results of
the calculation
Years and Months.
procedure TCaseMgtDataForm.DateEditDOBExit(Sender: TObject);
var
Days, Months, Years: Word;
Date1, date2: TDateTime;
Day1, Day2, Month1, Month2, Year1, Year2: Word;
bTest : Boolean ;
begin
date2 := Date;
bTest := False ;
Try {Need an error check if invalid date string }
Date1 := strtodate(DateeditDOB.text) ;
bTest := True ;
except
on E: EConvertError do
ShowMessage(E.ClassName + #13+ #10 + E.Message);
end;
if not bTest then
DateEditDOB.Text := ' / / ';
setfocusedcontrol(DateEditDOB) ; {Reset focus to input TEdit
on error (THis does not work properly)}
if bTest then begin {We got a good date converted}
DecodeDate(Date1, Year1, Month1, Day1);
DecodeDate(Date2, Year2, Month2, Day2);
Years := Year2 - Year1;
Months := 0;
Days := 0;
if Month2 < Month1 then begin
Inc(Months, 12);
Dec(Years);
end;
Inc(Months, Month2 - Month1);
if Day2 < Day1 then begin
Inc(Days, DaysPerMonth(Year1, Month1));
if Months = 0 then begin
Dec(Years);
Months := 11;
end
else Dec(Months);
end;
Inc(Days, Day2 - Day1);
Age.caption := inttostr(years);
Mon.caption := inttostr(months);
end ;
end;
Bill Krause
Http://www.spl-t.com
Buy Guitar Strings online at: http://www.stringsdirect.com
_______________________________________________
Delphi mailing list -> Delphi@elists.org
http://elists.org/mailman/listinfo/delphi
*********************************************************************************
]]>