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.

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

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;

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.

OnCloseUpCalendar(Sender)

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 
  plDateEditIsHoliday;

{$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    := 'ＭＳ Ｐゴシック';
      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.

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.

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.

//=============================================================================
//  元号のリストを作成
//  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;