tntjvpickdate.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

    EnableWindow(Handle, True);
end;

{$IFDEF VCL}
procedure TJvLocCalendar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style and not (WS_BORDER or WS_TABSTOP or WS_DISABLED);
end;
{$ENDIF VCL}

procedure TJvLocCalendar.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
var
  Coord: TGridCoord;
begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
end;

procedure TJvLocCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
  D, M, Y: Word;
begin
  inherited DrawCell(ACol, ARow, ARect, AState);
  DecodeDate(CalendarDate, Y, M, D);
  D := StrToIntDef(CellText[ACol, ARow], 0);
  if (D > 0) and (D <= DaysPerMonth(Y, M)) then
    if EncodeDate(Y, M, D) = SysUtils.Date then
      Frame3D(Canvas, ARect, clBtnShadow, clBtnHighlight, 1);
end;

//=== { TTntJvPopupCalendar } ===================================================

function CreatePopupCalendarW(AOwner: TComponent;
  ABiDiMode: TBiDiMode = bdLeftToRight;
  MinDate: TDateTime  = 0;
  MaxDate: TDateTime = 0): TWinControl;
begin
  Result := TTntJvPopupCalendar.Create(AOwner);
(*
  // TTntJvPopupCalendar sets Scaled to false anyway...
  if (AOwner <> nil) and not (csDesigning in AOwner.ComponentState) and
    (Screen.PixelsPerInch <> 96) then
  begin { scale to screen res }
    Result.ScaleBy(Screen.PixelsPerInch, 96);
    { The ScaleBy method does not scale the font well, so set the
      font back to the original info. }
    TTntJvPopupCalendar(Result).FCalendar.ParentFont := True;
    TTntJvPopupCalendar(Result).FCalendar.MinDate := MinDate;
    TTntJvPopupCalendar(Result).FCalendar.MaxDate := MaxDate;
    FontSetDefault(TTntJvPopupCalendar(Result).Font);
    {$IFDEF VCL}
    Result.BiDiMode := ABiDiMode;
    {$ENDIF VCL}
  end;
*)
end;

procedure SetupPopupCalendarW(PopupCalendar: TWinControl;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TTntStrings; FourDigitYear: Boolean;
  MinDate: TDateTime; MaxDate: TDateTime);
var
  I: Integer;
begin
  if (PopupCalendar = nil) or not (PopupCalendar is TTntJvPopupCalendar) then
    Exit;
  // Polaris
  if not (csDesigning in PopupCalendar.Owner.ComponentState) then
  begin
    TTntJvPopupCalendar(PopupCalendar).SetDate(0, MinDate);
    TTntJvPopupCalendar(PopupCalendar).SetDate(1, MaxDate);
  end;
  // Polaris
  //  TTntJvPopupCalendar(PopupCalendar).MaxDate := MaxDate;

  TTntJvPopupCalendar(PopupCalendar).FFourDigitYear := FourDigitYear;
  if TTntJvPopupCalendar(PopupCalendar).FCalendar <> nil then
  begin
    with TTntJvPopupCalendar(PopupCalendar).FCalendar do
    begin
      StartOfWeek := AStartOfWeek;
      WeekendColor := AWeekendColor;
      Weekends := AWeekends;
    end;
    if BtnHints <> nil then
      for I := 0 to Min(BtnHints.Count - 1, 3) do
        if BtnHints[I] <> '' then
          TTntJvPopupCalendar(PopupCalendar).FBtns[I].Hint := BtnHints[I];
  end;
end;

constructor TTntJvPopupCalendar.Create(AOwner: TComponent);
{$IFDEF JVCLThemesEnabled}
var
  BtnSide: Integer;
  VertOffset: Integer;
  HorzOffset: Integer;
  Control, BackPanel: TWinControl;
{$ELSE}
const
  BtnSide = 14;
  VertOffset = -1;
  HorzOffset = 1;
var
  Control, BackPanel: TWinControl;
{$ENDIF JVCLThemesEnabled}
begin
  inherited Create(AOwner);
  FFourDigitYear := IsFourDigitYear;
  Height := Max(PopupCalendarSize.Y, 120);
  Width := Max(PopupCalendarSize.X, 180);
  {$IFDEF UNIX}
  Constraints.MaxWidth := Width;
  Constraints.MaxHeight := Height;
  Constraints.MinWidth := Constraints.MaxWidth;
  Constraints.MinHeight := Constraints.MaxHeight;
  {$ENDIF UNIX}

  Color := clBtnFace;
  FontSetDefault(Font);
  if AOwner is TControl then
    ShowHint := TControl(AOwner).ShowHint
  else
    ShowHint := True;
  if csDesigning in ComponentState then
    Exit;

  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
  begin
    VertOffset := 0;
    HorzOffset := 0;
    BtnSide := 16
  end
  else
  begin
    VertOffset := -1;
    HorzOffset := 1;
    BtnSide := 14;
  end;
  {$ENDIF JVCLThemesEnabled}

  BackPanel := TTntPanel.Create(Self);
  with BackPanel as TTntPanel do
  begin
    Parent := Self;
    Align := alClient;
    ParentColor := True;
    ControlStyle := ControlStyle + [csReplicatable];
    BevelOuter := bvNone;
    BevelInner := bvNone;
  end;

  Control := TTntPanel.Create(Self);
  with Control as TTntPanel do
  begin
    Parent := BackPanel;
    Align := alTop;
    Width := Self.Width - 4;
    Height := 18;
    BevelOuter := bvNone;
    ParentColor := True;
    ControlStyle := ControlStyle + [csReplicatable];
  end;

  FCalendar := TJvLocCalendar.Create(Self);
  with TJvLocCalendar(FCalendar) do
  begin
    Parent := BackPanel;
    Align := alClient;
    OnChange := CalendarChange;
    OnMouseUp := CalendarMouseUp;
  end;

  FBtns[0] := TTntJvTimerSpeedButton.Create(Self);
  with FBtns[0] do
  begin
    Parent := Control;
    SetBounds(0 - HorzOffset, VertOffset, BtnSide, BtnSide);
    CreateButtonGlyph(Glyph, 0);
    OnClick := PrevYearBtnClick;
    Hint := RsPrevYearHint;
  end;

  FBtns[1] := TTntJvTimerSpeedButton.Create(Self);
  with FBtns[1] do
  begin
    Parent := Control;
    SetBounds(BtnSide - 1 - HorzOffset, VertOffset, BtnSide, BtnSide);
    CreateButtonGlyph(Glyph, 1);
    OnClick := PrevMonthBtnClick;
    Hint := RsPrevMonthHint;
  end;

  FTitleLabel := TTntLabel.Create(Self);
  with FTitleLabel do
  begin
    Parent := Control;
    AutoSize := False;
    Alignment := taCenter;
    SetBounds(BtnSide * 2 + 1, 1, Control.Width - 4 * BtnSide - 2, 14);
    Transparent := True;
    OnDblClick := TopPanelDblClick;
    ControlStyle := ControlStyle + [csReplicatable];
  end;

  FBtns[2] := TTntJvTimerSpeedButton.Create(Self);
  with FBtns[2] do
  begin
    Parent := Control;
    SetBounds(Control.Width - 2 * BtnSide + 1 + HorzOffset, VertOffset, BtnSide, BtnSide);
    CreateButtonGlyph(Glyph, 2);
    OnClick := NextMonthBtnClick;
    Hint := RsNextMonthHint;
  end;

  FBtns[3] := TTntJvTimerSpeedButton.Create(Self);
  with FBtns[3] do
  begin
    Parent := Control;
    SetBounds(Control.Width - BtnSide + HorzOffset, VertOffset, BtnSide, BtnSide);
    CreateButtonGlyph(Glyph, 3);
    OnClick := NextYearBtnClick;
    Hint := RsNextYearHint;
  end;
  //Polaris
  CheckButton;
end;

//>Polaris

procedure TTntJvPopupCalendar.CheckButton;
var
  //  CurDate: TDate;
  AYear, AMonth, ADay: Word;
begin
  if not Assigned(FCalendar) then
    Exit;
  //  CurDate := TJvLocCalendar(FCalendar).CalendarDate;
  if TJvLocCalendar(FCalendar).MinDate = NullDate then
    for AYear := 0 to 1 do
      FBtns[AYear].Enabled := True
  else
  begin
    DecodeDate(TJvLocCalendar(FCalendar).MinDate, AYear, AMonth, ADay);
    FBtns[0].Enabled := TJvLocCalendar(FCalendar).Year > AYear;
    FBtns[1].Enabled := (TJvLocCalendar(FCalendar).Year > AYear) or ((TJvLocCalendar(FCalendar).Year = AYear) and
      (TJvLocCalendar(FCalendar).Month > AMonth));
  end;
  if TJvLocCalendar(FCalendar).MaxDate = NullDate then
    for AYear := 2 to 3 do
      FBtns[AYear].Enabled := True
  else
  begin
    DecodeDate(TJvLocCalendar(FCalendar).MaxDate, AYear, AMonth, ADay);
    FBtns[2].Enabled := (TJvLocCalendar(FCalendar).Year < AYear) or ((TJvLocCalendar(FCalendar).Year = AYear) and
      (TJvLocCalendar(FCalendar).Month < AMonth));
    FBtns[3].Enabled := TJvLocCalendar(FCalendar).Year < AYear;
  end;
end;

procedure TTntJvPopupCalendar.Invalidate;
begin
  CheckButton;
  inherited Invalidate;
end;

procedure TTntJvPopupCalendar.Update;
begin
  CheckButton;
  inherited Update;
end;

{
function TTntJvPopupCalendar.GetDate(Index: Integer): TDateTime;
begin
  FCalendar.Min
  case Index of
    0:
      Result := TJvLocCalendar(FCalendar).FMinDate;
    1:
      Result := TJvLocCalendar(FCalendar).FMaxDate;
  else
    Result := NullDate;
  end;
end;
}

procedure TTntJvPopupCalendar.SetDate(Index: Integer; Value: TDateTime);
begin
  case Index of
    0:
      TJvLocCalendar(FCalendar).FMinDate := Value;
    1:
      TJvLocCalendar(FCalendar).FMaxDate := Value;
  end;
end;

//<Polaris

procedure TTntJvPopupCalendar.CalendarMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Longint;
begin
  if (Button = mbLeft) and (Shift - [ssLeft] = []) then
  begin
    TJvLocCalendar(FCalendar).MouseToCell(X, Y, Col, Row);
    if (Row > 0) and (FCalendar.CellText[Col, Row] <> '') then
      CloseUp(True);
  end;
end;

procedure TTntJvPopupCalendar.TopPanelDblClick(Sender: TObject);
begin
  FCalendar.CalendarDate := Trunc(Now);
end;

procedure TTntJvPopupCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if FCalendar <> nil then
    case Key of
      VK_NEXT:
        if ssCtrl in Shift then
          FCalendar.NextYear
        else
          FCalendar.NextMonth;
      VK_PRIOR:
        if ssCtrl in Shift then
          FCalendar.PrevYear
        else
          FCalendar.PrevMonth;
      VK_RETURN:
        Click;
    else
      TJvLocCalendar(FCalendar).KeyDown(Key, Shift);
    end;
end;

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

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

procedure TTntJvPopupCalendar.SetValue(const Value: Variant);
begin
  if not (csDesigning in ComponentState) then
  begin
    try
      if (Trim(ReplaceStringW(VarToWideStr(Value), DateSeparatorW, '')) = '') or
        VarIsNull(Value) or VarIsEmpty(Value) then
        FCalendar.CalendarDate := VarToDateTime(SysUtils.Date)
      else
        FCalendar.CalendarDate := VarToDateTime(Value);
      CalendarChange(nil);
    except
      FCalendar.CalendarDate := VarToDateTime(SysUtils.Date);
    end;
  end;
end;

procedure TTntJvPopupCalendar.PrevYearBtnClick(Sender: TObject);
begin
  FCalendar.PrevYear;
end;

procedure TTntJvPopupCalendar.NextYearBtnClick(Sender: TObject);
begin
  FCalendar.NextYear;
end;

procedure TTntJvPopupCalendar.PrevMonthBtnClick(Sender: TObject);
begin
  FCalendar.PrevMonth;
end;

procedure TTntJvPopupCalendar.NextMonthBtnClick(Sender: TObject);
begin
  FCalendar.NextMonth;
end;

procedure TTntJvPopupCalendar.CalendarChange(Sender: TObject);
begin
  FTitleLabel.Caption := WideFormatDateTime('MMMM, YYYY', FCalendar.CalendarDate);
  CheckButton; // Polaris
end;

//=== { TJvSelectDateDlg } ===================================================

type
  TJvSelectDateDlg = class(TTntForm)
    Calendar: TTntJvCalendar;
    TitleLabel: TTntLabel;
    procedure PrevMonthBtnClick(Sender: TObject);
    procedure NextMonthBtnClick(Sender: TObject);
    procedure PrevYearBtnClick(Sender: TObject);
    procedure NextYearBtnClick(Sender: TObject);
    procedure CalendarChange(Sender: TObject);
    procedure CalendarDblClick(Sender: TObject);
    procedure TopPanelDblClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    FBtns: array [0..3] of TTntJvSpeedButton;
    procedure SetDate(Date: TDateTime);
    procedure CheckButton; // Polaris
    function GetDate: TDateTime;
  {$IFDEF VisualCLX}
  protected
    function WidgetFlags: Integer; override;
  {$ENDIF VisualCLX}
  public
    constructor Create(AOwner: TComponent); override;
    property Date: TDateTime read GetDate write SetDate;
  end;

constructor TJvSelectDateDlg.Create(AOwner: TComponent);
var
  Control: TWinControl;
begin
  inherited CreateNew(AOwner, 0); // BCB compatible
  Caption := RsDateDlgCaption;
  BorderStyle := fbsToolWindow;
  Color := clBtnFace;
  BorderIcons := [biSystemMenu];
  ClientHeight := 158; // Polaris
  ClientWidth := 222;
  FontSetDefault(Font);