Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2014年11月10日] [更新 2016年12月07日] Delphi サンプルプログラム集
   
164_TCalendar を使用した日付ピッカーコンポーネント
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
元号選択式日付時刻入力コンポーネント (TplDateEdit)
164_DatePickerComponent.zip [4,298 KB] 2016年12月07日版(EXE同梱)



  • 2014年11月13日
  • コードのいろいろな修正とコード内のコメントの修正
  • 2015年11月03日
  • ロケールの日付の書式を和暦にするサンプルを追加
  • 2016年08月21日
  • 「指定した日が祝祭日かを調査する関数」の修正に伴う更新




日付ピッカー付きの日付入力コンポーネント


Delphi に実装されている日付入力関係のコンポーネントには次のようなものがあります.
  • TDateTimePicker
  • TMonthCalendar
  • TCalendar

TCalendar は [Samples] タブにあります.TCalendar は TCustomGrid の継承コンポーネントで,独立したユニットになっています.そのため,カスタマイズが比較的容易と言えます.

本ページのサンプルは,この TCalendar コンポーネントを使用したサンプルです.TCalendar コンポーネントを実行時に生成して,TDateTimePicker コンポーネントのように,カレンダを表示します.このカレンダで日付をピックアップします.
カレンダの年や月を移動するためのボタンを配置しています.これらは内部的に使用するだけなので,コンポーネントにしてしまった方が使い勝手良いと考え,コンポーネントにしています.
サイズの変更やフォントの変更に関するプロパティは実装していません.必要であれば各自で実装を考えてください.



[備考]
ロケールの日付の書式設定によっては,書式を伴う日付の処理が正しく行われない場合があります.





01_拙作の元号選択式日付時刻入力コンポを日付ピッカー付きにする


拙作の [元号選択式日付時刻入力コンポーネント] (クラス名は TplDateEdit) の継承クラスに,カレンダの表示機能を追加したココンポーネントを作成してみました.そのテストプログラムです.
実行時にコンポーネントを生成して表示します.プロジェクトのコンパイルには,拙作の [元号選択式日付時刻入力コンポーネント] がインストールされているか,TplDateEdit.pas をパスの通った場所に置いておく必要があります.

TDateTimePicker では,日付の入力部分にフォーカスがある場合,[F4] 押下でカレンダを表示するようになっていますが,本コンポーネントは,この機能は実装していません.TplDateEdit コンポーネントでは,[F4] は元号の選択リストを表示するようになっています.

このコンポーネントを,設計時にフォームに配置して,[元号選択式日付時刻入力コンポーネント] を移動すると,右側のボタンは,移動が終了してから移動します.少し違和感はありますが,フォームににボタンを配置してコーディングすることを考えれば,利用価値はあるかも知れません.




図1
実行画面
  • 日付入力用のコンポーネントの右側のボタンを押すとカレンダを表示する

リスト1
作成したコンポーネントのテストプログラム
コンポーネントは,実行時に生成して使用
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plDatePicker : TplDateEditPicker;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TplDateEditPickerのテスト(実行時生成)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  plDatePicker := TplDateEditPicker.Create(Self);
  plDatePicker.Parent := Self;
  plDatePicker.Top    := 40;
  plDatePicker.Left   := 20;
  plDatePicker.FormatMonthStr := 'YYYY年 M月';
  plDatePicker.StartOfWeek    := 0;
  plDatePicker.Gengo          := True;
end;

end.




02_日付の表示・入力部分を TCustomEdit にする場合


日付の表示,入力コントロールに拙作のコンポーネントを使用する必然性はありません.
以下は,TCustomEdit を継承したコンポーネントを日付の表示,入力に使用した場合のテストです.テストプログラムのコードは,上のテストプログラムと全く同じです.
注意して入力しないとカレンダに正確な日付をセットできませんが,TEdit の ReadOnly プロパティを True にして,日付の入力はカレンダだけに限定すれば一応実用にはなります.

添付のコンポーネントは,[F4] 押下でカレンダを表示するコードを追加しています.
このコンポーネントも,前項のコンポーネントと同じく,設計時にフォームに配置してマウスで移動すると,右側のボタンは,移動が終了してから移動します.




図2
実行時画面

本項のサンプルで使用しているコンポーネントは,上のサンプルで使用したコンポーネントのソースコードに以下の変更をして作成したものを使用しています.
  • TCustomEdit を継承した TMyDateEdit クラスを作成し,plDateEditPicker.pas に追加
    作成するクラス名は TMyDateEdit でなくてもよい.名前は任意
  • TplDateEditPicker の継承元を,作成したクラス名 (TMyDateEdit) にする
  • plDateEditPicker.pas 内の uses 部から plDateEdit を削除する

  TplDateEditPicker = class(TplDateEdit)
              ↓ 以下に変更
  TplDateEditPicker = class(TMyDateEdit)


作成した TMyDateEdit クラスには,最低限,読書き両用の Date プロパティが必要です.このプロパティは,TCalendar の Date プロパティへの値の設定と,読み出しに使用します.
Gengo プロパティは,作成した TMyDateEdit に元号表示するか,西暦表示するかを決めるプロパティです.GengoYear は,TCalendar で,和暦の入力制限を 99 年までとするために使用します.必要がなければ実装する必要ありません.その場合は,関係するコードを削除します.

このコンポーネントを外部から使用する際のクラス名は,上のサンプルと同じです.したがって,上のサンプルに添付しているコンポーネントと同時に使用することはできません.



リスト2
前項で使用したコンポーネントのコードに追加したコード
type と implementarion は,元のコードにあるので実際には不要
type
  TMyDateEdit = class(TCustomEdit)
  private
    FDate  : TDate;
    FGengo : Boolean;
    FGengoYear : Integer;
    procedure SetDatae(const Value: TDate);
    function GetGengoYear: Integer;
    function GetDate: TDate;
  public
    constructor Create(AOwner: TComponent); override;
    property Gengo     : Boolean read FGengo       write FGengo;
    property GengoYear : Integer read GetGengoYear write FGengoYear;
  published
    property Date : TDate read GetDate write SetDatae;
  end;

implementation

{ TMyDateEdit }

//-----------------------------------------------------------------------------
//  TMyDateEditのコンストラクタ(Createメソッド)
//-----------------------------------------------------------------------------
constructor TMyDateEdit.Create(AOwner: TComponent);
var
  iYear  : Word;
  iMonth : Word;
  iDay   : Word;
begin
  inherited;

  width     := 180;
  Height    := 23;
  Font.Size := 10;
  FGengo    := True;
  FDate     := Now;
  DecodeDate(FDate, iYear, iMonth, iDay);
  FGengoYear := iYear;
end;

//-----------------------------------------------------------------------------
//  TMyDateEditのDateプロパティの取得用関数
//  VarToDateTime関数は失敗すると例外を発生する
//-----------------------------------------------------------------------------
function TMyDateEdit.GetDate: TDate;
begin
  try
    Result := Trunc(VarToDateTime(Text));
  except
    Result := FDate;
  end;
end;

//-----------------------------------------------------------------------------
//  TMyDateEditのDateプロパティの設定用メソッド
//  和暦の時は年にeを使用しないと,VarToDateTime関数は西暦の値を返すので注意
//-----------------------------------------------------------------------------
procedure TMyDateEdit.SetDatae(const Value: TDate);
begin
  FDate := Value;
  if FGengo then begin
    Text := FormatDateTime('gg e年 M月 d日', Value);
  end else begin
    Text := FormatDateTime('YYYY年 M月 d日', Value);
  end;
end;

//-----------------------------------------------------------------------------
//  TMyDateEditのGengoYearプロパティの取得用関数
//-----------------------------------------------------------------------------
function TMyDateEdit.GetGengoYear: Integer;
var
  TheText : String;
begin
  TheText := FormatDateTime('e', FDate);
  Result  := StrToIntDef(TheText, 1);
end;




03_TMaskEdit で和暦表示


上のサンプルでは,日付の表示と入力に TCustomEdit を使用しましたが,元号や年月日の文字列以外の部分だけを入力可能にするコントロールとして思いつくのが TMaskEdit です.
TMaskEdit に和暦で日付を表示したり,TMaskEdit の EditText プロパティの値を TDateTime 型,あるいは TDate 型の値に変換するサンプルです.

TMaskEditは,指定桁数の値を入力すると,自動で次のフィールドに移動してくれます.指定桁数未満の入力で次のフィールドに移動するには,矢印キーを使用しなければなりません.この意味では,年月日の入力桁数は必須とした方が便利と言えます.




図3
設計時画面
  • TMadkEdit コンポーネントを配置
図4
TMaskEdit の値を TDate 型の値に変換
  • ここでは,変換した TDate 型の値を更に文字列に変換して表示している

リスト3
TMaskEdit で和暦表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Mask;

type
  TForm1 = class(TForm)
    Button1: TButton;
    MaskEdit1: TMaskEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TMaskEditに日付の値をセットする例
//
//  TMaskEditは,指定桁数の値を入力すると,自動で次のフィールドに移動してくれる
//  この意味では,表示と最大入力の桁数を固定しておく方がよいと思われる
//  最大入力桁数未満で次のフィールドに移動するには,矢印キーを使用する
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  MaskEdit1.ImeMode := imDisable;

  MaskEdit1.Text     := '';
 //'!   00年 00月 00\日;1; 'の方がいいかも知れない
  MaskEdit1.EditMask := '!   00年 00月 00\日;1; ';
  MaskEdit1.EditText := FormatDateTime('gg ee年 MM月 dd日', Now);
end;

//=============================================================================
//  TMaskEditの値(文字列型の値)から日付を取得する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADate   : TDate;
  TheText : String;
begin
  TheText := StringReplace(MaskEdit1.EditText, '_', '', [rfReplaceAll]);
  try
    ADate := Trunc(VarToDateTime(TheText));
  except
    ADate := Now;
  end;
  TheText := FormatDateTime('gg e年 M月 d日', ADate);
  MessageBox(Handle, PChar(TheText), '結果', 0);
end;

end.


[03-01_Component_Ex] フォルダに,TCustomMaskEdit を継承したコンポーネントのソースコードとテストプログラムを同梱しています.コンポーネントの名前の末尾に Ex を付けて,前のコンポーネントと別の名前にしています.
設計時の動作は,前項までのコンポーネントと同じです.



図5
TCustomMaskEdit を使用した日付ピッカー
  • 和暦と西暦表示の切り換え可能
  • カレンダの上の年月の表示書式も設定可能


[03-02_Component_EEx] フォルダには,同じく TCustomMaskEdit を継承したコンポーネントのソースコードとテストプログラムを同梱しています.
こらちのコンポーネントは,TMaskEdit の中にボタンを配置しています.ボタンとして,ウィンドウハンドルを持つ TBitBtn を使用しています.コンポーネントの名前の末尾に EEx を付けて,他のコンポーネントと区別できるようにしました.




図6
エディットコントロール内にボタンを配置
  • 和暦と西暦表示の切り換え可能
  • カレンダの上の年月の表示書式も設定可能




04_コンポーネントのソースコード


最初のテストプログラムで使用したコンポーネントのソースコードです.
カレンダ表示用のボタンをクリックすると,フォームを生成し,そのフォームの上にカレンダとボタン類を生成して表示するようになっています.
カレンダと共に配置しているボタン類は,内部的にに使用しているだけです.したがって,サブコンポーネントにはしていません.単なる内部の変数として使用しています.
TMaskEdit を使用したコンポーネントのソースコードは,サンプルのプロジェクトをダウンロードして確認してください.

国民の祝日 (祭日) の検出には,DEKO さんが作成したコードをユニットにして利用しています.平成 28 年 8 月から施行される「山の日」を国民の祝日 (祭日) に追加しています.

サイズの変更やフォントの変更に関するプロパティやメソッドは実装していません.必要であれば各自で追加してください.




図7
ファイル構成
  • 以下をパスの通った場所に置く
    plDateEditPicker.pas
    plDateEditPicker.res
    plDateEditPickerHoliday.pas
  • plDateEditPicker.pas をコンポーネントとして登録 (インストール) する

次のプロパティを追加しています.


凡例  published
 public
 ReadOnly

 StartOfWeek TDayOfWeek TCalendarの同名プロパティと同じ
設定可能な範囲は 0, 1, ..., 6
 FormatMonthStr TStrings カレンダの上に表示する年月の書式文字列


イベントは以下を追加しています.
このイベントは,TCalendar の OnClick イベントと同じです.日付の表示,入力用のコントロールにも同名のイベントがありますので,区別するためにこの名前にしています.OnClickCalendar のような名前の方がいいかも知れません.

OnCloseUpCalendar(Sender)

引数 説明
Sender TObject TCalendar コンポーネント
カレンダと右側のボタン以外で閉じた場合は発生しない


このコンポーネントは,内部でフォームを生成しています.TCalendar はイベント処理の都合でクラスを定義して,そのクラスから生成しています.フォームをそのようにすると,そのフォームのリソースが必要となるため,クラスの定義はしていません.TForm 型の変数から直接生成しています.

そのままでは処理ができないメッセージがあります.そこで,サブクラス化という手法を使用しています.そのサブクラス関数内でメッセージの処理を行っています.



リスト4
最初のサンプルで使用したコンポーネントのソースコード
unit plDateEditPicker;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Grids, Calendar, plDateEdit, Buttons, ExtCtrls,
  Types;

type
  TplDateEditPicker = class;

  TplDateEditCalendar = class(TCalendar)
  private
    FCompo : TpldateEditPicker;
  protected
    procedure DrawCell(ACol: Integer; ARow: Integer; ARect: TRect;
      AState: TGridDrawState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Click; override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TplDateEditPicker = class(TplDateEdit)
  private
    FbtnCalendarIcon   : TSpeedButton;
    FCalendarForm      : TForm;
    FlblMonth          : TLabel;
    FbtnPrevYear       : TSpeedButton;
    FbtnPrevMonth      : TSpeedButton;
    FbtnToday          : TSpeedButton;
    FbtnNextMonth      : TSpeedButton;
    FbtnNextYear       : TSpeedButton;
    FCalendar          : TplDateEditCalendar;
    FFlagCanClose      : Boolean;
    FFormatMonthStr    : String;
    FLimitMinYear      : Integer;
    FLimitMaxYear      : Integer;
    FStartOfWeek       : TDayOfWeek;
    FOnCloseUpCalendar : TNotifyEvent;
    FOriginalFormProc  : TWndMethod;
   procedure CreateFormAndControls(APos: TPoint);
    procedure OnMouseDownEventBtnCalendar(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnPrevNextClick(Sender: TObject);
    procedure CloseUpCalendar(KindOfClose: Integer);
    procedure SubClassFormProc(var Message: TMessage);
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMVisiblechanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
    procedure CMEnabledchanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
  public
    destructor Destroy; override;
    constructor Create(AOwner: TComponent); override;
  published
    property FormatMonthStr : String
      read FFormatMonthStr write FFormatMonthStr;
    property StartOfWeek : TDayOfWeek
      read FStartOfWeek write FStartOfWeek;
    property OnCloseUpCalendar : TNotifyEvent
      read FOnCloseUpCalendar write FOnCloseUpCalendar;
  end;

procedure Register;

implementation

uses 
  plIDateEditPickerIsHoliday;

{$R plDateEditPicker.res}

{ TplDateEditPicker }

//-----------------------------------------------------------------------------
//  コンポのconstructor処理
//-----------------------------------------------------------------------------
constructor TplDateEditPicker.Create(AOwner: TComponent);
begin
  inherited;

  //カレンダの上に表示する年月の表示フォーマット(publicプロパティ)
  FFormatMonthStr := 'YYYY 年 M月';
  //その他の初期値
  FLimitMinYear := 1873;
  FLimitMaxYear := 9999;
  //TCalendarのStartOfWeekの値
  FStartOfWeek  := 0;
end;

//-----------------------------------------------------------------------------
//  コンポのDestroy処理
//-----------------------------------------------------------------------------
destructor TplDateEditPicker.Destroy;
begin
  if Assigned(FCalendarForm) then begin
    FreeAndNil(FCalendarForm);
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
//  本コンポのSetParentメソッド処理
//  TplDateEditの右側にボタンを配置
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.SetParent(AParent: TWinControl);
var
  ABmp : TBitmap;
begin
  inherited;

  if AParent = nil then exit;

  if not Assigned(FbtnCalendarIcon) then begin
    FbtnCalendarIcon := TSpeedButton.Create(Self);
    //この程度であればWith文が便利
    With FbtnCalendarIcon do begin
      Parent      := AParent;
      Width       := 28;
      NumGlyphs   := 2;
      ParentBackground := False;
      OnMouseDown := OnMouseDownEventBtnCalendar;

      ABmp := TBitmap.Create;
      try
        ABmp.LoadFromResourceName(HInstance, 'plDateEditPickerBmp');
        FbtnCalendarIcon.Glyph.Assign(ABmp);
      finally
        FreeAndNil(ABmp);
      end;
    end;
    Self.Date := Now;
    Self.Font.Size := 10;
  end;
end;

//-----------------------------------------------------------------------------
//  本コンポのVisibleプロパティが変更された時のメッセージ処理
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  FbtnCalendarIcon.Visible := Self.Visible;
end;

//-----------------------------------------------------------------------------
//  本コンポのEnabledプロパティが変更された時のメッセージ処理
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.CMEnabledchanged(var Message: TMessage);
begin
  inherited;
  FbtnCalendarIcon.Enabled := Self.Enabled;
end;

//-----------------------------------------------------------------------------
//  本コンポの移動処理
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.WMMove(var Message: TWMMove);
begin
  inherited;
  if Assigned(FbtnCalendarIcon) then begin
    FbtnCalendarIcon.Left := Self.Left + Self.Width;
    FbtnCalendarIcon.Top  := Self.Top - 1;
  end;
end;

//-----------------------------------------------------------------------------
//  本コンポのリサイズ処理
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.WMSize(var Message: TWMSize);
begin
  inherited;
  if Assigned(FbtnCalendarIcon) then begin
    FbtnCalendarIcon.Left   := Self.Left + Self.Width;
    FbtnCalendarIcon.Top    := Self.Top - 1;
    FbtnCalendarIcon.Height := Self.Height + 2;
  end;
end;

//-----------------------------------------------------------------------------
//  TplDateEditの右側に配置したOnMouseDownイベント処理
//  ここでカレンダーを載せたフォームの表示,非表示を切り替える
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.OnMouseDownEventBtnCalendar(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  CalendarFormPos : TPoint;
  ParentForm      : TCustomForm;
  Monitor         : TMonitor;
  FormBottom      : Integer;
  FormRight       : Integer;
begin
  if Assigned(FCalendarForm) then begin
    if FCalendarForm.Visible then begin
      FCalendarForm.Close;
      CloseUpCalendar(1);
      exit;
    end;
  end;

  CalendarFormPos := TWinControl(Parent).ClientToScreen(Point(Self.Left, Self.Top));
  if not Assigned(FCalendarForm) then begin
    //カレンダーを表示するフォームとコントロール類を生成
    CreateFormAndControls(CalendarFormPos);
  end;

  Monitor := Screen.MonitorFromPoint(CalendarFormPos, mdNearest);

  FormBottom := CalendarFormPos.Y + Self.Height + FCalendarForm.Height;
  FormRight  := CalendarFormPos.X + FCalendarForm.Width;

  if Monitor.WorkareaRect.Bottom >= FormBottom then begin
    FCalendarForm.Top  := CalendarFormPos.Y + Self.Height;
  end else begin
    FCalendarForm.Top  := CalendarFormPos.Y - FCalendarForm.Height;
  end;

  if Monitor.WorkareaRect.Left > CalendarFormPos.X then begin
    FCalendarForm.Left := Monitor.WorkareaRect.Left;
  end else
  if Monitor.WorkareaRect.Right < FormRight then begin
    FCalendarForm.Left := Monitor.WorkareaRect.Right - FCalendarForm.Width;
  end else begin
    FCalendarForm.Left := CalendarFormPos.X;
  end;
  FCalendarForm.Show;

  FCalendar.StartOfWeek := FStartOfWeek;
  FCalendar.SetFocus;

  //TCalendarのOnChangeイベントを発生させる
  FCalendar.CalendarDate := Self.Date;

  ParentForm := GetParentForm(Self);
  PostMessage(ParentForm.Handle, WM_NCACTIVATE, 1, 0);
end;

//-----------------------------------------------------------------------------
//  カレンダー等を表示するフォームとコントロール類を生成して表示
//  体裁を考えて,初めて表示する時に生成する
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.CreateFormAndControls(APos: TPoint);
const
  CS_DROPSHADOW = $20000;
var
  WindowStyle     : LongInt;
  lblMonthHeight  : Integer;
  CalenderHeight  : Integer;
  FormClientWidth : Integer;
  btnHeight       : Integer;
  btnWidth        : Integer;
  btnTop          : Integer;
  FormHeight      : Integer;
  LRMargin        : Integer;
  btnSpace        : Integer;
  btnFonSize      : Integer;
begin
  //以下の2つの値を変更すると,フォームのサイズが変わる
  CalenderHeight  := 160;
  FormClientWidth := 197;
  //以下はその他の変数
  lblMonthHeight := 27;
  btnHeight      := 22;
  btnWidth       := 35;
  LRMargin       := 3;
  btnSpace       := 2;
  btnFonSize     := 9;
  btnTop         := lblMonthHeight + CalenderHeight + 6;
  FormHeight     := btnTop + btnHeight;

  if not Assigned(FCalendarForm) then begin
    FCalendarForm := TForm.Create(Self);
    with FCalendarForm do begin
      Caption      := 'plCalendarForm';
      Position     := poDesigned;
      ClientHeight := FormHeight;
      ClientWidth  := FormClientWidth;
      Scaled       := False;
      Font.Name    := 'MS Pゴシック';
      HorzScrollBar.Visible := False;
      VertScrollBar.Visible := False;
    end;
    WindowStyle := GetWindowLong(FCalendarForm.Handle, GWL_STYLE);
    WindowStyle := WindowStyle xor WS_CAPTION xor WS_THICKFRAME;
    WindowStyle := WindowStyle or WS_OVERLAPPED or WS_POPUP or WS_BORDER;

    //スタイル変更を実行
    SetWindowLong(FCalendarForm.Handle, GWL_STYLE, WindowStyle);
    //影付きとする
    SetClassLong(FCalendarForm.Handle, GCL_STYLE,
                 GetClassLong(FCalendarForm.Handle, GCL_STYLE) or CS_DROPSHADOW);
    //再描画のため必要(非クライアント領域を含めてウィンドウを再描画)
    SetWindowPos(FCalendarForm.Handle, 0, 0, 0, 0, 0,
                 SWP_DRAWFRAME  or
                 SWP_NOACTIVATE or
                 SWP_NOMOVE     or
                 SWP_NOSIZE     or
                 SWP_NOZORDER or SWP_HIDEWINDOW);

    FlblMonth := TLabel.Create(Self);
    with FlblMonth do begin
      Parent     := FCalendarForm;
      Height     := lblMonthHeight;
      Align      := alTop;
      Layout     := tlCenter;
      AutoSize   := False;
      Alignment  := taCenter;
      ParentFont := True;
      Font.Size  := 10;
      Caption    := '';
    end;

    FCalendar := TplDateEditCalendar.Create(Self);
    with FCalendar do begin
      Parent      := FCalendarForm;
      Width       := FCalendarForm.ClientWidth + 2;
      Left        := -1;
      Top         := FlblMonth.Height;
      Height      := CalenderHeight;
      ParentFont  := True;
      Font.Size   := 10;
      StartOfWeek := FStartOfWeek;
    end;

    //ボタンは,コンポーネント配列は使用しないで個別に生成
    FbtnPrevYear := TSpeedButton.Create(Self);
    With FbtnPrevYear do begin
      Parent     := FCalendarForm;
      Width      := btnWidth;
      Height     := btnHeight;
      Left       := LRMargin;
      Top        := btnTop;
      Caption    := '前年';
      ParentFont := True;
      Font.Size  := btnFonSize;
      OnClick    := btnPrevNextClick;
    end;

    FbtnPrevMonth := TSpeedButton.Create(Self);
    With FbtnPrevMonth do begin
      Parent     := FCalendarForm;
      Width      := btnWidth;
      Height     := btnHeight;
      Left       := FbtnPrevYear.Left + FbtnPrevYear.Width + btnSpace;
      Top        := btnTop;
      Caption    := '前月';
      ParentFont := True;
      Font.Size  := btnFonSize;
      OnClick    := btnPrevNextClick;
    end;

    FbtnNextYear := TSpeedButton.Create(Self);
    With FbtnNextYear do begin
      Parent     := FCalendarForm;
      Width      := btnWidth;
      Height     := btnHeight;
      Left       := FCalendarForm.ClientWidth - LRMargin - FbtnNextYear.Width;
      Top        := btnTop;
      Caption    := '翌年';
      ParentFont := True;
      Font.Size  := btnFonSize;
      OnClick    := btnPrevNextClick;
    end;

    FbtnNextMonth := TSpeedButton.Create(Self);
    With FbtnNextMonth do begin
      Parent     := FCalendarForm;
      Width      := btnWidth;
      Height     := btnHeight;
      Left       := FbtnNextYear.Left - btnSpace - FbtnNextMonth.Width;
      Top        := btnTop;
      Caption    := '翌月';
      ParentFont := True;
      Font.Size  := btnFonSize;
      OnClick    := btnPrevNextClick;
    end;

    FbtnToday := TSpeedButton.Create(Self);
    With FbtnToday do begin
      Parent     := FCalendarForm;
      Width      := btnWidth + 10;
      Height     := btnHeight;
      Left       := (FCalendarForm.ClientWidth - FbtnToday.Width) div 2;
      Top        := btnTop;
      Caption    := '今日';
      ParentFont := True;
      Font.Size  := btnFonSize;
      OnClick    := btnPrevNextClick;
    end;

    FCalendarForm.ClientHeight := FbtnPrevYear.Top + FbtnPrevYear.Height + 15;
    FCalendarForm.Color := FCalendar.Color;

    //カレンダを表示するフォームのメッセージ処理はサブクラスで対応
    FOriginalFormProc        := FCalendarForm.WindowProc;
    FCalendarForm.WindowProc := SubClassFormProc;
  end;
end;

//-----------------------------------------------------------------------------
//  各種ボタンのクリックイベント処理
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.btnPrevNextClick(Sender: TObject);
begin
  if Sender = FbtnPrevYear then begin
    FCalendar.PrevYear;
  end else
  if Sender = FbtnPrevMonth then begin
    FCalendar.PrevMonth;
  end else
  if Sender = FbtnToday then begin
    FCalendar.CalendarDate := Now;
  end else
  if Sender = FbtnNextMonth then begin
    FCalendar.NextMonth;
  end else
  if Sender = FbtnNextYear then begin
    FCalendar.NextYear;
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダのフォームを閉じた時のイベント処理
//  以下の操作以外で閉じた場合は発生しない
//  以下の操作で閉じた場合のみ値を変更するコードが書ける
//  (外部での実装となるが,元の値を退避しておく必要あり)
//
//  KindOfCloseUPの値
//  1 : TplDateEditの右側のボタンで閉じた
//  2 : 日付セルのOnClickで閉じた
//  3 : 日付セルの[Enter]押下で閉じた
//  4 : [ESC]押下で閉じた
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.CloseUpCalendar(KindOfClose: Integer);
begin
  if (Assigned(FOnCloseUpCalendar)) then begin
    FOnCloseUpCalendar(FCalendar);
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダを表示するフォームのサブクラス関数
//  他のアプリがアクティブになったらカレンダを載せているフォームを閉じる
//-----------------------------------------------------------------------------
procedure TplDateEditPicker.SubClassFormProc(var Message: TMessage);
var
  ParentForm : TCustomForm;
begin
  //元のウィンドウプロシージャーを実行
  FOriginalFormProc(Message);

  if Message.Msg = WM_ACTIVATEAPP then begin
    if FCalendarForm.Visible then begin
      ParentForm := GetParentForm(Self);
      PostMessage(ParentForm.Handle, WM_NCACTIVATE, 0, 0);
      PostMessage(FCalendarForm.Handle, WM_CLOSE, 0, 0);
    end;
  end else
  if Message.Msg = CM_DEACTIVATE then begin
    if FCalendarForm.Visible then begin
      PostMessage(FCalendarForm.Handle, WM_CLOSE, 0, 0);
    end;
  end;
end;

{ TplDateEditCalendar }

//-----------------------------------------------------------------------------
//  フォームに表示するTCalenderクラスのcontructor
//-----------------------------------------------------------------------------
constructor TplDateEditCalendar.Create(AOwner: TComponent);
begin
  inherited;
  FCompo := TplDateEditPicker(AOwner);
end;

//-----------------------------------------------------------------------------
//  フォームに表示するTCalenderクラスのClickメソッド
//-----------------------------------------------------------------------------
procedure TplDateEditCalendar.Click;
begin
  if (FCompo.FFlagCanClose) then begin
    FCompo.FCalendarForm.Close;
  end;

  inherited;
  if (FCompo.FFlagCanClose) then begin
    FCompo.CloseUpCalendar(2);
  end;
end;

//-----------------------------------------------------------------------------
//  フォームに表示するTCalenderクラスのChangeメソッド
//
//  TplDateEditが扱える範囲は1873年1月1日から4桁の西暦まで
//  和暦の時は99までしか扱えないので,そのための処理を追加
//-----------------------------------------------------------------------------
procedure TplDateEditCalendar.Change;
var
  ADate : TDate;
begin
  FCompo.FFlagCanClose := True;

  ADate := CalendarDate;

  //日付が範囲内であれば処理
  if (Year >= FCompo.FLimitMinYear) and (Year <= FCompo.FLimitMaxYear) then begin
    FCompo.Date := ADate;
  end else begin
    FCompo.FbtnPrevYear.Enabled  := False;
    FCompo.FbtnPrevMonth.Enabled := False;
    FCompo.FbtnNextMonth.Enabled := False;
    FCompo.FbtnNextYear.Enabled  := False;
    exit;
  end;

  if Year = FCompo.FLimitMinYear then begin
    FCompo.FbtnPrevYear.Enabled  := False;
    FCompo.FbtnPrevMonth.Enabled := Month <> 1;
  end else begin
    FCompo.FbtnPrevYear.Enabled  := True;
    FCompo.FbtnPrevMonth.Enabled := True;
  end;;

  //和暦表示の時は99年を超えた年は入力(ビック)できないようにする
  if FCompo.Gengo then begin
    if (FCompo.GengoYear = 99) then begin
      FCompo.FbtnNextYear.Enabled  := False;
      FCompo.FbtnNextMonth.Enabled := Month <> 12;
    end else begin
      FCompo.FbtnNextYear.Enabled  := True;
      FCompo.FbtnNextMonth.Enabled := True;
    end;
  end else begin
    if (Year = FCompo.FLimitMaxYear) then begin
      FCompo.FbtnNextYear.Enabled  := False;
      FCompo.FbtnNextMonth.Enabled := Month <> 12;
    end else begin
      FCompo.FbtnNextYear.Enabled  := True;
      FCompo.FbtnNextMonth.Enabled := True;
    end;;
  end;

  FCompo.FlblMonth.Caption := FormatDateTime(FCompo.FFormatMonthStr, ADate);
  inherited;
end;

//-----------------------------------------------------------------------------
//  フォームに表示するTCalenderクラスのKeyDownメソッド
//  矢印キーではKeyPressは発生しない
//  KeyDownの後にClickが発生する
//
//  VK_ESCAPEの時は,元に値に戻すような仕様の方がいいのか?
//-----------------------------------------------------------------------------
procedure TplDateEditCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    FCompo.FCalendarForm.Close;
    FCompo.CloseUpCalendar(3);
  end else
  if Key = VK_ESCAPE then begin
    FCompo.FCalendarForm.Close;
    FCompo.CloseUpCalendar(4);
  end else begin
    if Key in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then begin
      FCompo.FFlagCanClose := False;
    end else begin
      FCompo.FFlagCanClose := True;
    end;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
//  フォームに表示するTCalenderクラスのDrawCellメソッド
//  ここで日付の文字をTCalendarに描画している
//  このコードがないと,カレンダーのグリッドには何も表示しない
//-----------------------------------------------------------------------------
procedure TplDateEditCalendar.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  TheText   : string;
  ADate     : TDate;
  iDay      : Word;
  StrText   : string;
  SundayCol : Byte;
begin
  if FCompo.FStartOfWeek = 0 then begin
    SundayCol := 0;
  end else begin
    SundayCol := 7 - FCompo.FStartOfWeek;
  end;
  if (ACol = SundayCol) then Canvas.Font.Color := clRed;
  if (ACol = (6 - FCompo.FStartOfWeek)) then Canvas.Font.Color := $00C86615;

  TheText := CellText[ACol, ARow];
  if (not (gdFixed in AState)) then begin
    iDay := StrToIntDef(TheText, 0);
    if iDay <> 0 then begin
      ADate := EncodeDate(Year, Month, iDay);
      if IsSpecialHoliday(ADate, StrText) then begin
        Canvas.Font.Color := clRed;
      end;
    end;
  end;

  inherited DrawCell(ACol, ARow, ARect, AState);
end;

//-----------------------------------------------------------------------------
//   コンポーネント登録情報
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('plXRAY', [TplDateEditPicker]);
end;

end.




05_Delphi の日付時刻入力用コンポーネント


Delphi には,今回使用した TCalendar コンポーネント以外にも,日付や時刻の入力用のコンポーネントが用意されています.
下図は [Win32] タブにある TDateTimePicker コンポーネントです.

TDateTimePicker も,この後の TMonthCalendar, JEDI プロジェクトが提供している日付,時刻入力用のコンポーネントも Windows のコモンコントロールを使用したコンポーネントです.

これらのコンポーネントで和暦表示するには,筆者の知る限りでは,ロケールの設定を和暦に変更しないとできないようです..NET Framework の日付,時刻入力用コントロールであれば,システムの設定を変更しなくても和暦表示が可能なようです.




図8
TDateTimePicker コンポーネント
  • 時刻の入力用としても使用可能

下図は [Win32] タブにある TMonthCalendar コンポーネントです.このコンポーネントは,コンテナコンポーネントである TForm や TPanel に配置して使用します.
今回作成したコンポーネントでは,ボタン操作で年や月を移動します.Windows が提供している日付,時刻の入力用のコントロールでは,年月の表示部分をクリックすると,下図のように,月や年を選択できるようになります.



図9
TMonthCalendar コンポーネント
図10
年月の表示部分をクリックした状態
図11
更にクリック
図12
更にクリックした状態

JEDI プロジェクトにも,以下のような日付時刻入力用のコンポーネントがあります.
これらも Windows のコモンコントロールを使用していますが,TDateTimePicker, TMonthCalendar コンポーネントと実装内容が少し違います.例えば,TJvMonthCalendar2 には日付が選択された時のイベント OnSelect がありますが,TDateTimePicker にはありません.



図13
JEDI プロジェクトの日付時刻入力用コンポ
  • 上から
    TJvDateTimePicker
    TJvMonthCalendar
    TJvMonthCalendar2




06_ロケールの日付の書式を和暦に変更


ロケールは,現在の言語環境における日付や時刻,通貨等の書式の定義あるいは規則です.

Delphi は,自アプリ内で自由に日付や時刻の書式を設定できます.
ただし,現在のロケールにおける日付の書式が変更されていると,日付書式関係の処理が期待通りにならない場合があります.そのような場合,ShortDateFormat 等のグローバル変数で日付の書式を明示的に指定することで回避できます.

Delphi に付属の TDateTimePicker, TMonthCalendar コンポーネントには日付の書式を設定するプロパティやメソッドは実装されていません.また,ShortDateFormat 等で書式を和暦にしても,表示は和暦にはなりません.
そこで考えられるのが,ロケールの日付の書式を和暦にすることです.そうすると,ユーザのシステムの設定が変わります.したがって,日付関係の書式が和暦になることが期待できます.
本サンプルは,実際に SetLocaleInfo 関数を使用して,ロケールの日付の書式を設定します.終了時には元の設定に戻すようにしています.



[備考]
Delphi XE3では,グローバル変数 ShortDateFormat が廃止されました.また,Delphi XE5 でグローバル変数の MaxEraCount, EraNames, EraYearOffsets 等が廃止されました.詳細は以下の記事で確認してください.



実際にロケールを設定した結果を,[地域と言語] のダイアログで確認したのが下図です.
日付の書式が変更されていて,タスクバーの通知領域の日付も和暦になっています.



図14
変更前の [地域と言語] の設定を確認
図15
設定を [地域と言語] で確認
  • 日付の書式が変更されている
図16
カレンダの種類が [和暦] になる
  • 変更前は [西暦 (日本語)]
図17
変更後の通知領域の日付表示
  • 和暦表示になっている
  • ロケール情報の変更は,現在のユーザのシステム全体の変更となる
  • 他のアプリの日付処理も影響を受ける

下図は,本サンプルの設計時の画面と,実行時の画面です.
TDateTimePicker, TMonthCalendar コンポーネント共に,生成時にロケールの設定に従って書式を決定するようになっているようです.そこで,サンプルではロケールの設定と同時に,これらのコンポーネントを再生成しています.
カレンダ上部の年月には元号表示がありませんが,それ以外は和暦表示になっています.

ロケールの設定の変更は,ユーザのシステム全体の変更となります.他のアプリケーションの日付処理関係にも影響を与える可能性があります.
TCalendar コンポーネント,あるいは TCalendar コンポーネントを使用したコンポーネントを使用したコンポーネントを作成して利用すれば,ロケールの設定値とは全く関係なく,日付や時刻の書式を自由に設定することができます.



図18
設計時の画面
  • 上が TMonthCalendar コンポーネント
  • 下が TDateTimePicker コンポーネント
  • Button2 は [地域と言語] のダイアログ表示用のボタン (設定確認用)
図19
ロケールの日付の書式を和暦に変更
  • カレンダ上部の年月には元号表示がないが,和暦の日付になっている

リスト5
ロケールの日付の書式を和暦に変更
unit Unit1;

interface

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

type
  TForm1 = class(TForm)

    Button1: TButton;
    DateTimePicker1: TDateTimePicker;
    MonthCalendar1: TMonthCalendar;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FCalendarIdentifier : string;
    FShortDateFormat    : string;
    FLongDateFormat     : string;
    procedure SetLocaleDateFormat(ACalenderKind, AShortFmt, ALongFmt: string);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
 ShellAPI;

{$R *.dfm}

type
  TMyMonthCalendar = class(TMonthCalendar);
  TMyDateTimePicker = class(TDateTimePicker);

//=============================================================================
//  フォーム生成時の処理
//  ロケールの設定値を取得してグローバル変数に退避
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LTemp : array [0..LOCALE_NAME_MAX_LENGTH-1] of Char;
begin
  //指定ロケール識別子のカレンダの種類
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICALENDARTYPE, LTemp, Length(LTemp));
  FCalendarIdentifier := LTemp;

  //[日付(短い形式)]
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, LTemp, Length(LTemp));
  FShortDateFormat := LTemp;

  //[日付(長い形式)]
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLONGDATE, LTemp, Length(LTemp));
  FLongDateFormat := LTemp;
end;

//=============================================================================
//  フォームを閉じる時の処理
//  退避しておいた値をを使用して設定を元に戻す
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SetLocaleDateFormat(FCalendarIdentifier, FShortDateFormat, FLongDateFormat);
end;

//=============================================================================
//  ロケールのカレンダを和暦にして,日付の表示形式を設定
//  カレンダの種類と日付の形式が適切でないと正常に設定できないので注意
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCalendarIdentifier : string;
  LShortDateFormat    : string;
  LLongDateFormat     : string;
begin
  LCalendarIdentifier := UIntToStr(CAL_JAPAN);
  LShortDateFormat    := 'gg y/M/d';
  LLongDateFormat     := 'gg y''年''M''月''d''日''';

  SetLocaleDateFormat(LCalendarIdentifier, LShortDateFormat, LLongDateFormat);

  //コンポーネントの再生成
  //再生成しないと日付の書式が変更されない
  TMyMonthCalendar(MonthCalendar1).RecreateWnd;
  TMyDateTimePicker(DateTimePicker1).RecreateWnd;
end;

//=============================================================================
//  [地域と言語]のダイアログを表示
//  設定の確認用
//
//  ShellExecuteの使用にはusesにShellAPIが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDlgPath : string;
  LParams  : string;
begin
  LDlgPath := 'control.exe';
  LParams  := '/name Microsoft.RegionalAndLanguageOptions /page';
  ShellExecute(Handle, '', PChar(LDlgPath), PChar(LParams), nil, SW_SHOW);
end;

//-----------------------------------------------------------------------------
//  日付の書式等の設定用メソッド
//-----------------------------------------------------------------------------
procedure TForm1.SetLocaleDateFormat(ACalenderKind, AShortFmt,
  ALongFmt: string);
var
  LRet : Cardinal;
begin
  //指定ロケール識別子のカレンダの種類
  SetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICALENDARTYPE, PChar(ACalenderKind));
  //[日付(短い形式)]
  SetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, PChar(AShortFmt));
  //[日付(長い形式)]
  SetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLONGDATE, PChar(ALongFmt));

  //変更をシステムに通知
  //WM_SETTINGCHANGE = WM_WININICHANGE
  SendMessageTimeout(HWND_BROADCAST, WM_WININICHANGE, 0, 0, SMTO_NORMAL, 300, LRet);
end;

end.




07_元号名のリスト


元号名のリストは,前項で述べた理由により,Delphi XE5 以降と,それより前のバージョンの Delphi とでは取得方法が違うことになります.
Delphi XE4 以前では EraNames から取得します.Delphi XE5 以降では TFormatSettings.EraInfo から取得できます.




図20
元号のリスト

リスト6
元号名のリスト
Delphi 6 〜 Delphi XE4 用のコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  元号のリストを作成
//  Delphi 6 〜 Delhi XE4
//  MaxEraCountはSysUtilsで定義されている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
begin
  ListBox1.Items.Clear;

  for i := 1 to MaxEraCount do begin
    if EraNames[i]='' then break;
    ListBox1.Items.Add(EraNames[i]);
  end;
end;

end.


リスト7
元号名のリスト
Delphi XE5 以降用のコード
//=============================================================================
//  元号のリストを作成
//  Delhi XE5以降用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFormatSettings : TFormatSettings;
  LEraNames       : array of string;
  LMaxEraCount    : Integer;
  i               : Integer;
begin
  ListBox1.Items.Clear;

  LFormatSettings := TFormatSettings.Create;
  LMaxEraCount    := Length(FormatSettings.EraInfo);
  SetLength(LEraNames, LMaxEraCount + 1);

  for i := 0 to LMaxEraCount - 1 do begin
    LEraNames[i + 1] := LFormatSettings.EraInfo[I].EraName;
    ListBox1.Items.Add(LEraNames[i + 1]);
  end;
end;