home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161a.iso / handson / files / copydelp.exe / Calendar / calend.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-11-17  |  4.6 KB  |  178 lines
  1. unit calend;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, ToolWin, Grids, Calendar, StdCtrls, ExtCtrls, Buttons, Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Calendar1: TCalendar;
  12.     Panel1: TPanel;
  13.     RichEdit1: TRichEdit;
  14.     CoolBar1: TCoolBar;
  15.     DateTimePicker1: TDateTimePicker;
  16.     Panel2: TPanel;
  17.     ShowHideCalendarBtn: TButton;
  18.     PopupMenu1: TPopupMenu;
  19.     UseShortDateFormatMenuItem: TMenuItem;
  20.     UseLongDateFormatMenuItem: TMenuItem;
  21.     UseDaywithDateMenuItem: TMenuItem;
  22.     PopupMenu2: TPopupMenu;
  23.     ToggleDateFormat1: TMenuItem;
  24.     ConfigureDateTimePicker1: TMenuItem;
  25.     procedure DateTimePicker1Change(Sender: TObject);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure Calendar1Change(Sender: TObject);
  28.     procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
  29.       Shift: TShiftState);
  30.     procedure ShowHideCalendarBtnClick(Sender: TObject);
  31.     procedure FormResize(Sender: TObject);
  32.     procedure UseShortDateFormatMenuItemClick(Sender: TObject);
  33.     procedure UseLongDateFormatMenuItemClick(Sender: TObject);
  34.     procedure UseDaywithDateMenuItemClick(Sender: TObject);
  35.     procedure DateTimePicker1DblClick(Sender: TObject);
  36.     procedure ToggleDateFormat1Click(Sender: TObject);
  37.     procedure ConfigureDateTimePicker1Click(Sender: TObject);
  38.   private
  39.     { Private declarations }
  40.     procedure WMGetMinMaxInfo(var MSG: Tmessage); message WM_GetMinMaxInfo;
  41.     procedure ToggleDateTimePickerFormat;
  42.   public
  43.     { Public declarations }
  44.   end;
  45.  
  46. var
  47.   Form1: TForm1;
  48. const
  49.    MINFORMHEIGHT =  300;
  50.    MINFORMWIDTH = 450;
  51.    DAYWITHDATEFMT = 'dddd, mmmm d, yyyy';
  52.    DATEFMT : String = DAYWITHDATEFMT;
  53. implementation
  54.  
  55. uses configform;
  56.  
  57. {$R *.DFM}
  58.  
  59. procedure TForm1.DateTimePicker1Change(Sender: TObject);
  60. var
  61.    Year, Month, Day : Word;
  62. begin
  63.   DecodeDate(DateTimePicker1.Date, Year, Month, Day);
  64.   Calendar1.Year := Year;
  65.   Calendar1.Month := Month;
  66.   Calendar1.Day := Day;
  67. end;
  68.  
  69. procedure TForm1.FormCreate(Sender: TObject);
  70. begin
  71.    Panel1.Height := Form1.ClientHeight Div 2;
  72.    DateTimePicker1.Align := alTop;
  73.    Panel1.Align := alBottom;
  74.    Calendar1.Align := alClient;
  75. end;
  76.  
  77. procedure TForm1.Calendar1Change(Sender: TObject);
  78. var
  79.    Year, Month, Day : Word;
  80. begin
  81.    DecodeDate(DateTimePicker1.Date, Year, Month, Day);
  82.    DateTimePicker1.Date := EncodeDate(Year, Month, Calendar1.Day);
  83. end;
  84.  
  85. procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  86.   Shift: TShiftState);
  87. begin
  88.    if Key = vk_F8 then
  89.       RichEdit1.selText := FormatDateTime(DATEFMT, DateTimePicker1.Date );
  90. end;
  91.  
  92. procedure TForm1.ShowHideCalendarBtnClick(Sender: TObject);
  93. begin
  94.    if Calendar1.Visible then
  95.    begin
  96.       Calendar1.Hide;
  97.         Calendar1.Align := alNone;
  98.       Panel1.Align := alClient;
  99.       ShowHideCalendarBtn.Caption := 'Show Calendar';
  100.    end
  101.    else
  102.    begin
  103.        Panel1.Align := alNone;
  104.        Panel1.Align := alBottom;
  105.        Panel1.Height := Form1.ClientHeight Div 2;
  106.        Calendar1.Align := alClient;
  107.        Calendar1.Show;
  108.        ShowHideCalendarBtn.Caption := 'Hide Calendar';
  109.    end;
  110. end;
  111.  
  112. procedure TForm1.FormResize(Sender: TObject);
  113. begin
  114.   Panel1.Height := Form1.ClientHeight Div 2;
  115. end;
  116.  
  117. procedure TForm1.WMGetMinMaxInfo(var MSG: Tmessage);
  118. // adapted from Borland Techinfo Knowledgebase tip #2865
  119. Begin
  120.   inherited;
  121.  
  122.   with PMinMaxInfo(MSG.lparam)^ do
  123.   begin
  124.     with ptMinTrackSize do
  125.     begin
  126.       X := MINFORMWIDTH;
  127.       Y := MINFORMHEIGHT;
  128.     end;
  129.    { with ptMaxTrackSize do     // uncomment to restrict maximum size too
  130.     begin
  131.       X := 350;
  132.       Y := 250;
  133.     end;   }
  134.   end;
  135. end;
  136.  
  137. procedure TForm1.UseShortDateFormatMenuItemClick(Sender: TObject);
  138. begin
  139.    DATEFMT := ShortDateFormat;
  140. end;
  141.  
  142. procedure TForm1.UseLongDateFormatMenuItemClick(Sender: TObject);
  143. begin
  144.    DATEFMT := LongDateFormat;
  145. end;
  146.  
  147. procedure TForm1.UseDaywithDateMenuItemClick(Sender: TObject);
  148. begin
  149.    DATEFMT := DAYWITHDATEFMT;
  150. end;
  151.  
  152. procedure TForm1.ToggleDateTimePickerFormat;
  153. begin
  154.    if DateTimePicker1.DateFormat = dfShort then
  155.       DateTimePicker1.DateFormat := dfLong
  156.    else
  157.        DateTimePicker1.DateFormat := dfShort;
  158. end;
  159.  
  160. procedure TForm1.DateTimePicker1DblClick(Sender: TObject);
  161. begin
  162.    ToggleDateTimePickerFormat;
  163. end;
  164.  
  165. procedure TForm1.ToggleDateFormat1Click(Sender: TObject);
  166. begin
  167.     ToggleDateTimePickerFormat
  168. end;
  169.  
  170. procedure TForm1.ConfigureDateTimePicker1Click(Sender: TObject);
  171. begin
  172.    if not (ConfigurationForm.visible) then
  173.      ConfigurationForm.show;
  174.    ConfigurationForm.BringToFront;
  175. end;
  176.  
  177. end.
  178.