spopupclndr.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sPopupClndr;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sMonthCalendar, comctrls, sConst, sPanel, acntUtils
  {$IFDEF DELPHI6UP}, Variants{$ENDIF}, sCustomComboEdit, sSkinProvider,
  Menus;

const
  FormHeight = 144;

type
  TsPopupCalendar = class(TForm)
    sMonthCalendar1: TsMonthCalendar;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    OK1: TMenuItem;
    Cancel1: TMenuItem;
    procedure sToolButton3Click(Sender: TObject);
    procedure sToolButton1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sMonthCalendar1DblClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  protected
    FCloseUp: TCloseUpEvent;
    procedure KeyPress(var Key: Char); override;
    function GetValue: Variant;
    procedure SetValue(const Value: Variant);
    procedure CloseUp(Accept: Boolean); virtual;
    procedure WMEraseBkGnd (var Message: TMessage); message WM_ERASEBKGND;
  public
    FFourDigitYear: Boolean;
    FEditor: TsCustomComboEdit;
    property FCalendar: TsMonthCalendar read sMonthCalendar1 write sMonthCalendar1;
    property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
  end;

var
  sPopupCalendar: TsPopupCalendar;

implementation

{$R *.dfm}

uses sToolEdit, sStyleSimply, sSkinManager;

{ TsPopupCalendar }

function TsPopupCalendar.GetValue: Variant;
begin
  if (csDesigning in ComponentState) then
    Result := VarFromDateTime(SysUtils.Date)
  else
    Result := VarFromDateTime(FCalendar.CalendarDate);
end;

procedure TsPopupCalendar.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (FCalendar <> nil) and (Key <> #0) then FCalendar.FGrid.KeyPress(Key);
end;

procedure TsPopupCalendar.SetValue(const Value: Variant);
begin
  if not (csDesigning in ComponentState) then begin
    try
      if (Trim(ReplaceStr(VarToStr(Value), DateSeparator, '')) = '') or
        VarIsNull(Value) or VarIsEmpty(Value) then
        FCalendar.CalendarDate := VarToDateTime(SysUtils.Date)
      else FCalendar.CalendarDate := VarToDateTime(Value);
    except
      FCalendar.CalendarDate := VarToDateTime(SysUtils.Date);
    end;
  end;
end;

procedure TsPopupCalendar.sToolButton3Click(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TsPopupCalendar.sToolButton1Click(Sender: TObject);
begin
  Close;
end;

procedure TsPopupCalendar.CloseUp(Accept: Boolean);
begin
  if Assigned(FCloseUp) then FCloseUp(Self, Accept);
end;

procedure TsPopupCalendar.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  CanAccept : boolean;
  d : TDateTime;
begin
  inherited;
  case Key of
    VK_RETURN: begin
      if FEditor <> nil then begin
        d := sMonthCalendar1.CalendarDate;
        CanAccept := True;
        if Assigned(TsDateEdit(FEditor).OnAcceptDate) then TsDateEdit(FEditor).OnAcceptDate(FEditor, d, CanAccept);
        if CanAccept then begin
          TsCustomDateEdit(FEditor).Date := d;
          if Assigned(TsCustomDateEdit(FEditor).OnChange) then TsCustomDateEdit(FEditor).OnChange(TsCustomDateEdit(FEditor));
        end;
        FEditor.SetFocus;
        if FEditor.AutoSelect then FEditor.SelectAll;
      end;
      Close;
    end;
    VK_ESCAPE: begin
      FEditor.SetFocus;
      Close;
    end;
  end;
end;

procedure TsPopupCalendar.FormShow(Sender: TObject);
begin
  sMonthCalendar1.FDragBar.Cursor := crDefault;
  Height := FormHeight;
  if (DefaultManager <> nil) and DefaultManager.Active then Color := DefaultManager.GetGlobalColor else Color := clBtnFace;
  if Assigned(FEditor) then
    sMonthCalendar1.ShowCurrentDate := TsDateEdit(FEditor).ShowCurrentDate; 
end;

procedure TsPopupCalendar.FormCreate(Sender: TObject);
begin
  sMonthCalendar1.FGrid.OnDblClick := sMonthCalendar1DblClick;
end;

procedure TsPopupCalendar.sMonthCalendar1DblClick(Sender: TObject);
var
  CanAccept : boolean;
  d : TDateTime;
begin
  if FEditor <> nil then begin
    d := sMonthCalendar1.CalendarDate;
    CanAccept := True;
    if Assigned(TsDateEdit(FEditor).OnAcceptDate) then TsDateEdit(FEditor).OnAcceptDate(FEditor, d, CanAccept);
    if CanAccept then begin
      TsCustomDateEdit(FEditor).Date := d;
      if Assigned(TsCustomDateEdit(FEditor).OnChange) then TsCustomDateEdit(FEditor).OnChange(TsCustomDateEdit(FEditor));
    end;
    FEditor.SetFocus;
    if FEditor.AutoSelect then FEditor.SelectAll;
  end;
  Close;
end;

procedure TsPopupCalendar.WMEraseBkGnd(var Message: TMessage);
begin
  case Message.Msg of WM_ERASEBKGND : if Assigned(DefaultManager) and DefaultManager.Active then Exit end;
  inherited;
end;

procedure TsPopupCalendar.FormDeactivate(Sender: TObject);
begin
  Close;
end;

procedure TsPopupCalendar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  TsDateEdit(FEditor).FPopupWindow := nil;
  Inherited;
end;

end.