jvdatepickeredit.pas

East make Tray Icon in delphi

end;

procedure TJvCustomDatePickerEdit.CalDestroy(Sender: TObject);
begin
  PopupCloseUp(Self, False);
end;

procedure TJvCustomDatePickerEdit.CalSelect(Sender: TObject);
begin
  PopupCloseUp(Self, True);
end;

procedure TJvCustomDatePickerEdit.Change;
var
  lDate: TDateTime;
  lFigVal: Word;
  lActFig: TJvDateFigureInfo;

  procedure SetActiveFigVal(const AValue: Word);
  begin
    BeginInternalChange;
    try
      SelStart := lActFig.Start - 1;
      SelLength := lActFig.Length;
      SelText := Format('%.*d', [lActFig.Length, AValue]);
    finally
      EndInternalChange;
    end;
  end;

  procedure EnforceRange(const AMin, AMax: Word);
  begin
    if lFigVal > AMax then
      SetActiveFigVal(AMax)
    else
    if lFigVal < AMin then
      SetActiveFigVal(AMin);
  end;

begin
  if InternalChanging then
    Exit;

  FDateError := False;

  if [csDesigning, csDestroying] * ComponentState <> [] then
    Exit;

  if Text <> NoDateText then
  begin
    lDate := Self.Date;
    if AttemptTextToDate(Text, lDate) then
    begin
      BeginInternalChange;
      try
        Self.Date := lDate;
      finally
        EndInternalChange;
      end;
    end
    else
    if (not FDeleting) and EnableValidation then
    begin
      lActFig := ActiveFigure;

      if lActFig.Figure <> dfNone then
      begin
        lFigVal := StrToIntDef(Trim(Copy(Text, lActFig.Start, lActFig.Length)), 0);
        //only enforce range if the cursor is at the end of the current figure:
        if SelStart = lActFig.Start + lActFig.Length - 1 then
          case lActFig.Figure of
            dfDay:
              EnforceRange(1, 31);
            dfMonth:
              EnforceRange(1, 12);
            dfYear:
              {EnforceRange( MinYear, MaxYear)}; //year-validation still under development
          end;
      end;
      {make sure querying the date in an OnChange event handler always reflects
       the current contents of the control and not just the last valid value.}
      lDate := 0;
      AttemptTextToDate(Text, lDate, lActFig.Index = High(TJvDateFigures));
      if AlwaysReturnEditDate then
        FDate := lDate;
    end;
  end;
  inherited Change;
end;

procedure TJvCustomDatePickerEdit.Clear;
begin
  Checked := False;
end;

procedure TJvCustomDatePickerEdit.ClearMask;
begin
  if EditMask <> '' then
  begin
    FMask := EditMask;
    if not (csDesigning in ComponentState) then
      EditMask := '';
  end;
end;

constructor TJvCustomDatePickerEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FAllowNoDate := True;
  FAlwaysReturnEditDate := True;
  FDate := SysUtils.Date;
  FDateError := False;
  FDeleting := False;
  FEnableValidation := True;
  //  FMaxYear := 2900;
  //  FMinYear := 1800;
  FNoDateShortcut := TextToShortCut(RsDefaultNoDateShortcut);
  FNoDateText := '';
  FStoreDate := False;
  FStoreDateFormat := False;

  FCalAppearance := TJvMonthCalAppearance.Create;

  ControlState := ControlState + [csCreating];
  try
    ImageKind := ikDropDown; { force update }
    ShowButton := True;
  finally
    ControlState := ControlState - [csCreating];
  end;
end;

procedure TJvCustomDatePickerEdit.CreatePopup;
begin
  if not Assigned(FPopup) then
  begin
    FPopup := TJvDropCalendar.CreateWithAppearance(Self, FCalAppearance);
    with TJvDropCalendar(FPopup) do
    begin
//      SelDate := Self.Date;
      OnChange := Self.CalChange;
      OnSelect := Self.CalSelect;
      OnDestroy := Self.CalDestroy;
      OnCloseQuery := Self.CalCloseQuery;
//      OnKillFocus := Self.CalKillFocus;
//      Show;
//      SetFocus;
    end;
  end;
end;

procedure TJvCustomDatePickerEdit.CreateWnd;
begin
  inherited CreateWnd;
  { (rb) Should be DateFormat? }
  SetDateFormat(ShortDateFormat);
end;

function TJvCustomDatePickerEdit.DateFormatToEditMask(
  var ADateFormat: string): string;
begin
  StrReplace(ADateFormat, 'dddddd', LongDateFormat, []);
  StrReplace(ADateFormat, 'ddddd', ShortDateFormat, []);
  StrReplace(ADateFormat, 'dddd', '', []); // unsupported: DoW as full name
  StrReplace(ADateFormat, 'ddd', '', []); // unsupported: DoW as abbrev
  StrReplace(ADateFormat, 'MMMM', 'MM', []);
  StrReplace(ADateFormat, 'MMM', 'M', []);
  Result := ADateFormat;
  StrReplace(Result, 'dd', '00', []);
  StrReplace(Result, 'd', '99', []);
  StrReplace(Result, 'MM', '00', []);
  StrReplace(Result, 'M', '99', []);
  StrReplace(Result, 'yyyy', '0099', []);
  StrReplace(Result, 'yy', '00', []);
  StrReplace(Result, ' ', '_', []);
  Result := Trim(Result) + DateMaskSuffix;
end;

function TJvCustomDatePickerEdit.DateToText(const ADate: TDateTime): string;
var
  OldSep: Char;
begin
  OldSep := SysUtils.DateSeparator;
  // without this a slash would always be converted to SysUtils.DateSeparator
  SysUtils.DateSeparator := Self.DateSeparator;
  try
    Result := FormatDateTime(FInternalDateFormat, ADate);
  finally
    SysUtils.DateSeparator := OldSep;
  end;
end;

class function TJvCustomDatePickerEdit.DefaultImageIndex: TImageIndex;
begin
  Result := TJvDateEdit.DefaultImageIndex;
end;

destructor TJvCustomDatePickerEdit.Destroy;
begin
  FreeAndNil(FCalAppearance);
  inherited Destroy;
end;

function TJvCustomDatePickerEdit.DetermineDateSeparator(AFormat: string): Char;
begin
  AFormat := StrRemoveChars(Trim(AFormat), ['d', 'M', 'y']);
  if Length(AFormat) > 0 then
    Result := AFormat[1]
  else
    Result := SysUtils.DateSeparator;
end;

procedure TJvCustomDatePickerEdit.DoCtl3DChanged;
begin
  inherited DoCtl3DChanged;
  { (rb) Conflicts with ButtonFlat property }
  Button.Flat := not Self.Ctl3D;
end;

procedure TJvCustomDatePickerEdit.DoKillFocus(const ANextControl: TWinControl);
var
  lDate: TDateTime;
begin
  if (ANextControl = nil) or ((ANextControl <> FPopup) and
    (ANextControl.Owner <> FPopup)) then
    if not FDateError then
    begin
      PopupCloseUp(Self, False);
      inherited DoKillFocus(ANextControl);
      if EnableValidation then
      try
        lDate := Self.Date;
        if (Text <> NoDateText) and AttemptTextToDate(Text, lDate, True, True) then
          Self.Date := lDate;
      except
        on EConvertError do
          if not (csDestroying in ComponentState) then
          begin
            FDateError := True;
            SetFocus;
            raise;
          end
          else
            Self.Date := 0;
      end;
    end
    else
      inherited DoKillFocus(ANextControl);
end;

//procedure TJvCustomDatePickerEdit.DropButtonClick(Sender: TObject);
//begin
//  if Dropped then
//    CloseUp
//  else
//    DropDown;
//end;

//procedure TJvCustomDatePickerEdit.DropDown;
//begin
//  if not Dropped then
//  begin
//    if IsEmpty then
//      Self.Date := SysUtils.Date;
//
//    FDropFo := TJvDropCalendar.CreateWithAppearance(Self, FCalAppearance);
//    with FDropFo do
//    begin
//      SelDate := Self.Date;
//      OnChange := Self.CalChange;
//      OnSelect := Self.CalSelect;
//      OnDestroy := Self.CalDestroy;
//      OnCloseQuery := Self.CalCloseQuery;
//      OnKillFocus := Self.CalKillFocus;
//      Show;
//      SetFocus;
//    end;
//  end;
//end;

procedure TJvCustomDatePickerEdit.EnabledChanged;
begin
  inherited EnabledChanged;
  if not (Self.Enabled) and Dropped then
    PopupCloseUp(Self, False);
end;

procedure TJvCustomDatePickerEdit.FindSeparators(var AFigures: TJvDateFigures;
  const AText: string; const AGetLengths: Boolean);
begin
  //TODO 3 : make up for escaped characters in EditMask
  AFigures[0].Start := 1;
  AFigures[1].Start := Pos(DateSeparator, AText) + 1;
  AFigures[2].Start := StrLastPos(DateSeparator, AText) + 1;

  if AGetLengths then
  begin
    AFigures[0].Length := AFigures[1].Start - 2;
    AFigures[1].Length := AFigures[2].Start - AFigures[1].Start - 1;
    AFigures[2].Length := Length(AText) - AFigures[2].Start + 1;
  end;
end;

function TJvCustomDatePickerEdit.GetChecked: Boolean;
begin
  Result := not IsEmpty;
end;

function TJvCustomDatePickerEdit.GetDate: TDateTime;
begin
  Result := FDate;
end;

function TJvCustomDatePickerEdit.GetDropped: Boolean;
begin
  //Result := Assigned(FDropFo) and not (csDestroying in FDropFo.ComponentState);
  Result := PopupVisible;
end;

function TJvCustomDatePickerEdit.GetEditMask: string;
begin
  Result := inherited EditMask;
end;

function TJvCustomDatePickerEdit.GetEnableValidation: Boolean;
begin
  Result := FEnableValidation;
end;

function TJvCustomDatePickerEdit.GetPopupValue: Variant;
begin
  if FPopup is TJvDropCalendar then
    Result := TJvDropCalendar(FPopup).SelDate;
end;

function TJvCustomDatePickerEdit.GetText: TCaption;
var
  OldSep: Char;
begin
  OldSep := SysUtils.DateSeparator;
  SysUtils.DateSeparator := Self.DateSeparator;
  try
    Result := inherited Text;
  finally
    SysUtils.DateSeparator := OldSep;
  end;
end;

procedure TJvCustomDatePickerEdit.HidePopup;
begin
  inherited;
{  if (FPopup is TJvDropCalendar) and not (csDestroying in FPopup.ComponentState) then
    TJvDropCalendar(FPopup).Release;}
  //FPopup := nil;
end;

function TJvCustomDatePickerEdit.IsEmpty: Boolean;
begin
  Result := (FDate = 0);
end;

function TJvCustomDatePickerEdit.IsEmptyMaskText(const AText: string): Boolean;
begin
  Result := AnsiSameStr(AText, FEmptyMaskText);
end;

function TJvCustomDatePickerEdit.IsNoDateShortcutStored: Boolean;
begin
  Result := (NoDateShortcut <> TextToShortCut(RsDefaultNoDateShortcut));
end;

function TJvCustomDatePickerEdit.IsNoDateTextStored: Boolean;
begin
  Result := (NoDateText <> '');
end;

procedure TJvCustomDatePickerEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  // Indicates whether FDeleting is set here from False to True.
  DeleteSetHere: Boolean;
begin
  DeleteSetHere := False;

  if Text = NoDateText then
  begin
    Text := '';
    RestoreMask;
  end;

  if AllowNoDate and (ShortCut(Key, Shift) = NoDateShortcut) then
    Date := 0
  else
  if Shift * KeyboardShiftStates = [] then
    case Key of
//      VK_ESCAPE:
//        begin
//          CloseUp;
//          Reset;
//        end;
//      VK_DOWN:
//        if AShift = [ssAlt] then
//          DropDown;
      VK_BACK, VK_CLEAR, VK_DELETE, VK_EREOF, VK_OEM_CLEAR:
        begin
          DeleteSetHere := not FDeleting;