stooledit.pas

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

    Application.UnhookMainWindow(FormatSettingsChange);
    FHooked := False;
  end;
  inherited DestroyWindowHandle;
end;

procedure TsCustomDateEdit.UpdateFormat;
begin
  FDateFormat := DefDateFormat(FourDigitYear);
end;

function TsCustomDateEdit.GetDateFormat: string;
begin
  Result := FDateFormat;
end;

function TsCustomDateEdit.TextStored: Boolean;
begin
  Result := not IsEmptyStr(Text, [#0, ' ', DateSeparator, FBlanksChar]);
end;

function TsCustomDateEdit.CheckValidDate : boolean;
begin
  Result := False;
  if TextStored then try
    FFormatting := True;
    try
      SetDate(StrToDateFmt(FDateFormat, Text));
      Result := True;
    finally
      FFormatting := False;
    end;
  except
    if CanFocus then SetFocus;
    raise;
  end;
end;

procedure TsCustomDateEdit.Change;
begin
  if not FFormatting then inherited Change;
end;

procedure TsCustomDateEdit.CMExit(var Message: TCMExit);
begin
  if not (csDesigning in ComponentState) and CheckOnExit and CheckValidDate then begin
    if (FMaxDate <> 0) and (Date > FMaxDate)
      then Date := FMaxDate
      else if (FMinDate <> 0) and (Date < FMinDate) then Date := FMinDate;
  end;
  inherited;
end;

procedure TsCustomDateEdit.SetBlanksChar(Value: Char);
begin
  if Value <> FBlanksChar then begin
    if (Value < ' ') then Value := ' ';
    FBlanksChar := Value;
    UpdateMask;
  end;
end;

procedure TsCustomDateEdit.UpdateMask;
var
  DateValue: TDateTime;
  OldFormat: string[10];
begin
  DateValue := GetDate;
  OldFormat := FDateFormat;
  UpdateFormat;
  if (GetDateMask <> EditMask) or (OldFormat <> FDateFormat) then begin
    { force update }
    EditMask := '';
    EditMask := GetDateMask;
  end;
  UpdatePopup;
  SetDate(DateValue);
end;

function TsCustomDateEdit.FormatSettingsChange(var Message: TMessage): Boolean;
begin
  Result := False;
  if (Message.Msg = WM_WININICHANGE) and Application.UpdateFormatSettings then UpdateMask;
end;

function TsCustomDateEdit.FourDigitYear: Boolean;
begin
  Result := (FYearDigits = dyFour);
  Result := Result or ((FYearDigits = dyDefault) and sDateUtils.NormalYears);
end;

function TsCustomDateEdit.GetDateMask: string;
begin
  Result := DefDateMask(FBlanksChar, FourDigitYear);
end;

function TsCustomDateEdit.GetDate: TDateTime;
begin
  if DefaultToday
    then Result := SysUtils.Date
    else Result := NullDate;
  Result := StrToDateFmtDef(FDateFormat, Text, Result);
end;

procedure TsCustomDateEdit.SetDate(Value: TDateTime);
var
  D: TDateTime;
begin
  if not ValidDate(Value) or (Value = NullDate) then begin
    if DefaultToday then Value := SysUtils.Date else Value := NullDate;
  end;
  D := Self.Date;
  if Value = NullDate then Text := '' else Text := FormatDateTime(FDateFormat, Value);
  Modified := D <> Date;
end;

procedure TsCustomDateEdit.ApplyDate(Value: TDateTime);
begin
  SetDate(Value);
  SelectAll;
end;

function TsCustomDateEdit.GetDialogTitle: string;
begin
  Result := FTitle^;
end;

procedure TsCustomDateEdit.SetDialogTitle(const Value: string);
begin
  AssignStr(FTitle, Value);
end;

function TsCustomDateEdit.IsCustomTitle: Boolean;
begin
  Result := (CompareStr('Date select', DialogTitle) <> 0) and (FTitle <> NullStr);
end;

procedure TsCustomDateEdit.UpdatePopup;
var
  i : integer;
begin
  if (FPopupWindow <> nil) and (TsPopupCalendar(FPopupWindow).FCalendar <> nil) then begin
    TsPopupCalendar(FPopupWindow).FCalendar.StartOfWeek := FStartOfWeek;
    TsPopupCalendar(FPopupWindow).FCalendar.Weekends := FWeekends;
    TsPopupCalendar(FPopupWindow).FCalendar.WeekendColor := FWeekendColor;
    TsPopupCalendar(FPopupWindow).FFourDigitYear := FourDigitYear;
    if Assigned(FOnGetCellParams)
      then TsPopupCalendar(FPopupWindow).sMonthCalendar1.OnGetCellParams := FOnGetCellParams
      else TsPopupCalendar(FPopupWindow).sMonthCalendar1.OnGetCellParams := nil;
    if SkinData.Skinned and (DefaultManager <> nil)
      then TsPopupCalendar(FPopupWindow).Color := DefaultManager.GetGlobalColor
      else TsPopupCalendar(FPopupWindow).Color := clBtnFace;
    for i := 0 to CalendarHints.Count -1 do begin
      TsPopupCalendar(FPopupWindow).FCalendar.FBtns[i].Hint := CalendarHints[i];
      TsPopupCalendar(FPopupWindow).FCalendar.FBtns[i].ShowHint := ShowHint;
      if i = 3 then break;
    end;
  end;
end;

procedure TsCustomDateEdit.SetYearDigits(Value: TYearDigits);
begin
  if FYearDigits <> Value then begin
    FYearDigits := Value;
    UpdateMask;
  end;
end;

procedure TsCustomDateEdit.SetCalendarHints(Value: TStrings);
begin
  FCalendarHints.Assign(Value);
end;

procedure TsCustomDateEdit.CalendarHintsChanged(Sender: TObject);
begin
  TStringList(FCalendarHints).OnChange := nil;
  try
    while (FCalendarHints.Count > 4) do
      FCalendarHints.Delete(FCalendarHints.Count - 1);
  finally
    TStringList(FCalendarHints).OnChange := CalendarHintsChanged;
  end;
  if not (csDesigning in ComponentState) then UpdatePopup;
end;

procedure TsCustomDateEdit.SetWeekendColor(Value: TColor);
begin
  if Value <> FWeekendColor then begin
    FWeekendColor := Value;
    UpdatePopup;
  end;
end;

procedure TsCustomDateEdit.SetWeekends(Value: sConst.TDaysOfWeek);
begin
  if Value <> FWeekends then begin
    FWeekends := Value;
    UpdatePopup;
  end;
end;

procedure TsCustomDateEdit.SetStartOfWeek(Value: TCalDayOfWeek);
begin
  if Value <> FStartOfWeek then begin
    FStartOfWeek := Value;
    UpdatePopup;
  end;
end;

procedure TsCustomDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN, VK_ADD, VK_SUBTRACT]) and DroppedDown then begin
    TsPopupCalendar(FPopupWindow).FCalendar.FGrid.KeyDown(Key, Shift);
    Key := 0;
  end
  else if (Shift = []) and DirectInput then case Key of
    VK_ADD: begin
      ApplyDate(NvlDate(Date, Now) + 1);
      Key := 0;
    end;
    VK_SUBTRACT: begin
      ApplyDate(NvlDate(Date, Now) - 1);
      Key := 0;
    end;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TsCustomDateEdit.KeyPress(var Key: Char);
begin
  if (Key in ['T', 't', '+', '-']) and DroppedDown then begin
    TsPopupCalendar(FPopupWindow).FCalendar.FGrid.KeyPress(Key);
    Key := #0;
  end
  else if DirectInput then begin
    case Key of
      'T', 't': begin
        ApplyDate(Trunc(Now));
        Key := #0;
      end;
      '+', '-': begin
        Key := #0;
      end;
    end;
  end;
  inherited KeyPress(Key);
end;

procedure TsCustomDateEdit.PopupWindowShow;
begin
  if FPopupWindow = nil then FPopupWindow := TsPopupCalendar.Create(Self);
  if Self.Date <> NullDate
    then TsPopupCalendar(FPopupWindow).FCalendar.CalendarDate := Self.Date
    else TsPopupCalendar(FPopupWindow).FCalendar.CalendarDate := SysUtils.Date;
  TsPopupCalendar(FPopupWindow).FEditor := Self;
  UpdatePopup;
  inherited;
end;

procedure TsCustomDateEdit.Loaded;
begin
  inherited;
  Self.UpdateMask;
end;

procedure TsCustomDateEdit.WndProc(var Message: TMessage);
begin
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of // v4.40 Shagrat
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      if Assigned (FPopupWindow) then FPopupWindow.BroadCast(Message);
      UpdateFormat;
      UpdateMask;
    end;
    AC_SETNEWSKIN, AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      if Assigned (FPopupWindow) then FPopupWindow.BroadCast(Message);
      UpdateFormat;
      UpdateMask;
    end;
  end;
  inherited;
end;

procedure TsCustomDateEdit.SetMinDate(const Value: TDateTime);
begin
  if (FMaxDate <> NullDate) and (Value > FMaxDate) then Exit;
  if (FMinDate <> Value) then begin
    FMinDate := Value;
    if Date < FMinDate then Date := FMinDate;
  end;
end;

procedure TsCustomDateEdit.SetMaxDate(const Value: TDateTime);
begin
  if (FMaxDate <> Value) and (Value >= FMinDate) then begin
    FMaxDate := Value;
    if Date > FMaxDate then Date := FMaxDate;
  end;
end;

function TsCustomDateEdit.DateIsStored: boolean;
begin
  Result := not DefaultToday
end;

procedure TsCustomDateEdit.SetShowCurrentDate(const Value: boolean);
begin
  if FShowCurrentDate <> Value then begin
    FShowCurrentDate := Value;
  end;
end;

{ TsDateEdit }

constructor TsDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SkinData.COC := COC_TsDateEdit;
  EditMask := '!90/90/0000;1; ';
  UpdateMask;
end;

{ Utility routines }

procedure DateFormatChanged;
  procedure IterateControls(AControl: TWinControl);
  var
    I: Integer;
  begin
    with AControl do
      for I := 0 to ControlCount - 1 do begin
        if Controls[I] is TsCustomDateEdit then TsCustomDateEdit(Controls[I]).UpdateMask else if Controls[I] is TWinControl then IterateControls(TWinControl(Controls[I]));
      end;
  end;
var
  I: Integer;
begin
  if Screen <> nil then for I := 0 to Screen.FormCount - 1 do IterateControls(Screen.Forms[I]);
end;

function StrToDateFmt(const DateFormat, S: string): TDateTime;
begin
  if not InternalStrToDate(DateFormat, S, Result) then Raise EConvertError.CreateFmt('Invalid Date', [S]);
end;

function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
begin
  if not InternalStrToDate(DateFormat, S, Result) then Result := Trunc(Default);
end;

end.