⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 spopupclndr.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
字号:
unit sPopupClndr;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sCustomButton, ExtCtrls, sMonthCalendar, comctrls, sConst, sPanel,
  sUtils, sCustomComboEdit, sStyleUtil, sControlsManager, sButtonControl
  {$IFDEF DELPHI6UP}, Variants {$ENDIF};

const
  FormHeight = 184;

type
  TsPopupCalendar = class(TForm)
    sMonthCalendar1: TsMonthCalendar;
    sControlsManager1: TsControlsManager;
    sPanel1: TsPanel;
    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);
  private
  protected
    FCloseUp: TCloseUpEvent;
    procedure KeyPress(var Key: Char); override;
    function GetValue: Variant;
    procedure SetValue(const Value: Variant);
    procedure CloseUp(Accept: Boolean); virtual;
  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;

{ TsPopupCalendar }

{
procedure TsPopupCalendar.CalendarMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Longint;
begin
  if (Button = mbLeft) and (Shift = []) then begin
    FCalendar.FGrid.MouseToCell(X, Y, Col, Row);
    if (Row > 0) and (FCalendar.CellText[Col, Row] <> '')
      then CloseUp(True);
  end;
end;
}
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 := sMonthCalendar1.CalendarDate;
          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;
  if (FEditor <> nil) then begin
    sMonthCalendar1.Visible := False;
    Height := FormHeight - 40;
    if (FEditor <> nil) and (TsCustomDateEdit(FEditor).sStyle.sC <> nil) then begin
//      sStyleControl1.Assign(TsCustomDateEdit(FEditor).sStyle.sC)     !
    end;
  end
  else begin
    Height := FormHeight;
  end;
  sMonthCalendar1.Visible := True;
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 := sMonthCalendar1.CalendarDate;
      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.FormDeactivate(Sender: TObject);
begin
  if FEditor <> nil then Close;
end;

procedure TsPopupCalendar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if (FEditor <> nil) and not FEditor.MousePressed then TsCustomDateEdit(FEditor).DontPopup := False;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -