home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / calendar.lzh / CALUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-05  |  3KB  |  130 lines
  1. unit Calunit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Spin, Buttons, ExtCtrls, Grids, Calendar;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     BitBtnPrevMnth: TBitBtn;
  12.     Calendar1: TCalendar;
  13.     PanelMnth: TPanel;
  14.     BitBtnNextMnth: TBitBtn;
  15.     BitBtnChgStrtDay: TBitBtn;
  16.     ButtonPrevYr: TButton;
  17.     ButtonNextYr: TButton;
  18.     ExpandBtn: TButton;
  19.     ShrinkBtn: TButton;
  20.     btntoday: TButton;
  21.     BtnOneLine: TButton;
  22.     procedure Calendar1Change(Sender: TObject);
  23.     procedure BitBtnNextMnthClick(Sender: TObject);
  24.     procedure BitBtnPrevMnthClick(Sender: TObject);
  25.     procedure BitBtnChgStrtDayClick(Sender: TObject);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure ButtonPrevYrClick(Sender: TObject);
  28.     procedure ButtonNextYrClick(Sender: TObject);
  29.     procedure ExpandBtnClick(Sender: TObject);
  30.     procedure ShrinkBtnClick(Sender: TObject);
  31.     procedure btntodayClick(Sender: TObject);
  32.     procedure BtnOneLineClick(Sender: TObject);
  33.   private
  34.     { Private declarations }
  35.   public
  36.     { Public declarations }
  37.   end;
  38.  
  39. var
  40.   Form1: TForm1;
  41.  
  42. implementation
  43.  
  44. {$R *.DFM}
  45.  
  46. Const
  47.   MonthNames : array[1..12] of string =
  48.    ('January','February','March','April','May','June',
  49.     'July','August','September','October','November','December');
  50.  
  51. procedure TForm1.FormCreate(Sender: TObject);
  52. begin
  53.   panelMnth.caption := MonthNames[calendar1.month] + ' ' +
  54.                        inttostr(calendar1.day) + ', ' +
  55.                        inttostr(calendar1.year);
  56. end;
  57.  
  58. procedure TForm1.Calendar1Change(Sender: TObject);
  59. begin
  60.   panelMnth.caption := MonthNames[calendar1.month] + ' ' +
  61.                        inttostr(calendar1.day) + ', ' +
  62.                        inttostr(calendar1.year);
  63.    if calendar1.calendardate = date
  64.      then btntoday.enabled := false
  65.      else btntoday.enabled := true;
  66. end;
  67.  
  68. procedure TForm1.BitBtnNextMnthClick(Sender: TObject);
  69. begin
  70.   calendar1.nextmonth;
  71. end;
  72.  
  73. procedure TForm1.BitBtnPrevMnthClick(Sender: TObject);
  74. begin
  75.   calendar1.prevmonth;
  76. end;
  77.  
  78. procedure TForm1.BitBtnChgStrtDayClick(Sender: TObject);
  79. begin
  80.   calendar1.startofweek := succ(calendar1.startofweek);
  81.   if calendar1.startofweek >= 7 then
  82.      calendar1.startofweek := 0;
  83. end;
  84.  
  85. procedure TForm1.ButtonPrevYrClick(Sender: TObject);
  86. begin
  87.   calendar1.prevyear;
  88.   if ((calendar1.month = 2) and (calendar1.day = 29)) then
  89.        calendar1.day := 28;
  90. end;
  91.  
  92. procedure TForm1.ButtonNextYrClick(Sender: TObject);
  93. begin
  94.   calendar1.nextyear;
  95.   if ((calendar1.month = 2) and (calendar1.day = 29)) then
  96.        calendar1.day := 28;
  97. end;
  98.  
  99. procedure TForm1.ExpandBtnClick(Sender: TObject);
  100. begin
  101.   form1.height:=267
  102.   ;
  103.   form1.width := 345;
  104.   expandbtn.visible := false;
  105.   shrinkbtn.visible := true;
  106. end;
  107.  
  108. procedure TForm1.ShrinkBtnClick(Sender: TObject);
  109. begin
  110.   form1.height := 193;
  111.   form1.width := 360;
  112.   expandbtn.visible := true;
  113.   shrinkbtn.visible := false;
  114. end;
  115.  
  116. procedure TForm1.BtnOneLineClick(Sender: TObject);
  117. begin
  118.   form1.height := 67;
  119.   form1.width := 360;
  120.   expandbtn.visible := true;
  121.   shrinkbtn.visible := false;
  122. end;
  123.  
  124. procedure TForm1.btntodayClick(Sender: TObject);
  125. begin
  126.   calendar1.calendardate := date;
  127. end;
  128.  
  129. end.
  130.