jvdatepickeredit.pas

East make Tray Icon in delphi

          FDeleting := True;
        end;
    end;
  inherited KeyDown(Key, Shift);
  FDeleting := FDeleting and not DeleteSetHere;
end;

procedure TJvCustomDatePickerEdit.KeyPress(var Key: Char);
var
  OldSep: Char;
begin
  { this makes the transition easier for users used to non-mask-aware edit controls
    as they could continue typing the separator character without the cursor
    auto-advancing to the next figure when they don't expect it : }
  if (Key = Self.DateSeparator) and (Text[SelStart] = Self.DateSeparator) then
  begin
    Key := #0;
    Exit;
  end;

  OldSep := SysUtils.DateSeparator;
  SysUtils.DateSeparator := Self.DateSeparator;
  try
    inherited KeyPress(Key);
  finally
    SysUtils.DateSeparator := OldSep;
  end;
end;

procedure TJvCustomDatePickerEdit.Loaded;
begin
  inherited Loaded;
  UpdateDisplay;
end;

procedure TJvCustomDatePickerEdit.ParseFigures(var AFigures: TJvDateFigures;
  AFormat: string; const AMask: string);
var
  I: Integer;
  DummyFigures: TJvDateFigures;
begin
  {Determine the position of the individual figures in the mask string.}
  FindSeparators(AFigures, AMask);
  AFigures[2].Length := AFigures[2].Length - Length(DateMaskSuffix);

  AFormat := UpperCase(AFormat);

  {Determine the order of the individual figures in the format string.}
  FindSeparators(DummyFigures, AFormat, False);

  for I := 0 to 2 do
  begin
    case AFormat[DummyFigures[I].Start] of
      'D':
        AFigures[I].Figure := dfDay;
      'M':
        AFigures[I].Figure := dfMonth;
      'Y':
        AFigures[I].Figure := dfYear;
    end;
    AFigures[I].Index := I;
  end;
end;

procedure TJvCustomDatePickerEdit.RaiseNoDate;
begin
  raise EJVCLException.CreateResFmt(@RsEMustHaveADate, [Name]);
end;

procedure TJvCustomDatePickerEdit.ResetDateFormat;
begin
  FInternalDateFormat := FDateFormat;
  FMask := DateFormatToEditMask(FInternalDateFormat);
  ParseFigures(FDateFigures, FInternalDateFormat, FMask);
  BeginInternalChange;
  try
    EditMask := '';
    Text := '';
    EditMask := FMask;
    FEmptyMaskText := Text;
  finally
    EndInternalChange;
  end;
  UpdateDisplay;
end;

procedure TJvCustomDatePickerEdit.RestoreMask;
begin
  if EditMask = '' then
    EditMask := FMask;
end;

procedure TJvCustomDatePickerEdit.SetAllowNoDate(const AValue: Boolean);
begin
  if AllowNoDate <> AValue then
  begin
    FAllowNoDate := AValue;

    if AValue and IsEmpty then
      if csDesigning in ComponentState then
        Self.Date := SysUtils.Date
      else
        RaiseNoDate;

    if not AValue then
      ShowCheckBox := False;
  end;
end;

procedure TJvCustomDatePickerEdit.SetCalAppearance(
  const AValue: TJvMonthCalAppearance);
begin
  FCalAppearance.Assign(AValue);
end;

procedure TJvCustomDatePickerEdit.SetChecked(const AValue: Boolean);
begin
  if Checked <> AValue then
  begin
    if AValue then
    begin
      if Self.Date = 0 then
        Self.Date := SysUtils.Date;
    end
    else
    begin
      Self.Date := 0;
    end;
    Change;
  end;
end;

procedure TJvCustomDatePickerEdit.SetDate(const AValue: TDateTime);
begin
  if ValidateDate(AValue) then
    FDate := AValue;
  UpdateDisplay;
end;

procedure TJvCustomDatePickerEdit.SetDateFormat(const AValue: string);
begin
  FDateFormat := AValue;
  if FDateFormat = '' then
    FDateFormat := ShortDateFormat;
  DateSeparator := DetermineDateSeparator(FDateFormat); //calls ResetDateFormat implicitly
  if FDateFormat <> ShortDateFormat then
    FStoreDateFormat := True;
end;

procedure TJvCustomDatePickerEdit.SetDateSeparator(const AValue: Char);
begin
  FDateSeparator := AValue;
  ResetDateFormat;
end;

{ The only purpose of the following overrides is to overcome a known issue in
  Mask.pas where it is impossible to use the slash character in an EditMask if
  SysUtils.DateSeparator is set to something else even if the slash was escaped
  as a literal. By inheritance the following methods all end up eventually in
  Mask.MaskIntlLiteralToChar which performs the unwanted conversion. By
  temporarily setting SysUtils.DateSeparator we could circumvent this. }

procedure TJvCustomDatePickerEdit.SetEditMask(const AValue: string);
var
  OldSep: Char;
begin
  OldSep := SysUtils.DateSeparator;
  SysUtils.DateSeparator := Self.DateSeparator;
  try
    inherited EditMask := AValue;
  finally
    SysUtils.DateSeparator := OldSep;
  end;
end;

procedure TJvCustomDatePickerEdit.SetNoDateText(const AValue: string);
begin
  FNoDateText := AValue;
  UpdateDisplay;
end;

procedure TJvCustomDatePickerEdit.SetPopupValue(const Value: Variant);
begin
  if FPopup is TJvDropCalendar then
    TJvDropCalendar(FPopup).SelDate :=
      StrToDateDef(VarToStr(Value), SysUtils.Date);
end;

procedure TJvCustomDatePickerEdit.SetShowCheckbox(const AValue: Boolean);
begin
  inherited SetShowCheckbox(AValue);
  if AValue then
    AllowNoDate := True;
  UpdateDisplay;
end;

procedure TJvCustomDatePickerEdit.SetText(const AValue: TCaption);
var
  OldSep: Char;
begin
  OldSep := SysUtils.DateSeparator;
  SysUtils.DateSeparator := Self.DateSeparator;
  try
    inherited Text := AValue;
  finally
    SysUtils.DateSeparator := OldSep;
  end;
end;

procedure TJvCustomDatePickerEdit.ShowPopup(Origin: TPoint);
begin
  if FPopup is TJvDropCalendar then
  begin
    TJvDropCalendar(FPopup).Show;
  end;
end;

procedure TJvCustomDatePickerEdit.UpdateDisplay;
begin
  if InternalChanging or (csLoading in ComponentState) then
    Exit;

  BeginInternalChange;
  try
    inherited SetChecked(not IsEmpty);
    if IsEmpty then
    begin
      if not (csDesigning in ComponentState) then
      begin
        ClearMask;
        Text := NoDateText;
      end;
    end
    else
    begin
      RestoreMask;
      Text := DateToText(Self.Date)
    end;
  finally
    EndInternalChange;
  end;
end;

function TJvCustomDatePickerEdit.ValidateDate(const ADate: TDateTime): Boolean;
begin
  if (not AllowNoDate) and (ADate = 0) then
    RaiseNoDate;
  if (ADate < EncodeDate(1752, 09, 14)) or ((ADate > EncodeDate(1752, 09, 19)) and (ADate < EncodeDate(1752, 10, 1))) then
    { For historical/political reasons the days 1752-09-03 - 1752-09-13 do not
      exist in the Gregorian calendar - for some unknown reason the Microsoft
      calendar treats the period between 1752-09-20 and 1752-09-30 as missing
      instead, even though dates before 1752-09-14 are considered invalid as
      well (MS' offical explanation saying they only support the Gregorian
      calendar as of British adoption of it is not accurate: Britain adopted the
      Gregorian calendar starting 1752-01-01).}
    Result := False
  else
    Result := True;
end;

procedure TJvCustomDatePickerEdit.WMPaste(var Msg: TMessage);
var
  OldSep: Char;
begin
  OldSep := SysUtils.DateSeparator;
  SysUtils.DateSeparator := Self.DateSeparator;
  try
    inherited;
  finally
    SysUtils.DateSeparator := OldSep;
  end;
end;

//=== { TJvDropCalendar } ====================================================

procedure TJvDropCalendar.CalKeyPress(Sender: TObject; var Key: Char);
begin
  if WithBeep then
    SysUtils.Beep;
  case Word(Key) of
    VK_RETURN:
      DoSelect;
    VK_ESCAPE:
      DoCancel;
  else
    DoChange;
  end;
end;

procedure TJvDropCalendar.CalKillFocus(const ASender: TObject;
  const ANextControl: TWinControl);
var
  P: TPoint;
begin
  GetCursorPos(P);
  if PtInRect(BoundsRect, P) then
    Exit;
  if Assigned(ANextControl) then
    FocusKilled(ANextControl.Handle)
  else
    FocusKilled(0);
end;

procedure TJvDropCalendar.CalSelChange(Sender: TObject;
  StartDate, EndDate: TDateTime);
begin
  DoChange;
end;

procedure TJvDropCalendar.CalSelect(Sender: TObject;
  StartDate, EndDate: TDateTime);
begin
  DoSelect;
end;

constructor TJvDropCalendar.CreateWithAppearance(AOwner: TComponent;
  const AAppearance: TJvMonthCalAppearance);
begin
  inherited Create(AOwner);
  FWithBeep := False;
  FCal := TJvMonthCalendar2.CreateWithAppearance(Self, AAppearance);
  with TJvMonthCalendar2(FCal) do
  begin
    Parent := Self;
    ParentFont := True;
    OnSelChange := CalSelChange;
    OnSelect := CalSelect;
    OnKillFocus := CalKillFocus;
    OnKeyPress := CalKeyPress;
    Visible := True;
    AutoSize := True;
  end;
end;

destructor TJvDropCalendar.Destroy;
begin
  if Assigned(FCal) then
    with TJvMonthCalendar2(FCal) do
    begin
      OnSelChange := nil;
      OnSelect := nil;
      OnKeyPress := nil;
    end;
  inherited Destroy;
end;

procedure TJvDropCalendar.DoCancel;
begin
  if Assigned(OnCancel) then
    OnCancel(Self)
  else
    Release;
end;

procedure TJvDropCalendar.DoChange;
begin
  if Assigned(OnChange) then
    OnChange(Self);
end;

procedure TJvDropCalendar.DoSelect;
begin
  if Assigned(OnSelect) then
    OnSelect(Self);
end;

procedure TJvDropCalendar.DoShow;
begin
  {
   In the constructor the calendar will sometimes report
   the wrong size, so we do this here.
  }
  AutoSize := True;
  inherited DoShow;
end;

function TJvDropCalendar.GetSelDate: TDateTime;
begin
  Result := TJvMonthCalendar2(FCal).DateFirst;
end;

procedure TJvDropCalendar.SetFocus;
begin
  if FCal.CanFocus then
    FCal.SetFocus
  else
    inherited SetFocus;
end;

procedure TJvDropCalendar.SetSelDate(const AValue: TDateTime);
begin
  TJvMonthCalendar2(FCal).DateFirst := AValue;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.