Oktatási naptár
Készítsünk Delphi alkalmazást, mely
naptárt hoz létre Excel munkalapon. A naptár egy teljes oktatási évet
tartalmazzon, az első napja augusztus 1, az utolsó július 31 legyen. Bemeneti
táblákon lehessen beállítani a tanév rendjét meghatározó dátumokat, melyet
szöveges állományként tároljon. Jelölje nagyobb karaktermérettel és félkövér
beállítással a tanítási napokat. Számolja össze és jelenítse meg azt is, hogy a
hány tanítási nap esik a hét egyes napjaira és azt, hogy a tanítási napok száma
összesen mennyi.
A szükséges VCL elemek:
A főform tervező nézetben:
A Naptar.txt tartalma:
A program futási képe:
Program által előállított naptár:
A program listája:
unit UDENaptar;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
ActiveX, Excel2000, OleServer,
Dialogs, StdCtrls, Grids, ExcelXP;
type
TfmDENaptar = class(TForm)
lbIdopontok: TLabel;
sgTanNapok: TStringGrid;
sgUnnepnapok: TStringGrid;
sgMunkanapok: TStringGrid;
sgRendkivuli: TStringGrid;
btNaptar: TButton;
btKilepes: TButton;
svExcelAlkalmazas: TExcelApplication;
svExcelMunkafuzet: TExcelWorkbook;
svExcelMunkalap: TExcelWorksheet;
Procedure NaptarTolt;
Procedure Lemezrol;
Procedure Lemezre;
procedure btKilepesClick(Sender: TObject);
procedure btNaptarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
St2=String[2];
St6=String[6];
TNap=Record
Dat: St6;
Tan: Boolean;
End;
var
fmDENaptar: TfmDENaptar;
Datum: Array[1..24] Of St6;
DNev: String;
FText: Text;
Naptar: Array[1..366] Of TNap;
HoNSz: Array[1..12] Of Word;
Ev1, Ev2, ANap, BOsz, AHet, NapI: Word;
TN: Array[1..7] Of Word;
Const Ho: Array[1..12] Of String=('Január','Február','Március','Április',
'Május','Június','Július','Augusztus',
'Szeptember','Október','November','December');
HoH: Array[1..12] Of Word=(31,28,31,30,31,30,31,31,30,31,30,31);
Nap='HKSCPSV';
implementation
{$R *.dfm}
Function SzokoEv(Ev: Word): Boolean;
Begin
SzokoEv:= (Ev Mod 4 = 0) And (Ev Mod 100 <> 0) Or (Ev Mod 400 = 0);
End;
Function NapNev(E, H, N: Word): Word;
Var DT: TDateTime;
P: Word;
Begin
DT:= StrToDate(IntToStr(E)+'.'+IntToStr(H)+'.'+IntToStr(N)+'.');
P:= DayOfWeek(DT)-1; If P=0 Then P:= 7; NapNev:= P;
End;
Function DateToIndex(D: St6): Word;
Var I: Word;
Begin
DateToIndex:= 0;
For I:= 1 To 366 Do If Naptar[I].Dat=D Then
Begin DateToIndex:= I; Break End;
End;
Procedure TfmDENaptar.NaptarTolt;
Var I, J, K: Word;
W1, W2: St2;
Begin
Ev1:= StrToInt(Copy(DateTimeToStr(Now),1,4));
If StrToInt(Copy(DateTimeToStr(Now),6,2))<8 Then Dec(Ev1);
Ev2:= Ev1+1;
For I:= 1 To 12 Do HoNSz[I]:= HoH[I];
If SzokoEv(Ev2) Then HoNSz[2]:= 29;
NapI:= 1;
For I:= 8 To 12 Do For J:= 1 To HoNsz[I] Do
Begin
W1:= IntToStr(I); If I<10 Then W1:= '0'+W1;
W2:= IntToStr(J); If J<10 Then W2:= '0'+W2;
Naptar[NapI].Dat:= W1+'.'+W2+'.';
Inc(NapI);
End;
For I:= 1 To 7 Do For J:= 1 To HoNsz[I] Do
Begin
W1:= IntToStr(I); If I<10 Then W1:= '0'+W1;
W2:= IntToStr(J); If J<10 Then W2:= '0'+W2;
Naptar[NapI].Dat:= W1+'.'+W2+'.';
Inc(NapI);
End;
For I:= 1 To 366 Do Naptar[I].Tan:= False;
For I:= 1 To 4 Do
For J:= DateToIndex(Datum[2*I-1]) To DateToIndex(Datum[2*I]) Do
Naptar[J].Tan:= True;
For I:= 1 To DateToIndex('12.31.') Do With Naptar[I] Do
If NapNev(Ev1,StrToInt(Copy(Dat,1,2)),StrToInt(Copy(Dat,4,2)))>5 Then
Tan:= False;
For I:= DateToIndex('01.01.') To DateToIndex('07.31.') Do With Naptar[I] Do
If NapNev(Ev2,StrToInt(Copy(Dat,1,2)),StrToInt(Copy(Dat,4,2)))>5 Then
Tan:= False;
For I:= 9 To 19 Do Naptar[DateToIndex(Datum[I])].Tan:= False;
For I:= 20 To 24 Do Naptar[DateToIndex(Datum[I])].Tan:= True;
For I:= 1 To 7 Do TN[I]:= 0;
J:= NapNev(Ev1,8,1); K:= 365; If SzokoEv(Ev2) Then K:= 366;
For I:= 1 To K Do
Begin
If Naptar[I].Tan Then Inc(TN[J]);
Inc(J); If J>7 Then J:= 1;
End;
End;
Procedure TfmDENaptar.Lemezrol;
Var I, J: Word;
Ws: St6;
Begin
AssignFile(FText,DNev); {$I-}Reset(FText);{$I+}
If IOResult<>0 Then ReWrite(FText) Else
Begin
J:= 1;
With sgTanNapok Do For I:= 1 To 8 Do
Begin ReadLn(FText,Ws); Cells[1,I]:= Ws; Datum[J]:= Ws; Inc(J) End;
With sgUnnepnapok Do For I:= 1 To 6 Do
Begin ReadLn(FText,Ws); Cells[1,I]:= Ws; Datum[J]:= Ws; Inc(J) End;
With sgMunkanapok Do For I:= 1 To 5 Do
Begin ReadLn(FText,Ws); Cells[1,I]:= Ws; Datum[J]:= Ws; Inc(J) End;
With sgRendkivuli Do For I:= 1 To 5 Do
Begin ReadLn(FText,Ws); Cells[1,I]:= Ws; Datum[J]:= Ws; Inc(J) End;
End;
CloseFile(FText);
End;
Procedure TfmDENaptar.Lemezre;
Var I: Word;
Begin
AssignFile(FText,DNev); ReWrite(FText);
For I:= 1 To 8 Do WriteLn(FText,sgTanNapok.Cells[1,I]);
For I:= 1 To 6 Do WriteLn(FText,sgUnnepnapok.Cells[1,I]);
For I:= 1 To 5 Do WriteLn(FText,sgMunkanapok.Cells[1,I]);
For I:= 1 To 5 Do WriteLn(FText,sgRendkivuli.Cells[1,I]);
CloseFile(FText);
End;
procedure TfmDENaptar.btKilepesClick(Sender: TObject);
begin
Lemezre;
Close;
end;
procedure TfmDENaptar.FormCreate(Sender: TObject);
begin
With sgTanNapok Do
Begin
ColWidths[1]:= 64;
Cells[0,0]:= 'Tanítási napok';
Cells[1,0]:= 'Dátum:';
Cells[0,1]:= 'A tanév első,';
Cells[0,2]:= 'az őszi szünet előtti utolsó,';
Cells[0,3]:= 'az őszi szünet utáni első,';
Cells[0,4]:= 'a téli szünet előtti utolsó,';
Cells[0,5]:= 'a téli szünet utáni első,';
Cells[0,6]:= 'a tavaszi szünet előtti utolsó,';
Cells[0,7]:= 'a tavaszi szünet utáni első,';
Cells[0,8]:= 'a tanév utolsó tanítási napja:';
End;
With sgUnnepnapok Do
Begin
ColWidths[1]:= 64;
Cells[0,0]:= 'Ünnepnapok';
Cells[1,0]:= 'Dátum:';
Cells[0,1]:= 'Október 23., Nemzeti ünnep';
Cells[0,2]:= 'Mindenszentek';
Cells[0,3]:= 'Március 15., Nemzeti ünnep';
Cells[0,4]:= 'A munka ünnepe';
Cells[0,5]:= 'Húsvét hétfő';
Cells[0,6]:= 'Pünkösd hétfő';
End;
With sgMunkanapok Do
Begin
ColWidths[1]:= 64;
Cells[0,0]:= 'Tanítás nélküli munkanapok';
Cells[1,0]:= 'Dátum:';
Cells[0,1]:= 'Az írásbeli érettségi 1. napja';
Cells[0,2]:= 'Az írásbeli érettségi 2. napja';
Cells[0,3]:= 'Az írásbeli érettségi 3. napja';
Cells[0,4]:= '1. igazgatói tanítási szünet';
Cells[0,5]:= '2. igazgatói tanítási szünet';
End;
With sgRendkivuli Do
Begin
ColWidths[1]:= 64;
Cells[0,0]:= 'Rendkívüli tanítási napok';
Cells[1,0]:= 'Dátum:';
Cells[0,1]:= '1.';
Cells[0,2]:= '2.';
Cells[0,3]:= '3.';
Cells[0,4]:= '4.';
Cells[0,5]:= '5.';
End;
DNev:= 'Naptar.txt';
Lemezrol;
NaptarTolt;
end;
procedure TfmDENaptar.btNaptarClick(Sender: TObject);
Var LCID: Integer;
Ws: String;
I, J, K: Word;
Tart: OleVariant;
begin
J:= 1;
For I:= 1 To 8 Do Begin Datum[J]:= sgTanNapok.Cells[1,I]; Inc(J) End;
For I:= 1 To 6 Do Begin Datum[J]:= sgUnnepnapok.Cells[1,I]; Inc(J) End;
For I:= 1 To 5 Do Begin Datum[J]:= sgMunkanapok.Cells[1,I]; Inc(J) End;
For I:= 1 To 5 Do Begin Datum[J]:= sgRendkivuli.Cells[1,I]; Inc(J) End;
GetDir(0,Ws);
LCID:= GetUserDefaultLCID;
With svExcelAlkalmazas Do
Begin
Connect;
Visible[LCID]:= True;
DisplayAlerts[LCID]:= False;
svExcelMunkafuzet.ConnectTo(WorkBooks.Add(TOleEnum(xlWBATWorkSheet),LCID));
End;
With svExcelMunkalap Do
Begin
ConnectTo(svExcelMunkafuzet.Worksheets[1] As _WorkSheet);
PageSetup.Orientation:= 2;
With Cells Do
Begin
For I:= 1 To 3 Do For J:= 1 To 4 Do For K:= 1 To 7 Do
Begin
Item[(I-1)*8+K-1+2,(J-1)*7+1].Value:= Nap[K];
Item[(I-1)*8+K-1+2,(J-1)*7+1].Font.Bold:= True;
Item[(I-1)*8+K-1+2,(J-1)*7+1].Font.Size:= 14;
End;
Item[1,1].Value:= IntToStr(Ev1)+'. '+Ho[8];
For I:= 9 To 11 Do Item[1,(I-8)*7+1].Value:= Ho[I];
Item[9,1].Value:= Ho[12];
Item[9,8].Value:= IntToStr(Ev2)+'. '+Ho[1];
For I:= 2 To 3 Do Item[9,(I-1)*7+8].Value:= Ho[I];
For I:= 4 To 7 Do Item[17,(I-4)*7+1].Value:= Ho[I];
ANap:= NapNev(Ev1,8,1); NapI:= 1;
BOsz:= 2;
For I:= 8 To 11 Do
Begin
AHet:= 0;
For J:= 1 To HoNSz[I] Do
Begin
Item[ANap+1,BOSz+AHet].Value:= J;
If Naptar[NapI].Tan Then
Begin
Item[ANap+1,BOSz+AHet].Font.Bold:= True;
Item[ANap+1,BOSz+AHet].Font.Size:= 14;
End;
Inc(NapI);
Inc(ANap);
If ANap=8 Then Begin ANap:= 1; Inc(AHet) End;
End;
Inc(BOsz,7);
End;
BOsz:= 2;
AHet:= 0;
For J:= 1 To HoNSz[12] Do
Begin
Item[ANap+9,BOSz+AHet].Value:= J;
If Naptar[NapI].Tan Then
Begin
Item[ANap+9,BOSz+AHet].Font.Bold:= True;
Item[ANap+9,BOSz+AHet].Font.Size:= 14;
End;
Inc(NapI);
Inc(ANap);
If ANap=8 Then Begin ANap:= 1; Inc(AHet) End;
End;
BOsz:= 9;
For I:= 1 To 3 Do
Begin
AHet:= 0;
For J:= 1 To HoNSz[I] Do
Begin
Item[ANap+9,BOSz+AHet].Value:= J;
If Naptar[NapI].Tan Then
Begin
Item[ANap+9,BOSz+AHet].Font.Bold:= True;
Item[ANap+9,BOSz+AHet].Font.Size:= 14;
End;
Inc(NapI);
Inc(ANap);
If ANap=8 Then Begin ANap:= 1; Inc(AHet) End;
End;
Inc(BOsz,7);
End;
BOsz:= 2;
For I:= 4 To 7 Do
Begin
AHet:= 0;
For J:= 1 To HoNSz[I] Do
Begin
Item[ANap+17,BOSz+AHet].Value:= J;
If Naptar[NapI].Tan Then
Begin
Item[ANap+17,BOSz+AHet].Font.Bold:= True;
Item[ANap+17,BOSz+AHet].Font.Size:= 14;
End;
Inc(NapI);
Inc(ANap);
If ANap=8 Then Begin ANap:= 1; Inc(AHet) End;
End;
Inc(BOsz,7);
End;
End;
For I:= 1 To 3 Do
With Range['A'+IntToStr((I-1)*8+1),'AB'+IntToStr((I-1)*8+1)] Do
Begin
Select;
Font.Bold:= True;
Font.Size:= 14;
HorizontalAlignment:= xlHAlignCenter;
End;
For I:= 1 To 3 Do
Begin
Range['A'+IntToStr((I-1)*8+1),'G'+IntToStr((I-1)*8+1)].MergeCells:= True;
Range['H'+IntToStr((I-1)*8+1),'N'+IntToStr((I-1)*8+1)].MergeCells:= True;
Range['O'+IntToStr((I-1)*8+1),'U'+IntToStr((I-1)*8+1)].MergeCells:= True;
Range['V'+IntToStr((I-1)*8+1),'AB'+IntToStr((I-1)*8+1)].MergeCells:= True;
End;
With Cells Do
Begin
Range['A1','AB1'].ColumnWidth:= 3.43;
J:= 0;
For I:= 1 To 7 Do
Begin
Item[I+1,29]:= Nap[I]+': '+IntToStr(TN[I]);
Inc(J,TN[I]);
End;
Item[9,29]:= 'Össz: '+IntToStr(J);
For I:=1 To 2 Do
Begin Tart:= Range['A1','AC1']; Tart.Select; Tart.Rows[1].Insert End;
Range['A1','AB1'].MergeCells:= True;
Item[1,1].Font.Size:= 18;
Item[1,1].Font.Bold:= True;
Item[1,1].Font.Underline:= True;
Item[1,1].HorizontalAlignment:= xlHAlignCenter;
Item[1,1].Value:= 'Naptár: '+IntToStr(Ev1)+'-'+IntToStr(Ev2)+'.';
With Range['A3','AB26'] Do
Begin
Select;
Borders.LineStyle:= xlContinuous;
End;
Range['AC1','AC1'].Select;
End;
SaveAs(Ws+'\Naptar');
End;
svExcelMunkalap.Disconnect;
svExcelMunkafuzet.Disconnect;
svExcelAlkalmazas.Quit;
svExcelAlkalmazas.Disconnect;
end;
end.