calendarform.pas

功能全面的商业财会系统源码,清晰,很有参考价值.扩展性强.

unit CalendarForm;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Buttons, Grids, Calendar,
  ExtCtrls, Dialogs;

type
  TfrmCalendar = class(TForm)
    Calendar1: TCalendar;
    btnOK: TButton;
    btnCancel: TButton;
    Panel1: TPanel;
    lblTitle: TLabel;
    btnNextMonth: TSpeedButton;
    btnPrevMonth: TSpeedButton;
    procedure btnNextMonthClick(Sender: TObject);
    procedure btnPrevMonthClick(Sender: TObject);
    procedure Calendar1Change(Sender: TObject);
    procedure Calendar1DblClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    procedure SetDate(Date: TDateTime);
    function GetDate: TDateTime;
  public
    property Date: TDateTime read GetDate write SetDate;
  end;

var
  frmCalendar: TfrmCalendar;

implementation

{$R *.DFM}

procedure TfrmCalendar.SetDate(Date: TDateTime);
begin
  Calendar1.CalendarDate := Date;
end;

function TfrmCalendar.GetDate: TDateTime;
begin
  Result := Calendar1.CalendarDate;
end;

procedure TfrmCalendar.btnNextMonthClick(Sender: TObject);
begin
  Calendar1.NextMonth;
end;

procedure TfrmCalendar.btnPrevMonthClick(Sender: TObject);
begin
  Calendar1.PrevMonth;
end;

procedure TfrmCalendar.Calendar1Change(Sender: TObject);
begin
  lblTitle.Caption := FormatDateTime('MMMM, YYYY', Calendar1.CalendarDate);
end;

procedure TfrmCalendar.Calendar1DblClick(Sender: TObject);
begin
  ModalResult := mrOK;   //Close form as per OK button.
end;

procedure TfrmCalendar.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (shift = [ssCtrl]) and (key = vk_left) then begin
    Calendar1.PrevMonth;
    key := 0;
  end else if (shift = [ssCtrl]) and (key = vk_right) then begin
    Calendar1.NextMonth;
    key := 0;
  end;  
end;

end.