unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls, Buttons, plCalendarFormUnit, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    CalForm : TplCalendarForm;
    procedure OnCalendarChangeEvent(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.SelStart   := 1;
  Edit1.AutoSelect := False;
  Edit1.Text := FormatDateTime('yyyy年 MM月 dd日', Now);
end;

//=============================================================================
//  ボタンをクリックしたらカレンダフォームを表示
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  APos     : TPoint;
  CalDate  : TDate;
begin
  //カレンダフォームが生成されていないなら生成して、イベントも設定
  if not Assigned(CalForm) then begin
    CalForm := TplCalendarForm.Create(Self);
    CalForm.Calendar.OnChange := OnCalendarChangeEvent;
  end;

  if CalForm.Visible then begin
    CalForm.Close;
  end else begin
    //表示位置をスクリーン座標値に変換
    APos := Self.ClientToScreen(Point(Edit1.Left, Edit1.Top + Edit1.Height));
    CalForm.ShowPopUp(APos.X, APos.Y, Edit1.Height);
    //Edit1の値を日付に変換してカレンダフォームのカレンダにセット
    try
      CalDate := VarToDateTime(Edit1.Text);
    except
      CalDate := Trunc(Now);
    end;
    CalForm.Calendar.CalendarDate := CalDate;
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのTCalendarのOnChangeイベント処理
//  カレンダで選択中の日付をリアルタイムで取得する場合
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarChangeEvent(Sender: TObject);
var
  CalDate : TDate;
begin
  CalDate := CalForm.Calendar.CalendarDate;
  Edit1.Text := FormatDateTime('yyyy年 MM月 dd日', CalDate);
end;

end.

    function SetExceptRect(AControl: TWinControl; ARect: TRect): Boolean; overload;
    function SetExceptRect(AControl: TWinControl;
      ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls, Buttons, plCalendarFormUnit, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    CalForm : TplCalendarForm;
    procedure OnCalendarChangeEvent(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.SelStart   := 1;
  Edit1.AutoSelect := False;
  Edit1.Text := FormatDateTime('yyyy年 MM月 dd日', Now);
end;

//=============================================================================
//  ボタンをクリックしたらカレンダフォームを表示
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  APos    : TPoint;
  CalDate : TDate;
begin
  //カレンダフォームが生成されていなければ生成して、イベントも設定
  if not Assigned(CalForm) then begin
    CalForm := TplCalendarForm.Create(Self);
    CalForm.Calendar.OnChange := OnCalendarChangeEvent;
  end;

  if CalForm.Visible then begin
    CalForm.Close;
  end else begin
    //表示位置をスクリーン座標値に変換
    APos := Self.ClientToScreen(Point(Edit1.Left, Edit1.Top + Edit1.Height));
    CalForm.ShowPopUp(APos.X, APos.Y, Edit1.Height);
    //Edit1の値を日付に変換してカレンダフォームのカレンダにセット
    try
      CalDate := VarToDateTime(Edit1.Text);
    except
      CalDate := Trunc(Now);
    end;
    CalForm.Calendar.CalendarDate := CalDate;

    //非アクティブ検出を除外する矩形領域の設定
    //前回と位置が異なる場合があるかも知れないのでShowの後に実行
    //TSpeedButtonはTWinControlではないので、その親を第1引数に指定する
    CalForm.SetExceptRect(SpeedButton1.Parent, SpeedButton1.BoundsRect);
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのTCalendarのOnChangeイベント処理
//  カレンダで選択中の日付をリアルタイムで取得する場合
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarChangeEvent(Sender: TObject);
var
  CalDate : TDate;
begin
  CalDate := CalForm.Calendar.CalendarDate;
  Edit1.Text := FormatDateTime('yyyy年 MM月 dd日', CalDate);
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls, Buttons, plCalendarFormUnit, ExtCtrls, Mask;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    MaskEdit1: TMaskEdit;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    CalForm : TplCalendarForm;
    procedure OnCalendarChangeEvent(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  MaskEdit1.Text       := '';
  MaskEdit1.EditMask   := '!0000年00月00\日;1; ';
  MaskEdit1.SelStart   := 0;
  MaskEdit1.AutoSelect := False;
end;

//=============================================================================
//  ボタンをクリックしたらカレンダフォームを表示
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  APos     : TPoint;
  CalDate  : TDate;
begin
  //カレンダフォームが生成されていなければ生成して、イベントも設定
  if not Assigned(CalForm) then begin
    CalForm := TplCalendarForm.Create(Self);
    CalForm.Calendar.OnChange := OnCalendarChangeEvent;
  end;

  if CalForm.Visible then begin
    CalForm.Close;
  end else begin
    //表示位置をスクリーン座標値に変換
    APos := Self.ClientToScreen(Point(MaskEdit1.Left,
                                      MaskEdit1.Top + MaskEdit1.Height));
    CalForm.ShowPopUp(APos.X, APos.Y, MaskEdit1.Height);
    //MaskEdit1の値を日付に変換してカレンダフォームのカレンダにセット
    try
      CalDate := VarToDateTime(MaskEdit1.Text);
    except
      CalDate := Trunc(Now);
    end;
    CalForm.Calendar.CalendarDate := CalDate;

    //SpeedButton1の領域を、非アクティブ検出領域から除外
    //前回と位置が異なる場合があるかも知れないのでShowの後に実行
    //TSpeedButtonはTWinControlではないので、その親を第1引数に指定する
    CalForm.SetExceptRect(SpeedButton1.Parent, SpeedButton1.BoundsRect);
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのTCalendarのOnChangeイベント処理
//  カレンダで選択中の日付をリアルタイムで取得する場合
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarChangeEvent(Sender: TObject);
var
  CalDate : TDate;
begin
  CalDate := CalForm.Calendar.CalendarDate;
  MaskEdit1.Text := FormatDateTime('yyyy年 MM月 dd日', CalDate);
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Grids, StdCtrls, plDropStringGrid, plCalendarFormUnit;

type
  TplMyDropStringGrid = class(TplDropStringGrid)
  protected
    function CanEditShow: Boolean; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plDropGrid1 : TplMyDropStringGrid;
    CalForm : TplCalendarForm;
    procedure OnGetEditStyleEvent(TSender: TObject; ACol,
      ARow: Integer; var EditStyle: TEditStyle);
    procedure OnEditButtonClickEvent(Sender: TObject; ACol,
      ARow: Integer; ARect: TRect);
    procedure OnDropDownListEvent(Sender: TObject; ACol,
      ARow: Integer; ARect: TRect; var DefaultAction: Boolean);
    procedure OnEditMaskEvent(Sender: TObject; ACol, ARow: Integer;
      var Value: string);
    procedure OnCalendarChangeEvent(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  カレンダフォームを生成
//  テスト用に列数と列幅等を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //カレンダフォームを生成してイベントも設定
  if not Assigned(CalForm) then begin
    CalForm := TplCalendarForm.Create(Self);
    CalForm.Calendar.OnChange := OnCalendarChangeEvent;
  end;

  //フォームに配置したStringGrid1をplDropGrid(TplMyDropStringGrid)に置き換える
  plDropGrid1 := TplMyDropStringGrid(ChangeComponent(StringGrid1, TplMyDropStringGrid));


  //編集可能にしないとインプレイスエディタは起動しない
  plDropGrid1.Options := plDropGrid1.Options + [goEditing];

  plDropGrid1.DefaultDrawing := True;
  //編集可能にしないとインプレイスエディタは起動しない
  plDropGrid1.Options := plDropGrid1.Options + [goEditing];

  plDropGrid1.DefaultColWidth  := 130;
  plDropGrid1.DefaultRowHeight := 24;
  //左端の列幅設定
  plDropGrid1.ColWidths[0]  := 10;

  plDropGrid1.FixedCols := 1;
  plDropGrid1.FixedRows := 1;
  plDropGrid1.ColCount  := 3;
  plDropGrid1.RowCount  := 4;

  //テスト用の値をセット(固定行)
  plDropGrid1.Cells[1,0] := '開始年月日';
  plDropGrid1.Cells[2,0] := '終了年月日';

  //各種プロパティの設定(TplDropStringGridで追加したもの)
  plDropGrid1.InplaceButtonWidth := 18;
  plDropGrid1.DropListRowCount   := 10;
  plDropGrid1.DropListItemHeight := 17;
  plDropGrid1.DropListColor      := clWindow;

  //イベントの設定(標準のTStringGridにあるもの)
  plDropGrid1.OnGetEditMask := OnEditMaskEvent;

  //イベントの設定(TplDropStringGridで追加したもの)
  plDropGrid1.OnGetEditStyle     := OnGetEditStyleEvent;
  plDropGrid1.OnEditButtonClick  := OnEditButtonClickEvent;
  plDropGrid1.OnDropDownList     := OnDropDownListEvent;
end;

//-----------------------------------------------------------------------------
//  TplDropStringGridコンポのOnGetEditStyleイベント処理
//  列単位でボタンの種類を設定
//-----------------------------------------------------------------------------
procedure TForm1.OnGetEditStyleEvent(TSender: TObject; ACol,
  ARow: Integer; var EditStyle: TEditStyle);
begin
  if ACol = 1 then EditStyle := esPickList;
  if ACol = 2 then EditStyle := esEllipsis;
end;

//-----------------------------------------------------------------------------
//  TplDropStringGridコンポのOnDropDownListイベント処理
//  ドロップダウンのボタンをクリックした時のイベント
//-----------------------------------------------------------------------------
procedure TForm1.OnDropDownListEvent(Sender: TObject; ACol, ARow: Integer;
  ARect: TRect; var DefaultAction: Boolean);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (plDropGrid1.Col = 1) then begin
    //Falseにするとドロップダウンのリストを表示しない
    DefaultAction := False;

    if CalForm.Visible then begin
      CalForm.Close;
    end else begin
      CalForm.ShowPopUp(TplDropStringGrid(Sender),
                        ARect.Left, ARect.Bottom, ARect.Bottom - ARect.Top);

      //インプレイスエディタの値を取得してカレンダにセット
      InpEditor := TplMyDropStringGrid(plDropGrid1).InplaceEditor;
      if InpEditor <> nil then begin
        try
          CalDate := VarToDateTime(InpEditor.Text);
        except
          CalDate := Trunc(Now);
        end;
        CalForm.Calendar.CalendarDate := CalDate;
      end;
      //ドロップダウンボタンの領域を、非アクティブ検出領域から除外
      ARect.Left := ARect.Right - plDropGrid1.InplaceButtonWidth;
      CalForm.SetExceptRect(TplDropStringGrid(Sender), ARect);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  TplDropStringGridコンポのOnEditButtonClickイベント処理
//  参照ボタン(省略記号ボタン)をクリックした時の実行内容
//-----------------------------------------------------------------------------
procedure TForm1.OnEditButtonClickEvent(Sender: TObject; ACol,
  ARow: Integer; ARect: TRect);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (plDropGrid1.Col = 2) then begin
    if CalForm.Visible then begin
      CalForm.Close;
    end else begin
      CalForm.ShowPopUp(TplDropStringGrid(Sender),
                        ARect.Left, ARect.Bottom, ARect.Bottom - ARect.Top);

      //インプレイスエディタの値を取得してカレンダにセット
      InpEditor := TplMyDropStringGrid(plDropGrid1).InplaceEditor;
      if InpEditor <> nil then begin
        try
          CalDate := VarToDateTime(InpEditor.Text);
        except
          CalDate := Trunc(Now);
        end;
        CalForm.Calendar.CalendarDate := CalDate;
      end;
      //参照ボタンの領域を、非アクティブ検出領域から除外
      ARect.Left := ARect.Right - plDropGrid1.InplaceButtonWidth;
      CalForm.SetExceptRect(TplDropStringGrid(Sender), ARect);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのTCalendarのOnChangeイベント処理
//  カレンダで選択中の日付をリアルタイムで取得する場合
//  インプレイスエディタに値をセットする
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarChangeEvent(Sender: TObject);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (plDropGrid1.Col = 1) or (plDropGrid1.Col = 2) then begin
    InpEditor := TplMyDropStringGrid(plDropGrid1).InplaceEditor;
    if InpEditor <> nil then begin
      CalDate := CalForm.Calendar.CalendarDate;
      InpEditor.Text := FormatDateTime('yyyy年MM月dd日', CalDate);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  TStringGrid(TplDropStringGrid)のOnGetEditMaskイベント処理
//-----------------------------------------------------------------------------
procedure TForm1.OnEditMaskEvent(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  if (ACol = 1) or (ACol = 2) then begin
    Value := '!0000年00月00\日;1; ';
  end;
end;

{ TMyplDropStringGrid }

//-----------------------------------------------------------------------------
//  TplDropStringGridのCanEditShowメソッド処理
//  セルが編集モードになった時に自動的に実行される関数
//-----------------------------------------------------------------------------
function TplMyDropStringGrid.CanEditShow: Boolean;
begin
  Result := inherited CanEditShow;

  if InplaceEditor <> nil then begin
    //キャレットの位置をセルのテキストの最後尾にする
    //セルのテキストの長さではなく、インプレイスエディットのテキストの長さ
    InplaceEditor.SelStart := Length(InplaceEditor.Text);

    //セルの背景色
    if Col = 1 then begin
      InplaceEditor.Brush.Color := $00D0FDDA;
    end else begin
      InplaceEditor.Brush.Color := clWindow;
    end;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Grids, StdCtrls, plDropStringGrid, plCalendarFormUnit;

type
  TplMyDropStringGrid = class(TplDropStringGrid)
  protected
    function CanEditShow: Boolean; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plDropGrid1 : TplMyDropStringGrid;
    CalForm : TplCalendarForm;
    procedure OnGetEditStyleEvent(TSender: TObject; ACol,
      ARow: Integer; var EditStyle: TEditStyle);
    procedure OnEditButtonClickEvent(Sender: TObject; ACol,
      ARow: Integer; ARect: TRect);
    procedure OnDropDownListEvent(Sender: TObject; ACol,
      ARow: Integer; ARect: TRect; var DefaultAction: Boolean);
    procedure OnEditMaskEvent(Sender: TObject; ACol, ARow: Integer;
      var Value: string);
    procedure OnCalendarFormCloseEvent(Sender: TObject; var Action: TCloseAction);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  カレンダフォームを生成
//  テスト用に列数と列幅等を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //カレンダフォームを生成してイベントも設定
  if not Assigned(CalForm) then begin
    CalForm := TplCalendarForm.Create(Self);
    CalForm.OnClose := OnCalendarFormCloseEvent;
  end;

  //フォームに配置したStringGrid1をplDropGrid(TplMyDropStringGrid)に置き換える
  plDropGrid1 := TplMyDropStringGrid(ChangeComponent(StringGrid1, TplMyDropStringGrid));


  //編集可能にしないとインプレイスエディタは起動しない
  plDropGrid1.Options := plDropGrid1.Options + [goEditing];

  plDropGrid1.DefaultDrawing := True;
  //編集可能にしないとインプレイスエディタは起動しない
  plDropGrid1.Options := plDropGrid1.Options + [goEditing];

  plDropGrid1.DefaultColWidth  := 130;
  plDropGrid1.DefaultRowHeight := 24;
  //左端の列幅設定
  plDropGrid1.ColWidths[0]  := 10;

  plDropGrid1.FixedCols := 1;
  plDropGrid1.FixedRows := 1;
  plDropGrid1.ColCount  := 3;
  plDropGrid1.RowCount  := 4;

  //テスト用の値をセット(固定行)
  plDropGrid1.Cells[1,0] := '開始年月日';
  plDropGrid1.Cells[2,0] := '終了年月日';

  //各種プロパティの設定(TplDropStringGridで追加したもの)
  plDropGrid1.InplaceButtonWidth := 18;
  plDropGrid1.DropListRowCount   := 10;
  plDropGrid1.DropListItemHeight := 17;
  plDropGrid1.DropListColor      := clWindow;

  //イベントの設定(標準のTStringGridにあるもの)
  plDropGrid1.OnGetEditMask := OnEditMaskEvent;

  //イベントの設定(TplDropStringGridで追加したもの)
  plDropGrid1.OnGetEditStyle     := OnGetEditStyleEvent;
  plDropGrid1.OnEditButtonClick  := OnEditButtonClickEvent;
  plDropGrid1.OnDropDownList     := OnDropDownListEvent;
end;

//-----------------------------------------------------------------------------
//  TplDropStringGridコンポのOnGetEditStyleイベント処理
//  列単位でボタンの種類を設定
//-----------------------------------------------------------------------------
procedure TForm1.OnGetEditStyleEvent(TSender: TObject; ACol,
  ARow: Integer; var EditStyle: TEditStyle);
begin
  if ACol = 1 then EditStyle := esPickList;
  if ACol = 2 then EditStyle := esEllipsis;
end;

//-----------------------------------------------------------------------------
//  TplDropStringGridコンポのOnDropDownListイベント処理
//  ドロップダウンのボタンをクリックした時のイベント
//-----------------------------------------------------------------------------
procedure TForm1.OnDropDownListEvent(Sender: TObject; ACol, ARow: Integer;
  ARect: TRect; var DefaultAction: Boolean);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (ACol = 1) then begin
    //Falseにするとドロップダウンのリストを表示しない
    DefaultAction := False;

    if CalForm.Visible then begin
      CalForm.Close;
    end else begin
      CalForm.ShowPopUp(TplDropStringGrid(Sender),
                        ARect.Left, ARect.Bottom, ARect.Bottom - ARect.Top);

      //インプレイスエディタの値を取得してカレンダにセット
      InpEditor := TplMyDropStringGrid(plDropGrid1).InplaceEditor;
      if InpEditor <> nil then begin
        try
          CalDate := VarToDateTime(InpEditor.Text);
        except
          CalDate := Trunc(Now);
        end;
        CalForm.Calendar.CalendarDate := CalDate;
      end;
      //ドロップダウンボタンの領域を、非アクティブ検出領域から除外
      ARect.Left := ARect.Right - plDropGrid1.InplaceButtonWidth;
      CalForm.SetExceptRect(TplDropStringGrid(Sender), ARect);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  TplDropStringGridコンポのOnEditButtonClickイベント処理
//  参照ボタン(省略記号ボタン)をクリックした時の実行内容
//-----------------------------------------------------------------------------
procedure TForm1.OnEditButtonClickEvent(Sender: TObject; ACol,
  ARow: Integer; ARect: TRect);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (ACol = 2) then begin
    if CalForm.Visible then begin
      CalForm.Close;
    end else begin
      CalForm.ShowPopUp(TplDropStringGrid(Sender),
                        ARect.Left, ARect.Bottom, ARect.Bottom - ARect.Top);

      //インプレイスエディタの値を取得してカレンダにセット
      InpEditor := TplMyDropStringGrid(plDropGrid1).InplaceEditor;
      if InpEditor <> nil then begin
        try
          CalDate := VarToDateTime(InpEditor.Text);
        except
          CalDate := Trunc(Now);
        end;
        CalForm.Calendar.CalendarDate := CalDate;
      end;
      //参照ボタンの領域を、非アクティブ検出領域から除外
      ARect.Left := ARect.Right - plDropGrid1.InplaceButtonWidth;
      CalForm.SetExceptRect(TplDropStringGrid(Sender), ARect);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのOnCloseイベント処理
//  日付の文字列は、セルではなくインプレイスエディタにセットする
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarFormCloseEvent(Sender: TObject;
  var Action: TCloseAction);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (plDropGrid1.Col = 1) or (plDropGrid1.Col = 2) then begin
    InpEditor := TplMyDropStringGrid(plDropGrid1).InplaceEditor;
    if InpEditor <> nil then begin
      //クリックまたは[Enter]で終了した場合のみ処理
      if CalForm.KindOfClose = VK_RETURN then begin
        CalDate := CalForm.Calendar.CalendarDate;
        InpEditor.Text := FormatDateTime('yyyy年MM月dd日', CalDate);
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  TStringGrid(TplDropStringGrid)のOnGetEditMaskイベント処理
//-----------------------------------------------------------------------------
procedure TForm1.OnEditMaskEvent(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  if (ACol = 1) or (ACol = 2) then begin
    Value := '!0000年00月00\日;1; ';
  end;
end;

{ TMyplDropStringGrid }

//-----------------------------------------------------------------------------
//  TplDropStringGridのCanEditShowメソッド処理
//  セルが編集モードになった時に自動的に実行される関数
//-----------------------------------------------------------------------------
function TplMyDropStringGrid.CanEditShow: Boolean;
begin
  Result := inherited CanEditShow;

  if InplaceEditor <> nil then begin
    //キャレットの位置をセルのテキストの最後尾にする
    //セルのテキストの長さではなく、インプレイスエディットのテキストの長さ
    InplaceEditor.SelStart := Length(InplaceEditor.Text);

    //セルの背景色
    if Col = 1 then begin
      InplaceEditor.Brush.Color := $00D0FDDA;
    end else begin
      InplaceEditor.Brush.Color := clWindow;
    end;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Grids, ValEdit, ExtCtrls, plCalendarFormUnit,
  AppEvnts;

type
  TplValueListEditor = class(TValueListEditor)
  protected
    function CanEditShow: Boolean; override;
  end;

  TForm1 = class(TForm)
    ValueListEditor1: TValueListEditor;
    Panel1: TPanel;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ValueListEditor1EditButtonClick(Sender: TObject);
    procedure ValueListEditor1GetPickList(Sender: TObject;
      const KeyName: string; Values: TStrings);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
    plValueListEditor1: TValueListEditor;
    CalForm : TplCalendarForm;
    procedure OnCalendarFormCloseEvent(Sender: TObject; var Action: TCloseAction);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  カレンダフォームを生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  //カレンダフォームを生成してイベントも設定
  if not Assigned(CalForm) then begin
    CalForm := TplCalendarForm.Create(Self);
    CalForm.OnClose := OnCalendarFormCloseEvent;
  end;

  //フォームに配置したValueListEditor1をplValueListEditor1に置き換える
  plValueListEditor1 := TplValueListEditor(ChangeComponent
                                           (ValueListEditor1, TplValueListEditor));

  //値を全てクリア
  plValueListEditor1.Strings.Clear;

  //キー例の幅
  plValueListEditor1.ColWidths[0] := 90;

  //各列のタイトル文字を設定
  plValueListEditor1.TitleCaptions.Text := '';

  //行を追加してキー項目を設定
  plValueListEditor1.InsertRow('開始年月日', '', True);
  plValueListEditor1.InsertRow('終了年月日', '', True);
  plValueListEditor1.InsertRow('備      考', '', True);


  //最初の行の入力はドロップダウン用のボタンを表示する
  plValueListEditor1.ItemProps[0].EditStyle := esPickList;
  plValueListEditor1.ItemProps[0].EditMask  := '!0000年00月00\日;1; ';;
  //2番名の行の編集時は参照ボタンを表示する
  plValueListEditor1.ItemProps[1].EditStyle := esEllipsis;
  plValueListEditor1.ItemProps[1].EditMask  := '!0000年00月00\日;1; ';;

  //行の高さは全て同じにする(0はタイトル行)
  //DefaultRowHeightプロパティでも設定できる
  for i := 0 to plValueListEditor1.RowCount - 1 do begin
    plValueListEditor1.RowHeights[i] := 20;
  end;

  //最初は2行目にフォーカスを移動
  plValueListEditor1.Row := 2;
end;

//=============================================================================
//  TApplicationEventsコンポのOnMessageメッセージ処理
//
//  デフォルトのドロップダウンのリストを表示しない場合、TValueListEditorは、
//  ドロップダウンボタンをクリックすると、フォーカスがTValueListEditorに移動し
//  てしまう
//  そこで、TApplicationEvents.OnMessageでカレンダフォームを検出して、カレンダ
//  フォームにフォーカスがなかったらフォーカスを移動する
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if Assigned(CalForm)  then begin
    if (Msg.hwnd = CalForm.Handle) and (CalForm.Visible) then begin
      if GetForegroundWindow <> CalForm.Calendar.Handle then begin
        CalForm.Calendar.SetFocus;
      end;
    end;
  end;
end;

//=============================================================================
//  TValueListEditorのOnGetPickListイベント処理
//  矢印のボタンをクリックすると発生する
//=============================================================================
procedure TForm1.ValueListEditor1GetPickList(Sender: TObject;
  const KeyName: string; Values: TStrings);
var
  VLEditor  : TValueListEditor;
  InpEditor : TInplaceEdit;
  ACol      : Integer;
  ARow      : Integer;
  ARect     : TRect;
  CalDate   : TDate;
begin
  if KeyName = '開始年月日' then begin
    VLEditor := TValueListEditor(Sender);
    ACol     := VLEditor.Col;
    ARow     := VLEditor.Row;

    if CalForm.Visible then begin
      //ドロップダウンボタンをクリックするとフォーカスがTValueListEditorに移動する
      //そのため、カレンダフォームにフォーカス移動してキー操作で閉じる
      CalForm.Calendar.SetFocus;
      PostMessage(CalForm.Calendar.Handle, WM_KEYDOWN, VK_ESCAPE, $00010001);
      PostMessage(CalForm.Calendar.Handle, WM_KEYUP,   VK_ESCAPE, $C0010001);
    end else begin
      ARect := VLEditor.CellRect(ACol, ARow);
      CalForm.ShowPopUp(VLEditor, ARect.Left, ARect.Bottom, ARect.Bottom - ARect.Top);

      //インプレイスエディタの値を取得してカレンダにセット
      InpEditor := TplValueListEditor(VLEditor).InplaceEditor;
      if InpEditor <> nil then begin
        try
          CalDate := VarToDateTime(InpEditor.Text);
        except
          CalDate := Trunc(Now);
        end;
        CalForm.Calendar.CalendarDate := CalDate;
      end;
      //ドロップダウンボタンの領域を、非アクティブ検出領域から除外
      ARect.Left := ARect.Right -17;
      CalForm.SetExceptRect(VLEditor, ARect);
    end;
  end;
end;

//=============================================================================
//  TValueListEditorのOnEditButtonClickイベント処理
//  参照[...]ボタンをクリックすると発生する
//=============================================================================
procedure TForm1.ValueListEditor1EditButtonClick(Sender: TObject);
var
  VLEditor : TValueListEditor;
  InpEditor : TInplaceEdit;
  ACol      : Integer;

  ARow      : Integer;
  ARect     : TRect;
  CalDate   : TDate;
begin
  VLEditor := TplValueListEditor(Sender);
  ACol     := VLEditor.Col;
  ARow     := VLEditor.Row;

  if ARow = 2 then begin
    if CalForm.Visible then begin
      CalForm.Close;
    end else begin
      ARect := VLEditor.CellRect(ACol, ARow);
      CalForm.ShowPopUp(VLEditor, ARect.Left, ARect.Bottom, ARect.Bottom - ARect.Top);

      //インプレイスエディタの値を取得してカレンダにセット
      InpEditor := TplValueListEditor(VLEditor).InplaceEditor;
      if InpEditor <> nil then begin
        try
          CalDate := VarToDateTime(InpEditor.Text);
        except
          CalDate := Trunc(Now);
        end;
        CalForm.Calendar.CalendarDate := CalDate;
      end;
      //参照ボタンの領域を、非アクティブ検出領域から除外
      ARect.Left := ARect.Right -17;
      CalForm.SetExceptRect(VLEditor, ARect);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのOnCloseイベント処理
//  日付の文字列は、セルではなくインプレイスエディタにセットする
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarFormCloseEvent(Sender: TObject;
  var Action: TCloseAction);
var
  InpEditor : TInplaceEdit;
  CalDate   : TDate;
begin
  if (plValueListEditor1.Col = 1) or (plValueListEditor1.Col = 2) then begin
    InpEditor := TplValueListEditor(plValueListEditor1).InplaceEditor;
    if InpEditor <> nil then begin
      //クリックまたは[Enter]で終了した場合のみ処理
      if CalForm.KindOfClose = VK_RETURN then begin
        CalDate := CalForm.Calendar.CalendarDate;
        InpEditor.Text := FormatDateTime('yyyy年MM月dd日', CalDate);
      end;
    end;
  end;
end;

{ TplValueListEditor }

//-----------------------------------------------------------------------------
//  TMyValueListEditorのCanEditShowメソッド処理
//  セルが編集モードになった時に自動的に実行される関数
//-----------------------------------------------------------------------------
function TplValueListEditor.CanEditShow: Boolean;
begin
  Result := inherited CanEditShow;

  if InplaceEditor <> nil then begin
    //キャレットの位置をセルのテキストの最後尾にする
    //セルのテキストの長さではなく、インプレイスエディットのテキストの長さ
    InplaceEditor.SelStart := Length(InplaceEditor.Text);

    //セルの背景色
    InplaceEditor.Brush.Color := $00FFF4D2;
  end;
end;

end.

unit plCalendarFormUnit;

interface

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

type
  TplCalendarForm = class;

  TplCalendarFormCalendar = class(TCalendar)
  private
    FCalForm      : TplCalendarForm;
    FCanClose     : Boolean;
  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;
  end;

  TplCalendarForm = class(TForm)
    Panel: TPanel;
    btnPrevYear: TSpeedButton;
    btnPrevMonth: TSpeedButton;
    btnToday: TSpeedButton;
    btnNextMonth: TSpeedButton;
    btnNextYear: TSpeedButton;
    Calendar: TCalendar;
    procedure btnMoveYearMonthClick(Sender: TObject);
  private
    { Private 宣言 }
    FplCalendar      : TplCalendarFormCalendar;
    FhActivePrevForm : HWND;
    FExceptRect      : TRect;
    FKindOfClose     : Integer;
    FPanelFormatDate : String;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMShowingchanged(var Message: TMessage);
      message CM_SHOWINGCHANGED;
    procedure WMActivateApp(var Message: TWMActivateApp);
      message WM_ACTIVATEAPP;
    procedure DoShow; override;
    procedure DoCreate; override;
    procedure Deactivate; override;
    procedure CMActivate(var Message: TCMActivate); message CM_ACTIVATE;
  public
    { Public 宣言 }
    procedure ShowPopUp(ALeft, ATop: Integer; AHeight: Integer=0); overload;
    procedure ShowPopUp(AControl: TWinControl; ALeft, ATop: Integer;
      AHeight: Integer=0); overload;
    function SetExceptRect(AControl: TWinControl; ARect: TRect): Boolean; overload;
    function SetExceptRect(AControl: TWinControl;
      ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;
    property KindOfClose  : Integer read FKindOfClose;
    property PanelFormatDate : String read FPanelFormatDate write FPanelFormatDate;
  end;

var
  plCalendarForm: TplCalendarForm;

implementation

uses plChgCompo, plDateEditIsHoliday;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TCalendarのオブジェクトを生成して、ボタン類などの位置を調整
//=============================================================================
procedure TplCalendarForm.DoCreate;
var
  btnTop    : Integer;
  btnMargin : Integer;
  btnSpace  : Integer;
begin
  inherited;

  //フォーム作成時にコンポーネントの入れ替え
  //FplCalendarはTplCalendarFormCalendarクラスのオブジェクトであるが、
  //外部からはTplCalendarForm.Calendarでアクセス可能となる
  FplCalendar := TplCalendarFormCalendar(ChangeComponent(Calendar,
                                         TplCalendarFormCalendar));

  Self.Color := FplCalendar.Color;

  btnMargin := 3;
  btnSpace          := 2;
  btnTop            := Panel.Height + FplCalendar.Height + 6;

  with FplCalendar do begin
    Align       := alNone;
    FCalForm    := Self;
    FCanClose   := True;
    SetBounds(-1, Panel.Height, Self.ClientWidth + 2, FplCalendar.Height);
  end;

  //ボタンの位置を調整
  btnPrevYear.SetBounds  (btnMargin, btnTop,
                          btnPrevYear.Width, btnPrevYear.Height);
  btnPrevMonth.SetBounds (btnPrevYear.Left + btnPrevYear.Width + btnSpace, btnTop,
                          btnPrevMonth.Width, btnPrevMonth.Height);
  btnNextYear.SetBounds  (ClientWidth - btnMargin - btnNextYear.Width, btnTop,
                          btnNextYear.Width, btnNextYear.Height);
  btnNextMonth.SetBounds (btnNextYear.Left - btnSpace - btnNextMonth.Width, btnTop,
                          btnNextMonth.Width, btnNextMonth.Height);
  btnToday.SetBounds     ((ClientWidth - btnToday.Width) div 2 + 1, btnTop,
                          btnToday.Width, btnToday.Height);

  SetRectEmpty(FExceptRect);

  FPanelFormatDate := 'yyyy年 M月';
  Panel.Caption := FormatDateTime(PanelFormatDate, FplCalendar.CalendarDate);
end;

//=============================================================================
//  このフォームのウインドウスタイルの設定
//  好みに応じて変更する
//=============================================================================
procedure TplCalendarForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  FhActivePrevForm := Application.ActiveFormHandle;

  //このフォームはキャプションバーなしとしてWS_THICKFRAMEも除外
  Params.Style := WS_POPUP or WS_BORDER;
  //このフォームは最前面表示とする
  //これがなくても動作に支障はない
  //なぜなら、このフォーム以外がアクティブになったら閉じてしまうので
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
  //影付きとする
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

//=============================================================================
//  フォームを表示する時の処理
//=============================================================================
procedure TplCalendarForm.DoShow;
begin
  inherited;
  //直前にアクティブだったフォームのハンドルを取得
  FhActivePrevForm := Application.ActiveFormHandle;
end;

//=============================================================================
//  このフォームを表示したフォームを疑似的にアクティブにする
//=============================================================================
procedure TplCalendarForm.CMActivate(var Message: TCMActivate);
begin
  inherited;
  FplCalendar.SetFocus;
  if FhActivePrevForm <> 0 then begin
    PostMessage(FhActivePrevForm, WM_NCACTIVATE, 1, 0);
  end;
end;

//=============================================================================
//  引数を指定した表示メソッド
//  ALeft,ATop(スクリーン座標)の位置から表示する
//  AHeightを指定すると、画面下端で表示する際に、その分だけ上から表示する
//=============================================================================
procedure TplCalendarForm.ShowPopUp(ALeft, ATop: Integer; AHeight: Integer=0);
var
  ABottom : Integer;
  ARight  : Integer;
  CtrlPos : TPoint;
  Monitor : TMonitor;
begin
  CtrlPos := Point(ALeft, ATop);
  //表示位置の調整
  ARight  := CtrlPos.X + Self.Width;
  ABottom := CtrlPos.Y + Self.Height;

  Monitor := Screen.MonitorFromPoint(CtrlPos);
  if Monitor.WorkareaRect.Bottom < ABottom then begin
    CtrlPos.Y := CtrlPos.Y - AHeight - Self.Height;
  end;
  if Monitor.WorkareaRect.Left > CtrlPos.X then begin
    CtrlPos.X := Monitor.WorkareaRect.Left;
  end else
  if Monitor.WorkareaRect.Right < ARight then begin
    CtrlPos.X := Monitor.WorkareaRect.Right - Self.Width;
  end;

  SetBounds(CtrlPos.x, CtrlPos.y, Self.Width, Self.Height);
  //Showメソッドを実行
  Show;
end;

//=============================================================================
//  引数を指定した表示メソッド
//  ALeft,ATop(クライアント座標)の位置から表示する
//  スクリーン座標への変換はAControlを基に計算する
//  AHeightを指定すると、画面下端で表示する際に、その分だけ上から表示する
//=============================================================================
procedure TplCalendarForm.ShowPopUp(AControl: TWinControl; ALeft, ATop: Integer;
  AHeight: Integer=0);
var
  APos : TPoint;
begin
  if TWinControl(AControl) <> nil then begin
    APos := TWinControl(AControl).ClientToScreen(Point(ALeft,  ATop));
    ShowPopUp(APos.X, APos.Y, AHeight);
  end;
end;

//=============================================================================
//  CM_SHOWINGCHANGEDメッセージ処理
//  フォームが表示されたらTCalendarにフォーカス移動
//=============================================================================
procedure TplCalendarForm.CMShowingchanged(var Message: TMessage);
begin
  inherited;
  if Visible then begin
    FplCalendar.SetFocus;
  end;
end;

//=============================================================================
//  非アクティブになったら閉じる
//  ただし、現在のマウスカーソルがFExceptRectの範囲内だったら閉じない
//  外部のボタンクリックイベントで処理する
//
//  これはボタン操作で、トグル動作を実現するためのもの
//  単にトグル仕様のボタンを使用しても、このカレンダフォームでは無理がある
//  マウス操作以外でボタン類を操作されてしまった場合は機能しない
//=============================================================================
procedure TplCalendarForm.Deactivate;
var
  CurPos : TPoint;
begin
  inherited;

  FKindOfClose := VK_ESCAPE;
  GetCursorPos(CurPos);
  if not IsRectEmpty(FExceptRect) then begin
    if not PtInRect(FExceptRect, CurPos) then begin
      Close;
    end;
  end else begin
    Close;
  end;
end;

//=============================================================================
//  他のアプリがアクティブになったら閉じる
//  このフォームを表示したフォームも非アクティブにする
//  添付のサンプルに、メインフォームにカレンダフォームを配置するサンプルがある
//  その時は機能しない
//=============================================================================
procedure TplCalendarForm.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;

  FKindOfClose := VK_ESCAPE;
  if Visible then begin
    if FhActivePrevForm <> 0 then begin
      PostMessage(FhActivePrevForm, WM_NCACTIVATE, Ord(Message.Active), 0);
    end;
    Close;
  end;
end;

//=============================================================================
//  引数のTWinControlを基準にしたスクリーン座標における矩形領域を計算
//  非アクティブになった時の除外領域の設定用
//  TSpeedButton等はTWinControlではないので、その親をAControlに指定する
//=============================================================================
function TplCalendarForm.SetExceptRect(AControl: TWinControl; ALeft, ATop,
  ARight, ABottom: Integer): Boolean;
var
  PointTL : TPoint;
  PointBR : TPoint;
begin
  Result := True;
  if TWinControl(AControl) = nil then begin
    Result := False;
  end else begin
    PointTL := TWinControl(AControl).ClientToScreen(Point(ALeft,  ATop));
    PointBR := TWinControl(AControl).ClientToScreen(Point(ARight, ABottom));
    SetRect(FExceptRect, PointTL.X, PointTL.Y, PointBR.X, PointBR.Y);
  end;
end;

//=============================================================================
//  引数のTWinControlを基準にしたスクリーン座標における矩形領域を計算
//  非アクティブになった時の除外領域の設定用
//  TSpeedButton等はTWinControlではないので、その親をAControlに指定する
//=============================================================================
function TplCalendarForm.SetExceptRect(AControl: TWinControl;
  ARect: TRect): Boolean;
var
  PointTL : TPoint;
  PointBR : TPoint;
begin
  Result := True;
  if TWinControl(AControl) = nil then begin
    Result := False;
  end else begin
    PointTL := TWinControl(AControl).ClientToScreen(ARect.TopLeft);
    PointBR := TWinControl(AControl).ClientToScreen(ARect.BottomRight);
    SetRect(FExceptRect, PointTL.X, PointTL.Y, PointBR.X, PointBR.Y);
  end;
end;

//=============================================================================
//  [前年][前月][今日][翌月][翌年]ボタンのクリック
//=============================================================================
procedure TplCalendarForm.btnMoveYearMonthClick(Sender: TObject);
begin
  if Sender = btnPrevYear  then FplCalendar.PrevYear;
  if Sender = btnPrevMonth then FplCalendar.PrevMonth;
  if Sender = btnToday     then FplCalendar.CalendarDate := Now;
  if Sender = btnNextMonth then FplCalendar.NextMonth;
  if Sender = btnNextYear  then FplCalendar.NextYear;
end;

{ TplCalendarFormCalendar }

//-----------------------------------------------------------------------------
//  TCalendarのChange処理
//-----------------------------------------------------------------------------
procedure TplCalendarFormCalendar.Change;
begin
  FCanClose := True;
  inherited Change;
  //本カレンダフォームの上部のTPanelに表示する文字列
  FCalForm.Panel.Caption := FormatDateTime(FCalForm.PanelFormatDate, CalendarDate);
end;

//-----------------------------------------------------------------------------
//  TCalendarのClick処理
//-----------------------------------------------------------------------------
procedure TplCalendarFormCalendar.Click;
begin
  FCalForm.FKindOfClose := VK_RETURN;
  if FCanClose then begin
    Day := StrToInt(CellText[Col, Row]);
    FCalForm.Close;
  end;
  inherited Click;
end;

//-----------------------------------------------------------------------------
//  TCalendarのKeyDown処理
//  カーソル移動キーでもClickが発生するので、閉じないようにする
//  この閉じないようにする判定にFCanCloseを使用している
//
//  キー操作を追加、変更する場合は、このコードを編集する
//-----------------------------------------------------------------------------
procedure TplCalendarFormCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    FCalForm.FKindOfClose := VK_RETURN;
    FCalForm.Close;
  end else
  if Key = VK_ESCAPE then begin
    FCalForm.FKindOfClose := VK_ESCAPE;
    FCalForm.Close;
  end else begin
    if Key in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then begin
      FCanClose := False;
    end else begin
      FCanClose := True;
    end;
  end;

  inherited KeyDown(Key, Shift);
end;

//-----------------------------------------------------------------------------
//  フォームに表示しているTCalendarのDrawCellメソッド
//  ここで日付の文字をTCalendarに描画している
//  日曜日と国民の祝日を赤文字に、土曜日を青色にする
//
//  カスタム描画が必要な場合は、このコードを編集する
//-----------------------------------------------------------------------------
procedure TplCalendarFormCalendar.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  TheText   : string;
  ADate     : TDate;
  iDay      : Word;
  StrText   : string;
  SundayCol : Byte;
begin
  if StartOfWeek = 0 then begin
    SundayCol := 0;
  end else begin
    SundayCol := 7 - StartOfWeek;
  end;
  if (ACol = SundayCol) then Canvas.Font.Color := clRed;
  if (ACol = (6 - StartOfWeek)) 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;

  //TCalendarの元の描画コードを実行i
  inherited DrawCell(ACol, ARow, ARect, AState);
end;

end.

procedure TForm1.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Visible then begin
    if Message.Active = False then begin
      PostMessage(Handle, WM_NCACTIVATE, Ord(Message.Active), 0);
    end;
  end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls, Buttons, ExtCtrls, plCalendarFormUnit;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    CalForm : TplCalendarForm;
    procedure OnCalendarChangeEvent(Sender: TObject);
  protected
    procedure CMShowingchanged(var Message: TMessage);
      message CM_SHOWINGCHANGED;
    procedure WMActivateApp(var Message: TWMActivateApp);
      message WM_ACTIVATEAPP;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.SelStart   := 1;
  Edit1.AutoSelect := False;
  Edit1.Text := FormatDateTime('yyyy年 MM月 dd日', Now);
end;

//=============================================================================
//  フォーム表示終了時のメッセージ処理
//=============================================================================
procedure TForm1.CMShowingchanged(var Message: TMessage);
var
  CalDate : TDate;
begin
  inherited;

  if Visible then begin
    //カレンダフォームが生成されいなければ生成して、イベントも設定
    if not Assigned(CalForm) then begin
      CalForm := TplCalendarForm.Create(Self);
      CalForm.Calendar.OnChange := OnCalendarChangeEvent;
    end;

    //位置を設定して表示
    CalForm.Top  := Edit1.Top + Edit1.Height + 5;
    CalForm.Left := Edit1.Left;
    CalForm.Show;
    //親ウィンドウを変更
    //Showの後で設定しないと不定
    Windows.SetParent(CalForm.Handle, Handle);

    try
      CalDate := VarToDateTime(Edit1.Text);
    except
      CalDate := Trunc(Now);
    end;
    CalForm.Calendar.CalendarDate := CalDate;
  end;
end;

//-----------------------------------------------------------------------------
//  カレンダフォームのTCalendarのOnChangeイベント処理
//  カレンダで選択中の日付をリアルタイムで取得する
//-----------------------------------------------------------------------------
procedure TForm1.OnCalendarChangeEvent(Sender: TObject);
var
  CalDate : TDate;
begin
  CalDate := CalForm.Calendar.CalendarDate;
  Edit1.Text := FormatDateTime('yyyy年 MM月 dd日', CalDate);
end;

//-----------------------------------------------------------------------------
//  WM_ACTIVATEAPPメッセージ処理
//  キャプションバー(タイトルバー)のアクティブ・非アクティブ状態を制御
//-----------------------------------------------------------------------------
procedure TForm1.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Visible then begin
    if Message.Active = False then begin
      PostMessage(Handle, WM_NCACTIVATE, Ord(Message.Active), 0);
    end;
  end;
end;

end.

procedure TForm2.Button1Click(Sender: TObject);
begin
  Form3.SetBounds(30, 40, 220, 150);
  Form3.Show;
  //親を設定
  Windows.SetParent(Form3.Handle, Form2.Handle);
  //以下のように親を設定すると、Form3をアクティブにできなくなる
  //Form3.Parent := Self;
end;