Naptár

Írjunk egy egyszerű kis alkalmazást, mely öröknaptárként használható. A program indítása után az aktuális évvel és hónappal jelenjen meg. Az aktuális év egy szerkeszthető Edit mezőben legyen, melyet tetszőleges évre át lehessen írni. A hónapok neve egy nem szerkeszthető Edit mezőben helyezkedjen el. Az évekre és a hónapokra külön-külön lefelé és felfelé (egyesével) léptető nyomógombok álljanak rendelkezésre. Jelenjenek meg a hét napjai nevének rövidítései. A megjelenítésre Panel elemeket használjunk. Az aktuális nap legyen kiemelve (szín, méret, aláhúzás). A hétvégét eltérő háttérszínekkel jelenítsük meg.

A futási kép:

A program listája:

unit UNaptar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
DateUtils,
Dialogs, StdCtrls, ExtCtrls;

Const Ho: Array[1..12] Of String[10]=('Január','Február','Március',
                                      'Április','Május','Június',
                                      'Július','Augusztus','Szeptember',
                                      'Október','November','December');
      Nap: Array[0..6] Of String[3]= ('H','K','Sze','Cs','P','Szo','V');
type
TfmNaptar = class(TForm)
plNaptar: TPanel;
edEv: TEdit;
edHo: TEdit;
btEvLe: TButton;
btEvFel: TButton;
btHoLe: TButton;
btHoFel: TButton;
Procedure Kepre(Ev,Ho: Word);
procedure FormCreate(Sender: TObject);
procedure btEvLeClick(Sender: TObject);
procedure btEvFelClick(Sender: TObject);
procedure btHoLeClick(Sender: TObject);
procedure btHoFelClick(Sender: TObject);
procedure edEvChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmNaptar: TfmNaptar;
AEv, AHo: Word;
MaEv, MaHo, MaNap: Word;
  Napok: Array[0..5,1..7] Of TPanel;

implementation

{$R *.dfm}

Procedure TfmNaptar.Kepre(Ev,Ho: Word);
Var I, J, HN: Word;
    DT: TDateTime;
Begin
For I:= 0 To 5 Do For J:= 1 To 7 Do Napok[I,J].Caption:= ''; J:= 0;
For I:= 1 To 31 Do If IsValidDate(Ev,Ho,I) Then
Begin
    DT:= StrToDate(IntToStr(Ev)+'.'+IntToStr(Ho)+'.'+IntToStr(I));
    HN:= DayOfWeek(DT)-1; If HN=0 Then HN:= 7;
    Napok[J,HN].Caption:= IntToStr(I);
If (Ev=MaEv) And (Ho=MaHo) And(I=MaNap) Then
Begin
      Napok[J,HN].Font.Style:= [fsBold, fsUnderLine];
      Napok[J,HN].Font.Color:= clRed;
      Napok[J,HN].Font.Size:= 12;
End Else
Begin
      Napok[J,HN].Font.Style:= [fsBold];
      Napok[J,HN].Font.Color:= clBlack;
      Napok[J,HN].Font.Size:= 8;
End;
If HN=7 Then Inc(J);
End;
End;

procedure TfmNaptar.FormCreate(Sender: TObject);
Var I, J: Word;
Het: Array[0..6] Of TPanel;
    Ma: String[10];
begin
  Ma:= DateToStr(Today());
AEv:= StrToInt(Copy(Ma,1,4)); EdEv.Text:= IntToStr(AEv);
AHo:= StrToInt(Copy(Ma,6,2)); edHo.Text:= Ho[AHo];
MaEv:= AEv; MaHo:= AHo; MaNap:= StrToInt(Copy(Ma,9,2));
For I:= 0 To 6 Do
Begin
Het[I]:= TPanel.Create(plNaptar);
With Het[I] Do
Begin
Parent:= plNaptar;
Width:= 27;
Height:= 24;
Left:= I*Width+18;
      Top:= 33;
Caption:= Nap[I];
Color:= clOlive;
With Font Do
Begin
Color:= clWhite;
Style:= [fsBold];
End;
End;
End;
For I:= 0 To 5 Do For J:= 1 To 7 Do
Begin
    Napok[I,J]:= TPanel.Create(plNaptar);
With Napok[I,J] Do
Begin
Parent:= plNaptar;
Width:= 27;
Height:= 24;
Left:= (J-1)*Width+18;
      Top:= I*Height+57;
Case J Of
        6: Color:= clSkyBlue;
        7: Color:= clSilver;
Else Color:= clYellow;
End;
Font.Style:= [fsBold];
End;
End;
Kepre(AEv,AHo);
end;

procedure TfmNaptar.btEvLeClick(Sender: TObject);
begin
Dec(AEv); edEv.Text:= IntToStr(AEv); Kepre(AEv,AHo);
end;

procedure TfmNaptar.btEvFelClick(Sender: TObject);
begin
  Inc(AEv); edEv.Text:= IntToStr(AEv); Kepre(AEv,AHo);
end;

procedure TfmNaptar.btHoLeClick(Sender: TObject);
begin
Dec(AHo);
If AHo=0 Then Begin AHo:= 12; Dec(AEv); edEv.Text:= IntToStr(AEv) End;
edHo.Text:= Ho[AHo]; Kepre(AEv,AHo);
end;

procedure TfmNaptar.btHoFelClick(Sender: TObject);
begin
  Inc(AHo);
If AHo=13 Then Begin AHo:= 1; Inc(AEv); edEv.Text:= IntToStr(AEv) End;
edHo.Text:= Ho[AHo]; Kepre(AEv,AHo);
end;

procedure TfmNaptar.edEvChange(Sender: TObject);
Var Kod: Integer;
begin
Val(edEv.Text, AEv, Kod); Kepre(AEv,AHo);
end;

end.