Uses
Crt,Dos;
Type
Men = record
Name : String[15] ;
TabNumber : Byte;
PayMent : Word;
Stage : Byte;
Education : Byte ;
Burndate : Longint ; { ïî òèïó
930211 }
Age : Byte ;
End;
Var
F : File of Men;
F1 : Text;
I,T : Integer;
ColMen : Integer;
Table : array [1..99] of Men;
{
--=================================================================-- }
{
--===================== Îïèñàíèÿ
ïðîöåäóð ========================-- }
{
--=================================================================-- }
Procedure
Input_Database;
{
Ïðîöåäóðà ââîäà èñõîäíûõ äàííûõ }
Const
sDay
: Array [1..12] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);
Label
Name_Repeat,Date_Repeat,Stage_Repeat,Education_Repeat,Pay_Repeat;
Var
S : String;
W : Longint;
Error : Boolean;
Year : Word;
Month,Day : Byte;
C : Char;
Procedure
Strike;
{
Ïðîöåäóðà óáèðàåò ñ ýêðàíà íåïðàâèëüíóþ íàäïèñü è ñîîáùåíèå îá îøèáêå }
Begin
C:=ReadKey;
GoToXY(1,WhereY);
ClrEol;
GoToXY(1,WhereY-1);
ClrEol;
End;
Procedure
Look_Age;
{
ïðîöåäóðà âû÷èñëÿåò ïî äàòå ðîæäåíèÿ è ñåãîäíÿøíåé äàòå âîçðàñò ÷åëîâåêà }
Var
Year,Day,Month,DayofWeek : Word ;
Y,D,M : Integer ;
S1,S2,S3,S : String ;
Len : Integer ;
V : Integer ;
Begin
GetDate(Year,Month,Day,DayOfWeek);
Year:=Year-1900;
Str(Table[t].BurnDate,S);
Len:=Length(S);
S1:=Copy(S,Len-1,2);
S2:=Copy(S,Len-3,2);
S3:=Copy(S,Len-5,2);
Val(S1,D,I);
Val(S2,M,I);
Val(S3,Y,I);
V:=Day-D;
If V<0 Then Dec(Month);
V:=Month-M;
If V<0 Then Dec(Year);
V:=Year-Y;
Table[t].Age:=V;
End;
Begin
Assign(F,'Men.inp');
{$I-}
Reset(f);
{$I+}
IF IOResult<>0 Then
Begin
WriteLn('Ôàéë äàííûõ íå íàéäåí, ââåäèòå
äàííûå ñ êëàâèàòóðû :');
Repeat
Write('Ñêîëüêî âñåãî ðàáî÷èõ
(1..99):');ReadLn(ColMen);
Until (ColMen<100) and (ColMen>0);
WriteLn;
For t:=1 to ColMen Do
Begin
WriteLn('Ââîäÿòñÿ äàííûå î ÷åëîâåêå
N',t,'.');
WriteLn('Ïîðÿäêîâûé íîìåð :',t);
Table[t].TabNumber:=t;
Name_Repeat:
Write('Ôàìèëèÿ :');ReadLn(S);
If (Length(S)>15) or (Length(S)<1)
then
Begin
Write('Ôàìèëèÿ íå äîëæíà áûòü äëèííåå
15 ñèìâîëîâ.');
Strike;
GoTo Name_Repeat;
End;
Table[t].Name:=S;
Pay_Repeat:
Write('Çàðïëàòà :');ReadLn(W);
If (W<1) or (W>999) Then
Begin
Write('Çàðïëàòà íå äîëæíà áûòü <0
èëè >999 ðóáëåé.');
Strike;
GoTo Pay_Repeat;
End;
Table[t].PayMent:=W;
Education_Repeat:
Write('Êîä îáðàçîâàíèÿ :');ReadLn(W);
If (W<1) or (W>5) Then
Begin
Write('Êîä îáðàçîâàíèÿ - ýòî ÷èñëî â
èíòåðâàëå îò 1 äî 5.');
Strike;
GoTo Education_Repeat;
End;
Table[t].Education:=W;
Date_Repeat:
Error:=False;
Write('Äàòà ðîäæåíèÿ (ÃÃÌÌÄÄ)
:');ReadLn(W);
If W>921212 Then Error:=True;
If W<100101 Then Error:=True;
Str(W,S);
Val(Copy(s,1,2),Year,i);
Year:=Year+1900;
Val(Copy(S,3,2),Month,i);
Val(Copy(S,5,2),Day,i);
If (Month<1) or (Month>12) then
Error:=True;
If (sDay[Month]<Day) or (Day<1)
then Error:=True;
If (Year/4=Trunc(Year/4)) and (Month=2)
and (Day=29) then Error:=False;
If Error Then
Begin
Write('Òàêèå ëþäè íåòðóäîñïîñîáíû !');
Strike;
GoTo Date_Repeat;
End;
Table[t].BurnDate:=W;
Look_Age;
WriteLn('Âîçðàñò :',Table[t].Age);
Stage_Repeat:
Write('Îáùèé ñòàæ :');ReadLn(W);
If (W<0) or (W>Table[t].Age-14)
then
Begin
Write('Òàêîãî ñòàæà íå ìîæåò áûòü !');
Strike;
GoTo Stage_Repeat;
End;
Table[t].Stage:=W;
Writeln;
End;
WriteLn;Write('Ñîõðàíèòü âñå â ôàéëå
?(Y/N)');
Repeat
C:=ReadKey;
C:=UpCase(C);
Until (C='Y') or (C='N');
WriteLn;
If C='Y' then
Begin
ReWrite(F);
For t:=1 to ColMen Do Write(F,Table[t]);
Close(F);
End;
End Else
Begin
WriteLn('Ôàéë äàííûõ íàéäåí. ×èòàþ èç
ôàéëà ...');
T:=1;
While not eof(F) Do
Begin
Read(F,Table[t]);
Inc(t);
End;
ColMen:=t-1;
End;
End;
Procedure
Swap;
{
Âûçûâàåòñÿ èç Sort è Sort_Name }
{
Ìåíÿåò ìåñòàìè äâóõ ëþäåé â ìàññèâå ïðè ñîðòèðîâêå }
Var
Temple : Men;
Begin
Temple:=Table[i];
Table[i]:=Table[i+1];
Table[i+1]:=Temple;
End;
Procedure
Sort;
{ Â
êà÷åñòâå ïðîöåäóðû ñîðòèðîâêè èñïîëüçóåòñÿ ò.í. ïóçûðüêîâàÿ ñîðòèðîâêà }
Begin
WriteLn('Ñîðòèðóåì äàííûå ïî âîçðàñòó è
îáðàçîâàíèþ ...');
For t:=ColMen-1 DownTo 1 Do
For i:=1 to t Do
If Table[i].Age>Table[i+1].Age Then
Swap;
For t:=ColMen-1 DownTo 1 Do
For i:=1 to t Do
If Table[i].Age=Table[i+1].Age Then
If
Table[i].Education>Table[i+1].Education Then Swap;
End;
Procedure
Sort_Name;
{
Ñäåëàíà ïî îáðàçó è ïîäîáèþ ïðåäûäóùåé, íî ñîðòèðóåò âñå ïî èìåíàì }
Begin
For t:=ColMen-1 DownTo 1 Do
For i:=1 to t Do
If Table[i].Name>Table[i+1].Name then
Swap;
End;
Procedure
Write_Table;
{
Çàïèñûâàåò â ôàéë ïîëó÷èâøèåñÿ ðåç-òû è âûâîäèò èõ íà ýêðàí }
Const
VVV = ' ³ ';
Mes1 = 'Ñðåäíèå àðèôìåòè÷åñêèå ';
Mes2 = 'Ñðåäíèå äëÿ îäíîãî âîçðàñòà ';
Var
First,Second : Byte ;
Len : Byte
;
S,Full : String ;
AE_Pay,AE_Stage : Longint;
F_Pay,F_Stage : Longint;
AE_CountMen : Byte ;
F_CountMen : Byte ;
Summing,F_Summing : Boolean;
Writing,F_Writing : Boolean;
Double : Boolean;
Procedure
Add_Space(Count : Byte);
{
Ïðîöåäóðà äîáàâëÿåò ê ñòðîêå Full çàäàííîå êîëè÷åñòâî ïðîáåëîâ }
{ Ýòà
ïðîöåäóðà èñïîëüçóåòñÿ ïðè öåíòðîðîâàíèè ôàìèëèè }
Var
Cyc
: Byte;
Begin
Cyc:=0;
While Cyc<Count Do
Begin
Inc(Cyc);
Full:=Full+' ';
End;
End;
Procedure
P1;
Begin
Full:=Full+S+VVV;
End;
Procedure
Add_One;
Begin
AE_Stage:=AE_Stage+Table[t].Stage;
AE_Pay:=AE_Pay+Table[t].PayMent;
Inc(AE_CountMen);
End;
Procedure
ADD_One_F;
Begin
F_Stage:=F_Stage+Table[t].Stage;
F_Pay:=F_Pay+Table[t].PayMent;
Inc(F_CountMen);
End;
Procedure
Clear_AE;
Begin
AE_CountMen:=0;
AE_Stage:=0;
AE_Pay:=0;
Summing:=False;
End;
Procedure
Clear_F;
Begin
F_Pay:=0;
F_Stage:=0;
F_CountMen:=0;
F_Summing:=False;
End;
Procedure
Clear_Writing;
Begin
Writing:=False;
F_writing:=False;
End;
Procedure
Out_Sum(Mes : String ; Pay,Stage : Longint; CountMen : Byte);
{
Ïðîöåäóðà âûâîäèò ñðåäíèå àðèôìåòè÷åñêèå äëÿ ñòàæà è çàðïëàòû }
Var
Middle : Word;
Begin
If Not Double then
WriteLn(F1,'ÃÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄ´');
If F_Writing then Double:=True;
Full:='³ '+Mes+' ³ ';
Middle:=Round(Pay/CountMen);
Str(Middle,S);
If Middle<10 then S:='0'+S;
If Middle<100 then S:='0'+S;
p1;
Middle:=Round(Stage/CountMen);
Str(Middle,S);
If Middle<10 then S:='0'+S;
Full:=Full+S+' ³';
WriteLn(F1,Full);
If (Summing=False) and (F_Summing=True) then
Double:=False;
If Not Double then
WriteLn(F1,'ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿');
WriteLn(F1,'³Íîìåð ³ Âîçð ³ Îáð ³ Ôàìèëèÿ ³Òàá.N ³Äàòà ðîæä.³
Ç/Ï ³ Ñòàæ ³');
For t:=1 to ColMen Do
Begin
If Not Summing And Not Writing And not
F_Writing then
WriteLn(F1,'ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄ´');
Clear_Writing;
If (Table[t].Age=Table[t+1].Age) And
(Table[t].Education=Table[t+1].Education) Then
Begin
Summing:=True;
Add_One;
End Else
If Summing then
Begin
Add_One;
Writing:=True;
End;
If Table[t].Age=Table[t+1].Age then
Begin
F_Summing:=True;
Add_One_F;
End Else
If F_Summing then
Begin
Add_One_F;
F_Writing:=True;
End;
Full:='³
';
Str(T,S);
If T<10 then S:='0'+S;
p1;
Str(Table[t].Age,S);
p1;
Str(Table[t].Education,S);
p1;
S:=Table[t].Name;
Len:=Length(S);
First:=15-Len;
First:=Trunc(First/2);
Second:=15-First-Len;
Add_Space(First);
Full:=Full+S;
Add_Space(Second);
Full:=Full+VVV;
Str(Table[t].TabNumber,S);
If Table[t].TabNumber<10 then S:='0'+S;
p1;
Str(Table[t].BurnDate,S);
p1;
Str(Table[t].PayMent,S);
If Table[t].PayMent<10 then S:='0'+S;
If Table[t].PayMent<100 then S:='0'+S;
p1;
Str(Table[t].Stage,S);
If Table[t].Stage<10 then S:='0'+S;
p1;
WriteLn(F1,Full);
If (Summing and (t=ColMen)) or Writing
Then
Begin
Out_Sum(Mes1,AE_Pay,AE_Stage,AE_CountMen);
Clear_AE;
End;
If (F_Summing and (t=ColMen)) or F_Writing
then
Begin
Out_Sum(Mes2,F_Pay,F_Stage,F_CountMen);
Clear_F;
End;
End;
{====================================================================}
{ïðèâîäèò ñòðîêó ê âèäó äàòû (ää/ìì/ãã,
ìì/ãã)}
FUNCTION DataImage(Field : string) :
string;
BEGIN
Case (length(Field)) of
4 : begin {ììãã}
insert('/',Field,3);
end; {4}
6 : begin {ääììãã}
insert('/',Field,3);
insert('/',Field,6);
end; {6}
end; {case}
DataImage := Field;
END;
{====================================================================}
{âû÷èñëåíèå êîëè÷åñòâà ïîëíûõ ëåò ìåæäó
òåêóùåé äàòîé è
äàòîé-ïàðàìåòðîì}
FUNCTION CalculationAge(Date : string) :
integer;
Var
Year,Month,Day : integer; {ïåðåìåííûå
äëÿ äàòû-ïàðàìåòðà}
YearC,MonthC,DayC,DayOfWeekC : word;
{ïåðåìåííûå äëÿ ìàøèííîé äàòû}
Age : integer; {âîçðàñò}
BEGIN
{"ðàñùåïëåíèå" äàòû-ïàðàìåòðà}
Case (length(Date)) of
4 : begin {ììãã}
val(copy(Date,1,2),Month,Code);
val(copy(Date,3,2),Year,Code);
end; {4}
6 : begin {ääììãã}
val(copy(Date,1,2),Day,Code);
val(copy(Date,3,2),Month,Code);
val(copy(Date,5,2),Year,Code);
end; {6}
8 : begin {ää/ìì/ãã}
val(copy(Date,1,2),Day,Code);
val(copy(Date,4,2),Month,Code);
val(copy(Date,7,2),Year,Code);
end; {8}
end; {case}
{ñ÷èòûâàíèå ìàøèííîé (ñèñòåìíîé) äàòû}
GetDate(YearC,MonthC,DayC,DayOfWeekC);
YearC := YearC - 1900; {èçáàâëÿåìñÿ îò
ñòîëåòèÿ}
Age := YearC - Year; {ðàñ÷èòûâàåì
êîëè÷åñòâî ëåò}
{êîððåêòèðîâêà âîçðàñòà ñ ó÷åòîì ìåñÿöà
è äíÿ}
If length(Date) = 4 then
{íåò äíÿ}
If MonthC < Month then dec(Age)
Else
If (MonthC < Month) or ((MonthC =
Month) and (DayC < Day)) then dec(Age);
CalculationAge := Age;
END;
{====================================================================}
{êîíòðîëü çíà÷åíèé â èñõîäíîé çàïèñè íà
äîñòîâåðíîñòü}
PROCEDURE ControlSignificance;
Var
j : byte; {âñïîìîãàòåëüíàÿ ïåðåìåííàÿ}
{------------------------------------------------------------------}
{ïðåîáðàçîâàíèå ÷èñëà-ñòðîêè â ÷èñëî}
FUNCTION Num(sValue : string) : integer;
Var
Value : integer;
BEGIN
val(sValue,Value,Code);
Num := Value;
END;
{------------------------------------------------------------------}
{ïå÷àòü ñîîáùåíèÿ î òèïå îøèáêè â ïîëå
ââîäà}
PROCEDURE MessageError(Message :
string);
Var
Key : char;
BEGIN
RightField := false; {ïîëå îøèáî÷íî}
{ïå÷àòü îòöåíòðèðîâàííîãî â îêíå
ñîîáùåíèÿ}
GotoXY(2 + ((54-length(Message)) div
2),18);
Write(Message);
{îæèäàíèå è î÷èñòêà áîêñà}
GotoXY(05,22);
Write('Íàæìèòå ëþáóþ êëàâèøó, ÷òîáû
ïîâòîðèòü ââîä...');
While not(KeyPressed) do; {ïóñòîé öèêë
"ÏÎÊÀ" íå íàæàòà êëàâèøà}
Key := ReadKey; {î÷èñòèòü áóôåð
êëàâèàòóðû}
ClearMessageBox; {î÷èñòèòü áîêñ
ñîîáùåíèé}
END;
{------------------------------------------------------------------}
{êîíòðîëü íà öèôðû}
PROCEDURE Check1;
Var
j : byte;
BEGIN
For j := 1 to length(Field) do begin
If not(Field[j] in ['0'..'9']) then
begin
MessageError('Ïîëå ìîæåò ñîäåðæàòü
òîëüêî öèôðû.');
Exit;
end; {if}
end; {for}
END;
{------------------------------------------------------------------}
{êîíòðîëü íà ïðèíàäëåæíîñòü
ïîëÿ-ïàðàìåòðà èíòåðâàëó
Top <= Variable <= Bottom}
PROCEDURE Check2(Variable : integer;
Top,Bottom : integer;
Message : string);
BEGIN
If not((Top <= Variable) and
(Variable <= Bottom)) then begin
MessageError(Message);
end; {if}
END;
{------------------------------------------------------------------}
{êîíòðîëü íà êîððåêòíîñòü äàòû}
PROCEDURE Check3;
Var
Year,Month,Day : byte; {ïåðåìåííûå
äëÿ äàòû}
BEGIN
{êîíòðîëü íà íåäîñòàòî÷íîå êîëè÷åñòâî
ñèìâîëîâ}
If length(Field) <
length(LengthOfField[i]) then begin
MessageError('Äëèíà ïîëÿ ìåíüøå íåîáõîäèìîé.');
Exit;
end; {if}
{êîíòðîëü íà öèôðû}
Check1; If not(RightField) then Exit;
{"ðàñùåïëåíèå" äàòû}
Case (length(Field)) of
4 : begin {ììãã}
val(copy(Field,1,2),Month,Code);
val(copy(Field,3,2),Year,Code);
end; {4}
6 : begin {ääììãã}
val(copy(Field,1,2),Day,Code);
val(copy(Field,3,2),Month,Code);
val(copy(Field,5,2),Year,Code);
end; {6}
end; {case}
{ïðîâåðêà ìåñÿöà}
Check2(Month,1,12,'Îøèáêà ïðè óêàçàíèè
ìåñÿöà.');
If not(RightField) then Exit;
{ïðîâåðêà äíÿ, åñëè îí åñòü}
If length(Field) = 6 then begin
Case (Month) of
1,3,5,7,8,10,12 :
Check2(Day,1,31,'Îøèáêà ïðè
óêàçàíèè äíÿ.');
4,6,9,11 :
Check2(Day,1,30,'Îøèáêà ïðè
óêàçàíèè äíÿ.');
2 :
{åñëè ãîä âèñîêîñíûé, òî...}
If (Year mod 4) = 0 then
Check2(Day,1,29,'Îøèáêà ïðè
óêàçàíèè äíÿ.')
Else
Check2(Day,1,28,'Îøèáêà ïðè
óêàçàíèè äíÿ.');
end; {case Month}
If not(RightField) then Exit;
end; {if}
{ïðîâåðêà íà íåïðåâûøåíèå
äàòû-ïàðàìåòðà òåêóùåé äàòû}
If CalculationAge(Field) < 0 then
MessageError('Äàòà íå äîëæíà
ïðåâûøàòü òåêóùóþ.');
END;
{------------------------------------------------------------------}
{ïðîâåðêà íà ïðåâûøåíèå äàòîé-ïàðàìåòðà
äàòû ðîæäåíèÿ íà
íåêîòîðîå êîëè÷åñòâî ëåò}
PROCEDURE Check4(ExceedValue : byte);
Var
sValue : string;
BEGIN
str(ExceedValue:2,sValue);
If not(CalculationAge(Field) <=
Record2.Age - ExceedValue) then
MessageError('Äàòà äîëæíà ïðåâûøàòü
äàòó ðîæäåíèÿ íà ' + sValue + ' ëåò.');
END;
{------------------------------------------------------------------}
BEGIN
RightField := true; {ïðåäïîëîæèì, ÷òî
ïîëå âåðíî}
{êîíòðîëü íà îòñóòñòâèå èíôîðìàöèè â
ïîëå}
If length(Field) = 0 then begin
MessageError('Íåîáõîäèìî çàïîëíèòü
ïîëå.');
Exit;
end;
{êîíòðîëü íà ïðåâûøåíèå ïîëåì ïîëîæåííîé
äëèíû}
If length(Field) >
length(LengthOfField[i]) then begin
MessageError('Äëèíà ïîëÿ ïðåâûøàåò
äîïóñòèìóþ.');
Exit;
end;
Case (i) of
1 : begin {ôàìèëèÿ è èíèöèàëû
*********************************}
{êîíòðîëü íà áóêâû}
For j := 1 to length(Field) do begin
If not(Field[j] in
['À'..'ï','ð'..'ÿ',' ','.']) then begin
MessageError('Ïîëå ìîæåò
ñîäåðæàòü òîëüêî ðóññêèå áóêâû, "." è " ".');
Exit;
end; {if}
end; {for}
{ïðîâåðêà íà àëôàâèòíîå ñëåäîâàíèå
ôàìèëèé}
If Field < PrevFIO then begin
MessageError('Íàðóøåí àëôàâèòíûé
ïîðÿäîê ñëåäîâàíèÿ ôàìèëèé.');
end; {if}
end; {1}
2 : begin {ïîë (0-1)
******************************************}
Check1; If not(RightField) then
Exit;
Check2(Num(Field),0,1,'Çíà÷åíèå ïîëÿ
äîëæíî áûòü â èíòåðâàëå 0 - 1.');
end; {2}
3 : begin {äàòà ðîæäåíèÿ (ääììãã)
*****************************}
Check3; If not(RightField) then
Exit;
{åñëè ïîë æåíñêèé, òî îäèí èíòåðâàë
(14-55),
åñëè ìóæñêîé, òî äðóãîé (14-65)}
If Record2.Sex = 0 then
Check2(CalculationAge(Field),14,55,'Äàòà äîëæíà äàâàòü âîçðàñò 14 - 55
ëåò.')
Else
Check2(CalculationAge(Field),14,60,'Äàòà
äîëæíà äàâàòü âîçðàñò 14 - 60 ëåò.');
end; {3}
4 : begin {êîä îáðàçîâàíèÿ (1-7)
******************************}
Check1; If not(RightField) then
Exit;
Check2(Num(Field),1,7,'Çíà÷åíèå ïîëÿ
äîëæíî áûòü â èíòåðâàëå 1 - 7.');
end; {4}
5, {òàáåëüíûé íîìåð}
6, {êîä äîëæíîñòè}
7 : begin {çàðàáîòíàÿ ïëàòà
***********************************}
Check1;
end; {5,6,7}
8 : begin {äàòà ïîñòóïëåíèÿ íà çàâîä
(ääììãã) *****************}
Check3; If not(RightField) then
Exit;
Check4(14);
end; {8}
9 : begin {ñòàæ ðàáîòû íà çàâîäå
(ïîëíûõ ëåò) *****************}
Check1; If not(RightField) then Exit;
If Num(Field) <>
CalculationAge(Record2.DateEntryToFactory) then
MessageError('Ñòàæ íå
ïîäòâåðæäàåòñÿ äàòîé ïîñòóïëåíèÿ.');
end; {9}
10 : begin {îáùèé ñòàæ ðàáîòû (ïîëíûõ
ëåò) *********************}
Check1; If not(RightField) then Exit;
If Num(Field) <
Record2.LengthOfService then
MessageError('Ïîëå íå ìîæåò áûòü
ìåíüøå ïîëÿ "Ñòàæ".');
end; {10}
11 : begin {ïàðòèéíîñòü (1-3)
**********************************}
Check1; If not(RightField) then
Exit;
Check2(Num(Field),1,3,'Çíà÷åíèå ïîëÿ
äîëæíî áûòü â èíòåðâàëå 1 - 3.');
end; {11}
12 : begin {äàòà âñòóïëåíèÿ â ïàðòèþ
(ììãã) ********************}
Check3; If not(RightField) then
Exit;
{ïðîâåðêà âîçðàñòà âî âðåìÿ
âñòóïëåíèÿ}
Case (Record2.PartyMembership) of
1 : Check4(18); {÷ëåí ïàðòèè}
2 : Check4(16); {÷ëåí ÂËÊÑÌ}
end; {case}
end; {12}
13 : begin {ñåìåéíîå ïîëîæåíèå
*********************************}
Check1; If not(RightField) then
Exit;
Check2(Num(Field),1,4,'Çíà÷åíèå ïîëÿ
äîëæíî áûòü â èíòåðâàëå 1 - 4.');
end; {13}
end; {case}
END;
{====================================================================}
{====================================================================}
BEGIN
PrevFIO := ''; {ïðåäûäóùåé ôàìèëèè íå
áûëî}
{áåñêîíå÷íûé öèêë, âûõîä ïî 'Exit'}
While True do begin
ClrScr;
Write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ³1 - ÷ëåí
ïàðòèè ³ ');
Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Ñîîáùåíèÿ
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿³2 - ÷ëåí ÂËÊÑÌ
');
Write('³ ³³3 -
áåñïàðòèéíûé ³ ');
Write('³ Çàïîëíèòå ïîëÿ íåîáõîäèìîé èíôîðìàöèåé. ³ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ');
Write('³ ³ÚÄ Ñåìåéíîå
ïîëîæåíèå Ä¿');
Write('³ Ïðè ââîäå çàïèñåé, ôàìèëèè ³³1 - íå çàìóæåì/õîëîñò ³');
Write('³ äîëæíû ñëåäîâàòü â àëôàâèòíîì ïîðÿäêå. ³³2 - çàìóæåì/æåíàò ³');
Write('³ ³³3 -
ðàçâåäåíà/ðàçâåäåí³');
Write('³ Åñëè õîòèòå çàêîí÷èòü ââîä, íàæìèòå <Enter>. ³³4 - âäîâà/âäîâåö ³');
Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
With Record2 do begin
{ââîä èíôîðìàöèè}
For i := 1 to 13 do begin
{åñëè Ïàðòèéíîñòü =
"Áåñïàðòèéíûé", òî íå çàïðàøèâàòü äàòó}
If not((i = 12) and (PartyMembership
= 3)) then begin
{ïîâòîðÿòü, ïîêà ââåäåííîå ïîëå íå
áóäåò âåðíî}
Repeat
GotoXY(40,01+i); {óñòàíîâèòü êóðñîð}
WriteLn(LengthOfField[i]);
{îáîçíà÷èòü ðàçìåð ïîëÿ}
GotoXY(40,01+i); {óñòàíîâèòü êóðñîð}
ReadLn(Field); {çàïðîñèòü ïîëå}
{åñëè ââåäåíà ïóñòàÿ ôàìèëèÿ, òî
ïðåêðàòèòü ââîä}
If (i = 1) and (Field = '') then
Exit {âûõîä èç ïðîöåäóðû}
Else
ClearMessageBox; {î÷èñòèòü
áîêñ ñîîáùåíèé}
{êîíòðîëü ïîëÿ}
ControlSignificance;
Until RightField;
{ôîðìèðîâàíèå âûõîäíûõ çàïèñåé}
Case (i) of
1 : begin
{äîïîëíèòü ïîëå ïðîáåëàìè äî
15 ñèìâîëîâ}
While length(Field) < 15 do
Field := Field + ' ';
Record1.FIO := Field;
end;
2 : val(Field,Sex,Code);
3 : begin
BirthDay := DataImage(Field);
{ðàñ÷åò âîçðàñòà ñîòðóäíèêà}
Age := CalculationAge(Field);
end;
4 : val(Field,CodeEducation,Code);
5 :
val(Field,TimeSheetNumber,Code);
6 : val(Field,CodePost,Code);
7 : val(Field,Pay,Code);
8 : DateEntryToFactory :=
DataImage(Field);
9 :
val(Field,LengthOfService,Code);
10 :
val(Field,TotalLengthOfService,Code);
11 :
val(Field,PartyMembership,Code);
12 : DateEntryToParty :=
DataImage(Field);
13 :
val(Field,FamilySituation,Code);
end; {case i}
end {if}
Else begin
DateEntryToParty := '00/00';
end; {else}
end; {for i}
end; {with Record2}
PrevFIO := Record1.FIO; {çàïîìèíàåì
ôàìèëèþ êàê ïðåäûäóùóþ}
{âûâîä çàïèñåé íà äèñê}
Write(ff1,Record1); {âûâîä ôàìèëèè â ñîîòâåòñòâóþùèé ôàéë}
Write(ff2,Record2); {âûâîä çàïèñè â ôàéë
äàííûõ}
end; {while True}
END;
{**********************************************************************}
{îæèäàíèå íàæàòèÿ íà êëàâèøó}
PROCEDURE WaitingForKeyPressed;
Var
Key : char;
BEGIN
(* WriteLn(#7); {çâóêîâîé ñèãíàë} *)
WriteLn;
Write('Íàæìèòå ëþáóþ êëàâèøó, ÷òîáû
ïðîäîëæèòü...':60);
{ïóñòîé öèêë "ÏÎÊÀ" íå íàæàòà
êëàâèøà}
While not(KeyPressed) do;
Key := ReadKey; {î÷èñòèòü áóôåð
êëàâèàòóðû}
WriteLn;
WriteLn;
END;
{**********************************************************************}
{ïðåäóïðåæäåíèå î íà÷àëå ïå÷àòè}
PROCEDURE WarningOfPrinting(Name : string);
BEGIN
ClrScr;
WriteLn(Name:50);
WriteLn;
WriteLn('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»':56);
WriteLn('º Ïîäãîòîâüòå ïðèíòåð ê ðàáîòå:
':56);
WriteLn('º çàïðàâüòå áóìàãó è
':56);
WriteLn('º óñòàíîâèòå ðåæèì On Line
':56);
WriteLn('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ':56);
WaitingForKeyPressed;
WriteLn('Èäåò ïå÷àòü. Æäèòå...':50);
END;
{**********************************************************************}
{ïå÷àòü ñôîðìèðîâàííûõ ôàéëîâ}
PROCEDURE PrintDataFiles;
BEGIN
WarningOfPrinting('Ïå÷àòü Ñïèñêà
ôàìèëèé.');
WriteLn(pr,'Ñôîðìèðîâàí Ñïèñîê ôàìèëèé:');
WriteLn(pr,'---------------------------');
Reset(ff1);
{ïîêà íå äîñòèãíóò êîíåö ôàéëà,
âûïîëíÿòü...}
While not(EOF(ff1)) do begin
Read(ff1,Record1);
WriteLn(pr,Record1.FIO);
end; {while}
WriteLn(pr,#12); {ïåðåâîä ñòðàíèöû}
WarningOfPrinting('Ïå÷àòü Ôàéëà äàííûõ.
');
WriteLn(pr,'Ñôîðìèðîâàí Ôàéë äàííûõ:');
WriteLn(pr,'------------------------');
Reset(ff2);
{ïîêà íå äîñòèãíóò êîíåö ôàéëà,
âûïîëíÿòü...}
While not(EOF(ff2)) do begin
Read(ff2,Record2);
With Record2 do begin
Write(pr,TimeSheetNumber:3,' ');
Write(pr,Sex:1,' ');
Write(pr,CodePost:2,' ');
Write(pr,DateEntryToFactory:8,' ');
Write(pr,Pay:4,' ');
Write(pr,TotalLengthOfService:2,' ');
Write(pr,LengthOfService:2,' ');
Write(pr,CodeEducation:1,' ');
Write(pr,BirthDay:8,' ');
Write(pr,PartyMembership:1,' ');
Write(pr,DateEntryToParty:5,' ');
Write(pr,FamilySituation:1,' ');
WriteLn(pr,Age:2);
end; {with Record2}
end; {while}
WriteLn(pr,#12); {ïåðåâîä ñòðàíèöû}
END;
{**********************************************************************}
{ñîðòèðîâêà ñôîðìèðîâàííûõ ôàéëîâ}
PROCEDURE SortingDataFiles;
Var
Top, Bottom : integer; {íà÷àëî è êîíåö
ñîðòèðóåìîãî ôàéëà}
i, j ,k : integer;
iRecord1, kRecord1 : Struct1;
iRecord, jRecord, MinRecord : Struct2;
BEGIN
ClrScr;
WriteLn('Ñîðòèðîâêà ôàéëîâ äàííûõ.':52);
WriteLn('Æäèòå...':43);
Top
:= 0; {íîìåð ïåðâîé çàïèñè ôàéëà}
Bottom := FileSize(ff2)-1; {íîìåð
ïîñëåäíåé çàïèñè ôàéëà}
For i := Top to Bottom-1 do begin
Seek(ff2,i); Read(ff2,iRecord);
MinRecord := iRecord;
k := i;
For j := i+1 to Bottom do begin
Seek(ff2,j); Read(ff2,jRecord);
If (jRecord.Sex < MinRecord.Sex) or
((jRecord.Sex = MinRecord.Sex) and (jRecord.Age < MinRecord.Age)) then begin
MinRecord := jRecord;
k := j;
end; {if}
end; {for j}
{îáìåí çàïèñåé}
If k > i then begin
Seek(ff1,i); Read(ff1,iRecord1);
Seek(ff1,k); Read(ff1,kRecord1);
Seek(ff1,i); Write(ff1,kRecord1);
Seek(ff1,k); Write(ff1,iRecord1);
Seek(ff2,i); Write(ff2,MinRecord);
Seek(ff2,k); Write(ff2,iRecord);
end; {if}
end; {for i}
END;
{**********************************************************************}
{ïå÷àòü âåäîìîñòè}
PROCEDURE PrintTable;
Const
{ðàñøèôðîâêà êîäîâ}
TextForSex : array [0..1] of string[7] =
('Æåíùèíû',
'Ìóæ÷èíû');
TextForPartyMembership : array [1..3] of
string[11] =
('÷ëåí ïàðòèè',
'÷ëåí ÂËÊÑÌ ',
'
á/ï ');
Var
nList : byte; {íîìåð ëèñòà âåäîìîñòè}
CountLine : byte; {êîëè÷åñòâî íàïå÷àòàííûõ ïàð ñòðîê}
nContributor : word; {íîìåð ñîòðóäíèêà ïî ïîðÿäêó}
PrevSex, PrevAge : byte; {çíà÷åíèÿ
ïðåäûäóùåé çàïèñè}
SumPayForAge, {ñóììà ïî çàðïëàòå äëÿ âîçðàñòà}
SumTotalLengthOfServisForAge, {ñóììà ïî îá.ñòàæó äëÿ âîçðàñòà}
QuantityForAge, {÷èñëî ïîçèöèé äëÿ âîçðàñòà}
SumPayForSex, {ñóììà ïî çàðïëàòå äëÿ ïîëà}
SumTotalLengthOfServisForSex, {ñóììà ïî îá.ñòàæó äëÿ ïîëà}
QuantityForSex, {÷èñëî ïîçèöèé äëÿ ïîëà}
SumPayForTable, {ñóììà ïî çàðïëàòå äëÿ
òàáëèöû}
SumTotalLengthOfServisForTable, {ñóììà
ïî îá.ñòàæó äëÿ òàáëèöû}
QuantityForTable : word; {÷èñëî ïîçèöèé äëÿ òàáëèöû}
BreakPage : boolean; {áûë ëè ïåðåâåäåí
ëèñò}
{------------------------------------------------------------------}
{ïå÷àòü "ïîäâàëà" òàáëèöû}
PROCEDURE PrintFooter;
BEGIN
{ëèñò çàêîí÷èëñÿ ïîñëå îáû÷íîé ñòðîêè}
If (Record2.Sex = PrevSex) and
(Record2.Age = PrevAge) then begin
WriteLn(pr,'º ³
³ ³ ³ ³ ³ º');
WriteLn(pr,'ÈÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍͼ');
end {if}
Else begin
{ëèñò çàêîí÷èëñÿ ïîñëå ñðåäíåãî ïî
âîçðàñòó}
If (Record2.Sex = PrevSex) and
(Record2.Age <> PrevAge) then begin
WriteLn(pr,'º ³
º');
WriteLn(pr,'ÈÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍͼ');
end {if}
{ëèñò çàêîí÷èëñÿ ïîñëå ñðåäíåãî ïî
ïîëó}
Else begin
WriteLn(pr,'º ³
');
WriteLn(pr,AverageSum1:37,AverageSum2:9,' º');
{åñëè ýòî íå èòîã ïî òàáëèöå, òî
ïîä÷åðêíóòü ñðåäíèå}
If n < 3 then begin
WatchToPageBreak;
{åñëè ëèñò íå ïåðåâåäåí, òî
ïîä÷åðêíóòü ñð. àðèôìåòè÷åñêèå}
If not(BreakPage) then begin
Case (n) of
1 : begin
WriteLn(pr,'º ³
{ñìåíèëñÿ êëþ÷ Âîçðàñò?}
If Age <> PrevAge then begin
CalculationAverage(SumPayForAge,SumTotalLengthOfServisForAge,QuantityForAge,1);
PrevAge := Age;
end; {if}
{ñìåíèëñÿ êëþ÷ Ïîë?}
If Sex <> PrevSex then begin
CalculationAverage(SumPayForSex,SumTotalLengthOfServisForSex,QuantityForSex,2);
PrevSex := Sex;
end; {if}
inc(nContributor); {íàðàñòèòü íîìåð
ñîòðóäíèêà}
{íàïå÷àòàòü î÷åðåäíóþ ñòðî÷êó}
WriteLn(pr,'º ³
³ ³ ³ ³ ³ º');
Write(pr,'º',nContributor:2,'.');
If SumTotalLengthOfServisForSex = 0
then Write(pr,'³',TextForSex[Sex]:7)
else Write(pr,'³ ');
If SumTotalLengthOfServisForAge = 0
then Write(pr,'³ ',Age:2)