Нужна помощь в написании программы

Хакеры..и просто умные люди. Помогите студенту написать програмку на языке Паскаль 7-ой версии. Программа должна вычеслять день недели в разные годы, т.е. Напремер 2004 год 19.09.2004 воскресение , а какой день недели был 19.09. 1966 года. ?

Несомненно, твоя программа должна высчитать и високосные года... Так что будет не всё так просто Думаю, наши "хакеры" и просто умные люди тебе "помогут"...

P.S. обычно, когда просят помочь написать программу, они имеют ввиду - напишите за меня программу! Так что предлагай свои решения, мысли... Если тебе дали такое задание, то я уверен, к нему вас должны были подготовить!

И что тебе мешало продолжить тему https://forum.ee/?showtopic=5279 ?

Сообщение изменено: Setor (20 сентября 2004 - 09:30 )

Очень многие стандартные библиотеки имеют класс вроде DateTime, достаточно присвоить ему нужную дату, а потом спросить его день недели.
Если тебе именно нужно написать такой алгоритм самому, то читай здесь http://www.terra.es/personal2/grimmer/
Если тебе нужно сделать вид, что ты сам написал такой алгоритм, то пойди сюда http://javascript.in...ay-of-week.html и перепиши этот скриптец с JavaScript на Pascal.
Если тебе вообще хочется получить результат не ударив палец о палец, то за 100 EEK/час я тебе перепишу.

Сообщение изменено: archi (20 сентября 2004 - 10:32 )

archi, я немного покритикую твои советы, ладно?

Человеку дали типичное для первого курса задание по информатике. Которое фактически сводится к реализации какой-то математической формулы на языке программирования pascal. Ну плюс еще какая-то обвязка (ввод данных и вывод результатов). Поэтому:

Очень многие стандартные библиотеки имеют класс вроде DateTime, достаточно присвоить ему нужную дату, а потом спросить его день недели.

не подходит. Нужно именно самому реализовать формулу нахождения дня недели по дате, а не просто получить этот день недели самым простым и читабельным способом. Кстати это:

Если тебе нужно сделать вид, что ты сам написал такой алгоритм, то пойди сюда http://javascript.in...ay-of-week.html и перепиши этот скриптец с JavaScript на Pascal.

тоже не подходит так как и там этого алгоритма нет. Там именно создается объект типа Date и вызывается его метод getDay(). А по этой ссылке:

Если тебе именно нужно написать такой алгоритм самому, то читай здесь http://www.terra.es/personal2/grimmer/

написано, что это алгоритм так сказать оптимизированный для ручного счета. К тому же я не уверен, что у Bars888 все так хорошо с английским как у тебя.

И советую ему почитать следующее:

http://borlpasc.naro...l2/gl2_7_1.html

здоровая критика всегда приветствуется 8)
ты прав, твой линк самый лучший.

{ PTOOLDAT.INC Copyright 1984 R D Ostrander Version 1.0

Ostrander Data Services

5437 Honey Manor Dr

Indianapolis IN 46241



These Turbo Pascal functions are date manipulation tools used to Convert

Gregorian date strings, Change Gregorian Dates to and from Julian dates,

Find Day of Week, Add numbers to dates, Find the difference between dates,

Convert dates to 2 byte integers in order to save disk storage, and to

Retrieve the current (system) date. Handles date from 1/1/0100 to 12/31/9999.



This program has been placed in the Public Domain by the author and copies

may be freely made for non-commercial, demonstration, or evaluation purposes.

Use of these subroutines in a program for sale or for commercial purposes in

a place of business requires a $20 fee be paid to the author at the address

above. Personal non-commercial users may also elect to pay the $20 fee to

encourage further development of this and similar programs. With payment you

will be able to receive update notices, diskettes and printed documentation

of this and other PTOOLs from Ostrander Data Services.



PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services



Turbo Pascal is a Copyright of Borland International Inc.



Functions available in PTOOLDAT.INC are:



(Result)



PTDGValid (String) : Boolean - True if argument is valid Gregorian

Date

PTDJValid (Real) : Boolean - True if argument is valid Julian Date

(Note that this is useful for

Julian types A & B (ANSI) only)

PTDSValid (Integer) : Boolean - True if argument is valid Short

format Date

PTDGtoJ (String) : Real - Convert argument (Gregorian Date) to

a Julian Date

PTDJtoG (Real) : String - Convert argument (Julian Date) to a

Gregorian Date

PTDGtoG (String) : String - Convert argument (Gregorian Date in

2nd format) to Gregorian Date in

standard (1st) format - Note that

a blank (space filled) string

returned if the argument cannot be

converted

PTDGtoS (String) : Integer - Convert argument (Gregorian Date to

a Short format date. Return -32766 if

not in range of January 1st of Base

year thru June 1st, 179 years after

the Base Year.

PTDStoG (Integer) : String - Convert argument (Short format Date)

to a Gregorian Date

PTDJtoS (Real) : Integer - Convert argument (Julian Date to

a Short format date

PTDStoJ (Integer) : Real - Convert argument (Short format Date)

to a Julian Date

PTDGAdd (String, Integer) : String - Add argument-2 (Integer) number of

days to argument-1 (Gregorian Date)

and express result in Gregorian

format

PTDJAdd (Real, Integer) : Real - Add argument-2 (Integer) number of

days to argument-1 (Julian Date) and

express result in Julian format

PTDGComp (String, String) : Real - Subtract argument-2 (Gregorian Date)

from argument-1 (Gregorian Date)

giving number of days between dates

minus 1.

PTDJComp (Real, Real) : Real - Subtract argument-2 (Julian Date)

from argument-1 (Julian Date) giving

number of days between dates minus 1

PTDGLeap (String) : Boolean - True if argument (Gregorian Date) is

a Leap Year

PTDJLeap (Real) : Boolean - True if argument (Julian Date) is a

Leap Year

PTDSLeap (Integer) : Boolean - True if argument (Short format date)

is a Leap Year

PTDYLeap (Integer) : Boolean - True if argument is a Leap Year

PTDGDay (String) : String - Return Day of Week for argument

(Gregorian Date)

PTDJDay (Real) : String - Return Day of Week for argument

(Julian Date)

PTDSDay (Integer) : String - Return Day of Week for argument

(Short format date)

PTDGCurr : String - Current (system) Gregorian Date

PTDJCurr : Real - Current (system) Julian Date

PTDSCurr : Integer - Current (system) Short format date }





{ Constants and Parameters Begin Here ************************************* }





TYPE



PTOOLDAT_Str_21 = String [21]; {Gregorian Dates }

PTOOLDAT_Str_3 = String [3]; {Order of elements }

PTOOLDAT_Str_9 = String [9]; {Day of Week }

PTOOLDAT_Elements = Array [1..3] of String [21]; {Parsing elements }

PTOOLDAT_Numbers = Array [1..3] of Integer; {Parsing numbers }

PTOOLDAT_Months = Array [1..12] of String [9]; {Months Names }

PTOOLDAT_Days = Array [1..7] of PTOOLDAT_Str_9;{Days of the Week }





CONST



{ Gregorian Date A string expression of up to 21 characters.

-------------- example: 02/15/50 or February 2, 1950



The order and style to display the elements

(Month, Day, Year) are determined by the

parameters below.



As an argument, the date is passed as a string

expression with 3 elements in the same order as

displayed separated by at least one of the

characters / - , . ' ; : ( ) or a space. }



{ Gregorian Date parameters }

{*********************************}

PTOOLDAT_G_YrDisp : Byte = 2; { # of Display Chars for Year }

{ 2 = 50 }

{ 4 = 1950 }

PTOOLDAT_G_MoDisp : Byte = 2; { # of Display Chars for Month }

{ 2 = 02 }

{ 3 = Feb }

{ 9 = February }

PTOOLDAT_G_DaDisp : Byte = 2; { # of Display Chars for Day }

{ 2 = 15 }

PTOOLDAT_G_Order : String [3] = 'MDY'; { Order of Display }

{ MDY = 02 15 50 }

PTOOLDAT_G_Sep1 : String [3] = '/'; { 1st Separation Character }

{ / = 02/15 50 }

PTOOLDAT_G_Sep2 : String [3] = '/'; { 2nd Separation Character }

{ / = 02/15/50 }

PTOOLDAT_G_ZeroSup : Boolean = True; { Zero Suppress Display? }

{ True = 2/15/50 }

{*********************************}



{ The 2nd Gregorian Date is used solely as input for

the conversion function PTDGtoG }



{ 2nd Gregorian Date parameters }

{*********************************}

PTOOLDAT_G2_Order : String [3] = 'YMD'; { Order of Input }

{*********************************}



{ Julian Date A Real number in either of three formats:

----------- A = ANSI Date (YYDDD) YY is the year within century

DDD is the day of the year

B = ANSI Date (YYYYDDD) YYYY is the year

DDD is the day of the year

E = Elapsed days since January 1 of the base year below.

Note that this may result in a negative number

if the date is previous to the base year

CAUTION - If the base year below is changed, this

value becomes meaningless.







{ Julian Date parameter }

{*********************************}

PTOOLDAT_J_Type : Char = 'A'; { Julian Date Type }

{ A = ANSI Date (YYDDD) }

{ (50046) }

{ B = ANSI DATE (YYYYDDD) }

{ (1950046) }

{ E = Days since January }

{ 1st of base year }

{ (7350) }

{*********************************}



{ Short Date An integer value representing the number of days since

---------- January 1 of the base year below minus 32765. USE WITH

CAUTION, dates earlier than the base year or later than

179 years after the base year cannot be calculated (date

returned is -32766). This date is useful for saving disk

or table storage only - it must be changed back to

another form to be used.



Day of Week A String expression of up to 9 characters

----------- The format depends on the parameter below:



1 = 1 2 3 4 5 6 7

3 = Sun Mon Tue Wed Thr FrI Sat

9 = Sunday Monday Tuesday Wednesday Thursday Friday Saturday }



{ Day of Week parameter }

{*********************************}

PTOOLDAT_Day_Type : Byte = 3; { Day of week Type }

{ 1 = 4 }

{ 2 = We }

{ 3 = Wed }

{ 9 = Wednesday }

{*********************************}



{Base Year This is used for dates in Julian Type B format, for

--------- conversion of dates entered without a century, and

for Short format dates.

If Base Year is 1930 then the year 50 will be calculated

as 1950, the year 29 will be calculated as 2029. }



PTOOLDAT_BaseYear : Integer = 1930;



{***** PTOOLDAT Internal usage fields follow: *****}



PTOOLDAT_Element : PTOOLDAT_Elements = (' ', ' ', ' ');

PTOOLDAT_Number : PTOOLDAT_Numbers = (0, 0, 0);

PTOOLDAT_ElY : String [9] = ' ';

PTOOLDAT_ElM : String [9] = ' ';

PTOOLDAT_ElD : String [9] = ' ';

PTOOLDAT_NumY : Integer = 0;

PTOOLDAT_NumM : Integer = 0;

PTOOLDAT_NumD : Integer = 0;



PTOOLDAT_Mon : PTOOLDAT_Months = ('Jan', 'Feb', 'Mar', 'Apr', 'May',

'Jun', 'Jul', 'Aug', 'Sep', 'Oct',

'Nov', 'Dec');

PTOOLDAT_Month : PTOOLDAT_Months = ('January', 'February', 'March',

'April', 'May', 'June', 'July',

'August', 'September', 'October',

'November', 'December');

PTOOLDAT_Day : PTOOLDAT_Days = ('Sun', 'Mon', 'Tue', 'Wed', 'Thr',

'Fri', 'Sat');

PTOOLDAT_DayOW : PTOOLDAT_Days = ('Sunday', 'Monday', 'Tuesday',

'Wednesday', 'Thursday', 'Friday',

'Saturday');





{ Internal Functions Begin Here ******************************************* }





Procedure PTOOLDAT_Parse (VAR Test : PTOOLDAT_Str_21;

VAR Number_of_Elements : Integer);



Var

I, J, E : Byte; { Get elements of input }

{ Any of the characters }

Begin { below may seperate }

I := 1; { the elements. }

For E := 1 to 3 do

Begin

While (Test [I] in

['/', '-', ',', '.', ';', ':', '(', ')', ' '])

and (I <= Length (Test)) do

I := I + 1;

J := 1;

While (not (Test [I] in

['/', '-', ',', '.', ';', ':', '(', ')', ' ']))

and (I <= Length (Test)) do

Begin

PTOOLDAT_Element [E] [J] := Test [I];

J := J + 1;

I := I + 1;

Number_of_Elements := E;

PTOOLDAT_Element [E] [0] := Char (J - 1);

End;

End;

While (Test [I] in ['/', '-', ',', '.', ';', ':', '(', ')', ' '])

and (I <= Length (Test)) do

I := I + 1;

If (not (Test [I] in ['/', '-', ',', '.', ';', ':', '(', ')', ' ']))

and (I <= Length (Test)) then

Number_of_Elements := 4;

End;





Function PTOOLDAT_Set_Century (InYear : Integer) : Integer;



Var { Add correct century based on Base }

Century : Integer; { Year - if less than then next }

{ century else same. }

Begin

Century := Trunc (Int ( PTOOLDAT_BaseYear / 100)) * 100;

If InYear >= PTOOLDAT_BaseYear - Century

then PTOOLDAT_Set_Century := Century + InYear

else PTOOLDAT_Set_Century := Century + InYear + 100;

End;





Function PTOOLDAT_GetNum (Test : PTOOLDAT_Str_21; MDY : Char) : Integer;



Var

Number : Integer; { Get the number of the }

Code : Integer; { Month, Day, or Year }

I, J : Byte;

Year : Integer;

Century : Integer;

Ch : Char;

TestMon : String [3];

TestMonth : String [9];



Begin

PTOOLDAT_GetNum := 0;

Number := 0;

Val (Test, Number, Code);

Case MDY of

'M' : If (Code = 0)

and (Number in [1..12]) then

PTOOLDAT_GetNum := Number

else

Begin

For I := 1 to 21 do

Begin

Ch := Test [I];

Test [I] := UpCase (Ch);

End;

For I := 1 to 12 do

Begin

For J := 1 to 3 do

{ Check for } Begin

{ alphabetic } Ch := PTOOLDAT_Mon [I] [J];

{ month inputs } TestMon [J] := UpCase (Ch);

End;

For J := 1 to 9 do

Begin

Ch := PTOOLDAT_Month [I] [J];

TestMonth [J] := UpCase (Ch);

End;

TestMon [0] := PTOOLDAT_Mon [I] [0];

TestMonth [0] := PTOOLDAT_Month [I] [0];

If (Test = TestMon)

or (Test = TestMonth) then

PTOOLDAT_GetNum := I;

End;

End;

'D' : If Code = 0 then

If Number in [1..31] then PTOOLDAT_GetNum := Number;

'Y' : If Code = 0 then

If Number > 99 then PTOOLDAT_GetNum := Number

else

PTOOLDAT_GetNum := PTOOLDAT_Set_Century (Number);

End; {Case}

End;





Function PTOOLDAT_Leap_Year (InYear : Integer) : Boolean;



Var { Find out if it's a Leap Year }

Century : Integer;

Year : Integer;



Begin

If InYear < 100 then

InYear := PTOOLDAT_Set_Century (InYear);

Century := Trunc (Int (InYear / 100));

Year := InYear - (Century * 100);

PTOOLDAT_Leap_Year := True;

If Year <> (Trunc (Int (Year / 4)) * 4) then PTOOLDAT_Leap_Year := False;

If (Year = 0) and

(Century = (Trunc (Int (Century / 4)) * 4)) and

(Century <> (Trunc (Int (Century / 10)) * 10)) then

PTOOLDAT_Leap_Year := False;

End;





Function PTOOLDAT_G_Check (Test : PTOOLDAT_Str_21;

OrderIn : PTOOLDAT_Str_3)

: Boolean;



Var { Find out if the Element areas }

Num_of_El : Integer; { represent a valid Gregorian date }

E : Byte; { and set Number areas }

Ok : Boolean;



Begin

Ok := True;

PTOOLDAT_Parse (Test, Num_of_El);

If Num_of_El <> 3 then

Ok := False;

For E := 1 to 3 do

Begin

PTOOLDAT_Number [E] := PTOOLDAT_GetNum (PTOOLDAT_Element [E],

OrderIn [E]);

If PTOOLDAT_Number [E] = 0 then Ok := False;

End;

If Ok = True then

Begin

For E := 1 to 3 do

Case OrderIn [E] of

'Y' : PTOOLDAT_NumY := PTOOLDAT_Number [E];

'M' : PTOOLDAT_NumM := PTOOLDAT_Number [E];

'D' : PTOOLDAT_NumD := PTOOLDAT_Number [E];

End; {Case}

If PTOOLDAT_NumD > 30 then

If not (PTOOLDAT_NumM in [1, 3, 5, 7, 8, 10, 12]) then

Ok := False;

If (PTOOLDAT_NumD > 29) and

(PTOOLDAT_NumM = 2) then Ok := False;

If (PTOOLDAT_NumD > 28) and

(PTOOLDAT_NumM = 2) and

(PTOOLDAT_Leap_Year (PTOOLDAT_NumY) = False) then

Ok := False;

End;

PTOOLDAT_G_Check := Ok;

End;





Function PTOOLDAT_Make_G : PTOOLDAT_Str_21;



Var { Transform the Number & Element areas }

E : Byte; { into a Gregorian date }

Output : String [21];



Begin

If PTOOLDAT_G_YrDisp = 2 then

Str (PTOOLDAT_NumY - (Trunc (Int (PTOOLDAT_NumY / 100)) * 100):2,

PTOOLDAT_ElY)

else

Str (PTOOLDAT_NumY:4, PTOOLDAT_ElY);

If PTOOLDAT_ElY [1] = ' ' then PTOOLDAT_ElY [1] := '0';

Case PTOOLDAT_G_MoDisp of

2 : Begin

Str (PTOOLDAT_NumM:2, PTOOLDAT_ElM);

If PTOOLDAT_ElM [1] = ' ' then

If PTOOLDAT_G_ZeroSup then Delete (PTOOLDAT_ElM, 1, 1)

else PTOOLDAT_ElM [1] := '0';

End;

3 : PTOOLDAT_ElM := PTOOLDAT_Mon [PTOOLDAT_NumM];

9 : PTOOLDAT_ElM := PTOOLDAT_Month [PTOOLDAT_NumM];

End; {Case}

Str (PTOOLDAT_NumD:2, PTOOLDAT_ElD);

If PTOOLDAT_ElD [1] = ' ' then

If PTOOLDAT_G_ZeroSup then Delete (PTOOLDAT_ElD, 1, 1)

else PTOOLDAT_ElD [1] := '0';

Output := '';

For E := 1 to 3 do

Begin

Case PTOOLDAT_G_Order [E] of

'Y' : Output := Output + PTOOLDAT_ElY;

'M' : Output := Output + PTOOLDAT_ElM;

'D' : Output := Output + PTOOLDAT_ElD;

End; {Case}

Case E of

1 : Output := Output + PTOOLDAT_G_Sep1;

2 : Output := Output + PTOOLDAT_G_Sep2;

End; {Case}

End;

PTOOLDAT_Make_G := Output;

End;





Function PTOOLDAT_G_Convert (Test : PTOOLDAT_Str_21;

OrderIn, OrderOut : PTOOLDAT_Str_3)

: PTOOLDAT_Str_21;



Begin { Transform date formats }

PTOOLDAT_G_Convert := ' ';

If PTOOLDAT_G_Check (Test, OrderIn) then

PTOOLDAT_G_Convert := PTOOLDAT_Make_G;

End;





Function PTOOLDAT_Day_of_Year : Integer;



Var { Get Day of Year }

Result : Integer;



Const

Days : Array [1..12] of Integer = (0, 31, 59, 90, 120, 151, 181, 212,

243, 273, 304, 334);



Begin

Result := Days [PTOOLDAT_NumM] + PTOOLDAT_NumD;

If (PTOOLDAT_NumM > 2) and

(PTOOLDAT_Leap_Year (PTOOLDAT_NumY)) then

Result := Result + 1;

PTOOLDAT_Day_of_Year := Result;

End;





Function PTOOLDAT_J_Type_E : Real;



Var { Get 'E' type Julian Date from }

Accum : Real; { Number area }

I, J : Integer;



Begin

If PTOOLDAT_BaseYear <= PTOOLDAT_NumY then

Begin

J := Trunc ( Int((PTOOLDAT_NumY - PTOOLDAT_BaseYear) / 4));

Accum := Int (J) * 1461;

I := PTOOLDAT_BaseYear + (J * 4);

While I < PTOOLDAT_NumY do

Begin

If PTOOLDAT_Leap_Year (I) then Accum := Accum + 366

else Accum := Accum + 365;

I := I + 1;

End;

PTOOLDAT_J_Type_E := Accum + PTOOLDAT_Day_of_Year - 1;

End

else

Begin

If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then

Accum := 367 - PTOOLDAT_Day_of_Year

else

Accum := 366 - PTOOLDAT_Day_of_Year;

J := Trunc ( Int ((PTOOLDAT_BaseYear - PTOOLDAT_NumY) / 4));

Accum := Accum + (Int (J) * 1461);

I := PTOOLDAT_NumY + 1 + (J * 4);

While I < PTOOLDAT_BaseYear do

Begin

If PTOOLDAT_Leap_Year (I) then Accum := Accum + 366

else Accum := Accum + 365;

I := I + 1;

End;

PTOOLDAT_J_Type_E := Accum * -1;

End;

End;





Procedure PTOOLDAT_Set_M_D (Input : Real);



Var { Get Month & Day }

InInt : Integer; { from DDD }

I : Byte;

J : Integer;

DayTest : Array [1..12] of Integer;



Const

Days : Array [1..12] of Integer = (0, 31, 59, 90, 120, 151, 181, 212,

243, 273, 304, 334);



Begin

InInt := Trunc (Input - ((Int (Trunc (Input / 1000) * 1000));

Move (Days, DayTest, 24);

If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then

For I := 3 to 12 do

DayTest [I] := DayTest [I] + 1;

For I := 1 to 12 do

If InInt > DayTest [I] then

Begin

PTOOLDAT_NumM := I;

J := DayTest [I];

End;

PTOOLDAT_NumD := InInt - J;

End;





Procedure PTOOLDAT_J_E_Eval (Input : Real);

{ Convert a Julian type 'E' }

Var { date to Number area }

Years, Days : Integer;

I : Byte;

Test : Integer;



Begin

If Input >= 0 then

Begin

Years := Trunc (Input / 1461);

Days := Trunc (Input - (Int (Years) * 1461)) + 1;

PTOOLDAT_NumY := PTOOLDAT_BaseYear;

For I := 1 to 4 do

Begin

If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Test := 366

else Test := 365;

If Days > Test then

Begin

Days := Days - Test;

PTOOLDAT_NumY := PTOOLDAT_NumY + 1;

End;

End;

PTOOLDAT_NumY := PTOOLDAT_NumY + (Years * 4);

End

else

Begin

Input := Input * -1;

Years := Trunc (Input / 1461);

Days := Trunc (Input - (Int (Years) * 1461));

PTOOLDAT_NumY := PTOOLDAT_BaseYear - 1;

For I := 1 to 4 do

Begin

If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Test := 366

else Test := 365;

If Days > Test then

Begin

Days := Days - Test;

PTOOLDAT_NumY := PTOOLDAT_NumY - 1;

End;

End;

PTOOLDAT_NumY := PTOOLDAT_NumY - (Years * 4);

If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Days := 367 - Days

else Days := 366 - Days;

End;

PTOOLDAT_Set_M_D (Days);

End;





Procedure PTOOLDAT_J_AB_Set_Y (Input : Real); { Put Year in Number area }

{ From YYmmm }

Begin

PTOOLDAT_NumY := Trunc (Input / 1000);

If PTOOLDAT_NumY < 100 then

PTOOLDAT_NumY := PTOOLDAT_Set_Century (PTOOLDAT_NumY);

End;





Function PTOOLDAT_Get_Jul : Real;

{ Get Julian Date from Number area }

Begin

Case PTOOLDAT_J_Type of

'A' : PTOOLDAT_Get_Jul := (Int (PTOOLDAT_NumY) * 1000)

- (Int (PTOOLDAT_NumY / 100) * 100000.0)

+ Int (PTOOLDAT_Day_of_Year);

'B' : PTOOLDAT_Get_Jul := (Int (PTOOLDAT_NumY) * 1000)

+ Int (PTOOLDAT_Day_of_Year);

'E' : PTOOLDAT_Get_Jul := PTOOLDAT_J_Type_E;

End; {Case}

End;





Function PTOOLDAT_Get_S : Integer;

{ Get Short date from Number area }

Var

Julian : Real;



Const

MaxJul : Real = 65532.0;



Begin

Julian := PTOOLDAT_J_Type_E;

If (Julian >= 0) and

(Julian <= MaxJul) then PTOOLDAT_Get_S := Trunc (Julian - 32765)

else PTOOLDAT_Get_S := -32766;

End;





Function PTOOLDAT_DOW (Day : Integer) : PTOOLDAT_Str_9;



Var

Hold_DOW : PTOOLDAT_Str_9; { Convert 1 - 7 to day }

{ of week verbage }

Begin

Case PTOOLDAT_Day_Type of

1 : Begin

Str (Day:1, Hold_DOW);

PTOOLDAT_DOW := Hold_DOW;

End;

3 : PTOOLDAT_DOW := PTOOLDAT_Day [Day];

9 : PTOOLDAT_DOW := PTOOLDAT_DayOW [Day];

End; {Case}

End;





Function PTOOLDAT_Get_Date : PTOOLDAT_Str_21;



Type { BIOS call to get current date }

BiosCall = Record

Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;

End;



Var

BiosRec : BiosCall;

Year, Month, Day : String [4];



Begin

With BiosRec do

Begin

Ax := $2a shl 8;

End;

MsDos (BiosRec);

With BiosRec do

Begin

Str (Cx, Year);

Str (Dx mod 256, Day);

Str (Dx shr 8, Month);

End;

PTOOLDAT_Get_Date := Year + ' ' + Month + ' ' + Day;

End;





{Called Functions Begin Here ******************************************** }





FUNCTION PTDGValid (Test : PTOOLDAT_Str_21) : Boolean;



BEGIN



PTDGValid := PTOOLDAT_G_Check (Test, PTOOLDAT_G_Order);



END;





FUNCTION PTDJValid (Test : Real) : Boolean;



VAR



Year : Integer;

Day : Integer;

Ok : Boolean;



BEGIN



Ok := True;

Case PTOOLDAT_J_Type of

'A' : If (Test < 1.0) or

(Test > 99365.0) then Ok := False;

'B' : If (Test < 1.0) or

(Test > 9999365.0) then Ok := False;

End; {Case}

PTDJValid := Ok;

If (Ok = True) and

(PTOOLDAT_J_Type <> 'E') then

Begin

Year := Trunc (Test / 1000);

Day := Trunc (Test - (Int (Year) * 1000));

If (Day > 366)

or ((Day = 366) and

(PTOOLDAT_Leap_Year (Year) = False))

or (Day = 0) then

PTDJValid := False;

End;



END;





FUNCTION PTDSValid (Short : Integer) : Boolean;



BEGIN



If Short <> -32766 then PTDSValid := True

else PTDSValid := False



END;





FUNCTION PTDGtoJ (Input : PTOOLDAT_Str_21) : Real;



BEGIN



If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then

PTDGtoJ := PTOOLDAT_Get_Jul;



END;





FUNCTION PTDJtoG (Input : Real) : PTOOLDAT_Str_21;



BEGIN



PTDJtoG := ' ';

If PTOOLDAT_J_Type = 'E' then PTOOLDAT_J_E_Eval (Input)

else

Begin

PTOOLDAT_J_AB_Set_Y (Input);

PTOOLDAT_NumY := Trunc (Input / 1000);

If PTOOLDAT_NumY < 100 then

PTOOLDAT_NumY := PTOOLDAT_Set_Century (PTOOLDAT_NumY);

PTOOLDAT_Set_M_D (Input);

End;

PTDJtoG := PTOOLDAT_Make_G;



END;





FUNCTION PTDGtoG (Input : PTOOLDAT_Str_21) : PTOOLDAT_Str_21;



BEGIN



If PTOOLDAT_G_Check (Input, PTOOLDAT_G2_Order) then

PTDGtoG := PTOOLDAT_Make_G

else

PTDGtoG := ' ';



END;





FUNCTION PTDGtoS (Input : PTOOLDAT_Str_21) : Integer;



BEGIN



If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then

PTDGtoS := PTOOLDAT_Get_S

else

PTDGtoS := -32766;



END;





FUNCTION PTDStoG (Short : Integer) : PTOOLDAT_Str_21;



BEGIN



If PTDSValid (Short) = False then PTDStoG := ' '

else

Begin

PTOOLDAT_J_E_Eval (Int (Short) + 32765);

PTDStoG := PTOOLDAT_Make_G;

End



END;





FUNCTION PTDJtoS (Input : Real) : Integer;



CONST



MaxJul : Real = 65532.0;



BEGIN



PTDJtoS := -32766;

If PTOOLDAT_J_TYPE in ['A', 'B'] then

Begin

PTOOLDAT_J_AB_Set_Y (Input);

PTOOLDAT_Set_M_D (Input);

PTDJtoS := PTOOLDAT_Get_S;

End

else

If (Input >= 0) and

(Input <= MaxJul) then PTDJtoS := Trunc (Input - 32765);



END;





FUNCTION PTDStoJ (Short : Integer) : Real;



VAR



Julian_E : Real;



BEGIN



Julian_E := Int (Short) + 32765;

If PTDSValid (Short) then

If PTOOLDAT_J_Type = 'E' then

PTDStoJ := Julian_E

else

Begin

PTOOLDAT_J_E_Eval (Julian_E);

PTDStoJ := PTOOLDAT_Get_Jul;

End;



END;





FUNCTION PTDGAdd (Input : PTOOLDAT_Str_21;

Number : Integer) : PTOOLDAT_Str_21;



BEGIN



If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then

Begin

PTOOLDAT_J_E_Eval (PTOOLDAT_J_Type_E + Int (Number));

PTDGAdd := PTOOLDAT_Make_G;

End;



END;





FUNCTION PTDJAdd (Input : Real; Number : Integer) : Real;



BEGIN



If PTOOLDAT_J_Type = 'E' then

PTDJAdd := (Input + Int (Number))

else

Begin

PTOOLDAT_J_AB_Set_Y (Input);

PTOOLDAT_Set_M_D (Input);

PTOOLDAT_J_E_Eval (PTOOLDAT_J_Type_E + Int (Number));

PTDJAdd := PTOOLDAT_Get_Jul;

End;



END;





FUNCTION PTDGComp (Minuend, Subtrahend : PTOOLDAT_Str_21) : Real;



VAR

Hold_Jul_Type : Char;



BEGIN



Hold_Jul_Type := PTOOLDAT_J_Type;

PTOOLDAT_J_Type := 'E';

PTDGComp := PTDGtoJ (Minuend) - PTDGtoJ (Subtrahend);

PTOOLDAT_J_Type := Hold_Jul_Type;



END;



FUNCTION PTDJComp (Minuend, Subtrahend : Real) : Real;



VAR



Hold_Jul : Real;



BEGIN



If PTOOLDAT_J_Type = 'E' then PTDJComp := Minuend - Subtrahend

else

Begin

PTOOLDAT_J_AB_Set_Y (Minuend);

PTOOLDAT_Set_M_D (Minuend);

Hold_Jul := (PTOOLDAT_J_Type_E);

PTOOLDAT_J_AB_Set_Y (Subtrahend);

PTOOLDAT_Set_M_D (Subtrahend);

PTDJComp := Hold_Jul - (PTOOLDAT_J_Type_E);

End;



END;





FUNCTION PTDGLeap (Input : PTOOLDAT_Str_21) : Boolean;



BEGIN



If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then

PTDGLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY)

else

PTDGLeap := False;



END;





FUNCTION PTDJLeap (Input : Real) : Boolean;



BEGIN



If PTOOLDAT_J_Type = 'E' then

PTOOLDAT_J_E_Eval (Input)

else

PTOOLDAT_J_AB_Set_Y (Input);

PTDJLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY);



END;





FUNCTION PTDSLeap (Input : Integer) : Boolean;



BEGIN



If PTDSValid (Input) = False then PTDSLeap := False

else

Begin

PTOOLDAT_J_E_Eval (Int (Input) + 32765);

PTDSLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY);

End;



END;





FUNCTION PTDYLeap (Input : Integer) : Boolean;



BEGIN



PTDYLeap := PTOOLDAT_Leap_Year (Input);



END;





FUNCTION PTDGDay (Input : PTOOLDAT_Str_21) : PTOOLDAT_Str_9;



VAR



Hold_Base_Year : Integer;

Hold_Jul_Type : Char;

Day : Integer;



BEGIN



Hold_Base_Year := PTOOLDAT_BaseYear;

PTOOLDAT_BaseYear := 0100;

Hold_Jul_Type := PTOOLDAT_J_Type;

PTOOLDAT_J_Type := 'E';

Day := Trunc (Frac (PTDGtoJ (Input) / 7) * 7.001) + 1;

PTDGDay := PTOOLDAT_DOW (Day);

PTOOLDAT_BaseYear := Hold_Base_Year;

PTOOLDAT_J_Type := Hold_Jul_Type;



END;





FUNCTION PTDJDay (Input : Real) : PTOOLDAT_Str_9;



BEGIN



PTDJDay := PTDGDay (PTDJtoG (Input));



END;





FUNCTION PTDSDay (Input : Integer) : PTOOLDAT_Str_9;



BEGIN



PTDSDay := PTDGDay (PTDStoG (Input));



END;





FUNCTION PTDGCurr : PTOOLDAT_Str_21;



BEGIN



PTDGCurr := PTOOLDAT_G_Convert (PTOOLDAT_Get_Date,

'YMD', PTOOLDAT_G_Order);



END;





FUNCTION PTDJCurr : Real;



BEGIN



PTDJCurr := PTDGtoJ (PTDGCurr);



END;





FUNCTION PTDSCurr : Integer;



BEGIN



PTDSCurr := PTDGtoS (PTDGCurr);



END;



Program PTOOLDAT; {Copyright R D Ostrander

Ostrander Data Services

5437 Honey Manor Dr

Indianapolis IN 46241



This is a demonstration program for the Turbo Pascal subroutine PTOOLDAT

for date manipulations. Address any questions to the author at the above

address. }



{$V-} { This parameter is necessary in order to pass String parameters

of other than 21 characters. }



Var

Input : String [21];

InGreg : Array [1..20] of String [21];

InJul : Array [1..20] of Real;

I,J,K : Byte;

Done : Boolean;

Ch : Char;

Code, Short : Integer;





{$I PTOOLDAT.INC} {Include statement for PTOOLDAT functions and procedures }





BEGIN



ClrScr;

Gotoxy (15,5); Write ('Demonstration of PTOOLDAT procedure.');

Gotoxy (15,7); Write ('PTOOLDAT and this program are copyrights');

Gotoxy (15,8); Write ('of R D Ostrander');

Gotoxy (15,9); Write (' Ostrander Data Services');

Gotoxy (15,10); Write (' 5437 Honey Manor Dr');

Gotoxy (15,11); Write (' Indianapolis IN 46241');

Gotoxy (15,13); Write ('and have been placed in the public domain.');

Delay (4000);

ClrScr;



Done := False;

Gotoxy (30,1); Write ('Gregorian Date Validation');

Gotoxy (1, 3); Write ('Enter up to 20 dates to be validated');

Writeln (' - give Month, Day, and Year - ie ', PTDGCurr);

Gotoxy (1, 5); Write ('Enter X to end');

I := 1;

While (I <= 20)

and (Done = False) do

Begin

Gotoxy (1, I + 5);

Write ('Enter date ');

Gotoxy (12, I + 5);

Read (Input);

Ch := Input [1];

Gotoxy (32, I + 5);

If UpCase (Ch) = 'X' then Done := True

else

If PTDGValid (Input) then

Begin

Write (Input, ' is a Valid Date ');

InGreg [I] := Input;

I := I + 1;

End

else

Write (Input, ' is not Valid - Try Again ');

End;



ClrScr;

Done := False;

Gotoxy (30,1); Write ('Julian Date Validation');

Gotoxy (1, 3); Write ('Enter up to 20 dates to be validated');

Writeln (' - give number as YYDDD - ie ', PTDJCurr:5:0);

Gotoxy (1, 5); Write ('Enter X to end');

J := 1;

While (J <= 20)

and (Done = False) do

Begin

Gotoxy (1, J + 5);

Write ('Enter date ');

Gotoxy (12, J + 5);

Read (Input);

Ch := Input [1];

If (UpCase (Ch) = 'X') or (Ch = '') then Done := True

else

Begin

Gotoxy (32, J + 5);

Val (Input, InJul [J], Code);

If Code <> 0 then InJul [J] := 0;

If PTDJValid (InJul [J]) then

Begin

Write (Input,

' is a Valid Date ');

J := J + 1;

End

else

Write (Input, ' is not Valid - Try Again ');

End;

End;



ClrScr;

I := I - 1;

Gotoxy (30,1); Write ('Gregorian Date Manipulations');

Gotoxy (1, 3); Write ('Input Julian (Type (Type E)');

Gotoxy (48,3); Write ('Alternate (Day of Week) Short');

For K := 1 to I do

Begin

Gotoxy (1, K + 4); Write (InGreg [K]);

Gotoxy (23,K + 4); Write (PTDGtoJ (InGreg [K]):5:0);

PTOOLDAT_J_Type := 'B';

Gotoxy (30,K + 4); Write (PTDGtoJ (InGreg [K]):7:0);

PTOOLDAT_J_Type := 'E';

Gotoxy (39,K + 4); Write (PTDGtoJ (InGreg [K]):8:0);

PTOOLDAT_J_Type := 'A';

PTOOLDAT_G_Order := 'YMD';

PTOOLDAT_G_Sep1 := '-';

PTOOLDAT_G_Sep2 := '-';

PTOOLDAT_G_ZeroSup := False;

PTOOLDAT_G2_Order := 'MDY';

Gotoxy (48,K + 4); Write (PTDGtoG (InGreg [K]));

PTOOLDAT_G_Order := 'MDY';

PTOOLDAT_G_Sep1 := '/';

PTOOLDAT_G_Sep2 := '/';

PTOOLDAT_G_ZeroSup := False;

PTOOLDAT_G2_Order := 'YMD';

PTOOLDAT_Day_Type := 9;

Gotoxy (58,K + 4); Write (PTDGDay (InGreg [K]));

PTOOLDAT_Day_Type := 3;

Short := PTDGtoS (InGreg [K]);

Gotoxy (72,K + 4); Write (Short:6);

Gotoxy (80,K + 4);

If Short = -32766 then Write ('*');

End;

Gotoxy (1, 25); Write ('Press any key to continue');

Read (KBD, Ch);



ClrScr;

J := J - 1;

Gotoxy (30,1); Write ('Julian Date Manipulations');

Gotoxy (1, 3); Write ('Input Gregorian or');

Gotoxy (40,3); Write ('Day LeapYr +100 Days Minus Prev Date');

For K := 1 to J do

Begin

Gotoxy (1, K + 4); Write (InJul [K]:5:0);

Gotoxy (7, K + 4); Write (PTDJtoG (InJul [K]));

PTOOLDAT_G_YrDisp := 4;

PTOOLDAT_G_MoDisp := 9;

PTOOLDAT_G_Sep1 := ' ';

PTOOLDAT_G_Sep2 := ', ';

PTOOLDAT_G_ZeroSup := True;

Gotoxy (18,K + 4); Write (PTDJtoG (InJul [K]));

PTOOLDAT_G_YrDisp := 2;

PTOOLDAT_G_MoDisp := 2;

PTOOLDAT_G_Sep1 := '/';

PTOOLDAT_G_Sep2 := '/';

PTOOLDAT_G_ZeroSup := False;

Gotoxy (40,K + 4); Write (PTDJDay (InJul [K]));

Gotoxy (44,K + 4);

If PTDJLeap (InJul [K]) then Write ('Yes')

else Write ('No');

Gotoxy (51,K + 4); Write (PTDJtoG (PTDJAdd (InJul [K], 100);

If K > 1 then

Begin

Gotoxy (61,K + 4);

Write (PTDJComp (InJul [K], InJul [K-1]):8:0, ' Days');

End;

End;



Gotoxy (1, 24);



END.

Сообщение изменено: tomatensaft (20 сентября 2004 - 21:27 )

libricon, я думаю, что на такие длинные листинги лучше делать ссылки.

Я тоже так считаю... В следующий раз хотя бы в [ code ] [ / code ] вставляй...

ОГРОМНОЕ СПАСИБО! Всем, всем - кто отозвался.


Немного пояснений: Это программа нужна для помощи знакомой подруге, которая учится в иституте. Если бы я учился бы там тоже то наверняка бы разберался бы в Паскале, а так вот приходится просить помощи... И что интересно - как только говоришь что надо написать порогу в паскале, так все сразу отворачиваются или ссылаются на нехватку времени. Я очень благодарен всем кто отозвался.!

PS: Теперь все попробуем (с подругой разумеется) и после напишу что получилось.

а прога помогла, извените что не бросил ссылку, долго было мне ее выкладывать, потом брасать, времени не было, я еще на си что-то похожее делал, только по скромнее, но не нашел примера, а эта прога, она умеет переводить и григорианского календаря в юлианский и обратно, а также возвращать день недели заданного числа и года, если порытся то надо просто эту функцию найти и на ее основе сделать что надо