📄 jvcalendar.pas
字号:
begin
inherited ColorChanged;
InvalidateRect(Handle, nil, True);
end;
procedure TJvCustomMonthCalendar.FontChanged;
begin
inherited FontChanged;
// if HandleAllocated then
// Perform(WM_SIZE,0,0);
InvalidateRect(Handle, nil, True);
end;
procedure TJvCustomMonthCalendar.SetMultiSelect(Value: Boolean);
begin
if FMultiSelect <> Value then
begin
FMultiSelect := Value;
RecreateWnd;
end;
end;
procedure TJvCustomMonthCalendar.SetShowToday(Value: Boolean);
begin
FAppearance.ShowToday := Value;
end;
procedure TJvCustomMonthCalendar.SetCircleToday(Value: Boolean);
begin
FAppearance.CircleToday := Value;
end;
procedure TJvCustomMonthCalendar.SetWeekNumbers(Value: Boolean);
begin
FAppearance.WeekNumbers := Value;
end;
procedure TJvCustomMonthCalendar.SetFirstDayOfWeek(Value: TJvMonthCalWeekDay);
begin
FAppearance.FirstDayOfWeek := Value;
end;
procedure TJvCustomMonthCalendar.SetMaxSelCount(Value: Word);
begin
if FMaxSelCount <> Value then
begin
FMaxSelCount := Value;
Change;
end;
end;
procedure TJvCustomMonthCalendar.SetMinDate(Value: TDateTime);
begin
if FMinDate <> Value then
begin
FMinDate := Value;
Change;
end;
end;
procedure TJvCustomMonthCalendar.SetMaxDate(Value: TDateTime);
begin
if FMaxDate <> Value then
begin
FMaxDate := Value;
Change;
end;
end;
procedure TJvCustomMonthCalendar.SetFirstSelDate(Value: TDateTime);
begin
FFirstSelDate := Value;
SetSelectedDays(FFirstSelDate, FLastSelDate);
end;
function TJvCustomMonthCalendar.GetFirstSelDate: TDateTime;
var
rgst: array [0..1] of TSystemTime;
begin
Result := FFirstSelDate;
if not HandleAllocated then
Exit;
if FMultiSelect then
MonthCal_GetSelRange(Handle, @rgst[0])
else
MonthCal_GetCurSel(Handle, rgst[0]);
with rgst[0] do
FFirstSelDate := EncodeDate(wYear, wMonth, wDay);
end;
procedure TJvCustomMonthCalendar.SetLastSelDate(Value: TDateTime);
begin
if FLastSelDate <> Value then
begin
FLastSelDate := Value;
SetSelectedDays(FLastSelDate, FFirstSelDate);
end;
end;
function TJvCustomMonthCalendar.GetLastSelDate: TDateTime;
var
rgst: array [0..1] of TSystemTime;
begin
Result := FLastSelDate;
if not HandleAllocated then
Exit;
if not FMultiSelect then
begin
Result := FLastSelDate;
Exit;
end;
if MonthCal_GetSelRange(Handle, @rgst[0]) then
with rgst[1] do
FLastSelDate := Trunc(EncodeDate(wYear, wMonth, wDay));
end;
procedure TJvCustomMonthCalendar.SetSelectedDays(dFrom, dTo: TDateTime);
var
rgst: array [0..1] of TSystemTime;
begin
if not HandleAllocated then
Exit;
if FMultiSelect then
begin
if (dFrom <> 0) and (dTo <> 0) then
begin
with rgst[0] do
DecodeDate(dFrom, wYear, wMonth, wDay);
with rgst[1] do
DecodeDate(dTo, wYear, wMonth, wDay);
MonthCal_SetSelRange(Handle, @rgst[0]);
end
else
MonthCal_SetSelRange(Handle, nil);
end
else
begin
with rgst[0] do
DecodeDate(dFrom, wYear, wMonth, wDay);
MonthCal_SetCurSel(Handle, rgst[0]);
end;
end;
procedure TJvCustomMonthCalendar.SetMonthDelta(Value: Integer);
begin
if FMonthDelta <> Value then
begin
FMonthDelta := Value;
Change;
end;
end;
procedure TJvCustomMonthCalendar.SetToday(Value: TDateTime);
begin
if FToday <> Value then
begin
FToday := Value;
Change;
end;
end;
procedure TJvCustomMonthCalendar.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
function TJvCustomMonthCalendar.GetTodayWidth: Integer;
begin
Result := SendMessage(Handle, MCM_GETMAXTODAYWIDTH, 0, 0);
end;
function TJvCustomMonthCalendar.VisibleMonths: Integer;
begin
Result := 1;
if not HandleAllocated then
Exit;
Result := MonthCal_GetMonthRange(Handle, GMR_DAYSTATE, nil);
end;
procedure TJvCustomMonthCalendar.SetDayStates(MonthCount: Integer; DayStates: array of TMonthDayState);
var
Index: Integer;
begin
if not HandleAllocated then
Exit;
Index := High(DayStates) - Low(DayStates);
if (Index < MonthCount) or (Index < VisibleMonths) then
raise EMonthCalError.CreateRes(@RsEInvalidArgumentToSetDayStates);
SendMessage(Handle, MCM_SETDAYSTATE, MonthCount, Longint(@DayStates));
end;
// first default width = 166
// next width = 334 (+ 168)
// next width = 502 (+ 168)
// next width = 670 (+ 168)
// first default height = 157
// next height = 299 (+ 142)
// next height = 441 (+ 142)
// next height = 583 (+ 142)
function TJvCustomMonthCalendar.GetMinSize: TRect;
begin
if HandleAllocated then
begin
SendMessage(Handle, MCM_GETMINREQRECT, 0, Longint(@Result));
OffSetRect(Result, -Result.Left, -Result.Top);
end
else
Result := Rect(0, 0, 191, 154);
end;
procedure TJvCustomMonthCalendar.CNNotify(var Msg: TWMNotify);
var
dFrom, dTo: TDateTime;
StateArray: TMonthDayStateArray;
begin
with Msg.NMHdr^ do
case Code of
MCN_GETDAYSTATE:
DoGetDayState(PNMDayState(Msg.NMHdr)^, StateArray);
MCN_SELCHANGE:
begin
if IsBlankDate(PNMSelChange(Msg.NMHdr)^.stSelStart) then
Exit;
with PNMSelChange(Msg.NMHdr)^.stSelStart do
dFrom := Trunc(EncodeDate(wYear, wMonth, wDay));
if IsBlankDate(PNMSelChange(Msg.NMHdr)^.stSelEnd) then
dTo := dFrom
else
with PNMSelChange(Msg.NMHdr)^.stSelEnd do
dTo := Trunc(EncodeDate(wYear, wMonth, wDay));
DoDateSelChange(dFrom, dTo);
end;
MCN_SELECT:
begin
if IsBlankDate(PNMSelChange(Msg.NMHdr)^.stSelStart) then
Exit;
with PNMSelChange(Msg.NMHdr)^.stSelStart do
dFrom := Trunc(EncodeDate(wYear, wMonth, wDay));
if IsBlankDate(PNMSelChange(Msg.NMHdr)^.stSelEnd) then
dTo := dFrom
else
with PNMSelChange(Msg.NMHdr)^.stSelEnd do
dTo := Trunc(EncodeDate(wYear, wMonth, wDay));
DoDateSelect(dFrom, dTo);
end;
end;
end;
procedure TJvCustomMonthCalendar.ConstrainedResize(var MinWidth, MinHeight,
MaxWidth, MaxHeight: Integer);
var
R: TRect;
CtlMinWidth, CtlMinHeight: Integer;
begin
if HandleAllocated then
begin
MonthCal_GetMinReqRect(Handle, R);
with R do
begin
CtlMinHeight := Bottom - Top;
CtlMinWidth := Right - Left;
end;
if MinHeight < CtlMinHeight then
MinHeight := CtlMinHeight;
if MinWidth < CtlMinWidth then
MinWidth := CtlMinWidth;
end;
inherited ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
end;
function TJvCustomMonthCalendar.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
var
R: TRect;
begin
if HandleAllocated then
begin
Result := True;
R := MinSize;
with R do
begin
NewWidth := Right - Left + Ord(BorderStyle = bsSingle) * 2;
NewHeight := Bottom - Top + Ord(BorderStyle = bsSingle) * 2;
end;
end
else
Result := False;
end;
procedure TJvCustomMonthCalendar.GetDlgCode(var Code: TDlgCodes);
begin
Code := [dcWantArrows];
end;
procedure TJvCustomMonthCalendar.WMLButtonDown(var Msg: TWMLButtonDown);
begin
SetFocus;
inherited;
end;
function TJvCustomMonthCalendar.GetBoldDays: TStrings;
begin
Result := FAppearance.BoldDays;
end;
function TJvCustomMonthCalendar.GetCircleToday: Boolean;
begin
Result := FAppearance.CircleToday;
end;
function TJvCustomMonthCalendar.GetColors: TJvMonthCalColors;
begin
Result := FAppearance.Colors;
end;
function TJvCustomMonthCalendar.GetShowToday: Boolean;
begin
Result := FAppearance.ShowToday;
end;
function TJvCustomMonthCalendar.GetWeekNumbers: Boolean;
begin
Result := FAppearance.WeekNumbers;
end;
function TJvCustomMonthCalendar.GetFirstDayOfWeek: TJvMonthCalWeekDay;
begin
Result := FAppearance.FirstDayOfWeek;
end;
procedure TJvCustomMonthCalendar.FocusKilled(NextWnd: HWND);
begin
FLeaving := True;
try
inherited FocusKilled(NextWnd);
DoFocusKilled(FindControl(NextWnd));
finally
FLeaving := False;
end;
end;
procedure TJvCustomMonthCalendar.FocusSet(PrevWnd: HWND);
begin
FEntering := True;
try
inherited FocusSet(PrevWnd);
DoFocusSet(FindControl(PrevWnd));
finally
FEntering := False;
end;
end;
procedure TJvCustomMonthCalendar.DoFocusSet(const APreviousControl: TWinControl);
begin
if Assigned(OnSetFocus) then
OnSetFocus(Self, APreviousControl);
end;
procedure TJvCustomMonthCalendar.DoFocusKilled(const ANextControl: TWinControl);
begin
if Assigned(OnKillFocus) then
OnKillFocus(Self, ANextControl);
end;
//=== { TJvMonthCalAppearance } ==============================================
constructor TJvMonthCalAppearance.Create;
begin
inherited Create;
FCircleToday := True;
FColors := TJvMonthCalColors.Create(nil);
FBoldDays := TMonthCalStrings.Create;
FShowToday := True;
FWeekNumbers := False;
FFirstDoW := mcLocale;
end;
destructor TJvMonthCalAppearance.Destroy;
begin
FreeAndNil(FColors);
FreeAndNil(FBoldDays);
inherited Destroy;
end;
function TJvMonthCalAppearance.GetCalendar: TJvCustomMonthCalendar;
begin
Result := FColors.Calendar;
end;
function TJvMonthCalAppearance.GetBoldDays: TStrings;
begin
Result := FBoldDays;
end;
procedure TJvMonthCalAppearance.SetBoldDays(const AValue: TStrings);
begin
FBoldDays.Assign(AValue);
if Assigned(Calendar) then
Calendar.DoBoldDays;
end;
procedure TJvMonthCalAppearance.SetCalendar(const AValue: TJvCustomMonthCalendar);
begin
FColors.Calendar := AValue;
TMonthCalStrings(FBoldDays).Calendar := AValue;
end;
procedure TJvMonthCalAppearance.SetCircleToday(const AValue: Boolean);
begin
if FCircleToday <> AValue then
begin
FCircleToday := AValue;
if Assigned(Calendar) then
Calendar.RecreateWnd;
end;
end;
procedure TJvMonthCalAppearance.SetColors(const AValue: TJvMonthCalColors);
begin
FColors.Assign(AValue);
end;
procedure TJvMonthCalAppearance.SetFirstDoW(
const AValue: TJvMonthCalWeekDay);
begin
if FFirstDoW <> AValue then
begin
FFirstDoW := AValue;
if Assigned(Calendar) then
Calendar.Change;
end;
end;
procedure TJvMonthCalAppearance.SetShowToday(const AValue: Boolean);
begin
if FShowToday <> AValue then
begin
FShowToday := AValue;
if Assigned(Calendar) then
Calendar.RecreateWnd;
end;
end;
procedure TJvMonthCalAppearance.SetWeekNumbers(const AValue: Boolean);
begin
if FWeekNumbers <> AValue then
begin
FWeekNumbers := AValue;
if Assigned(Calendar) then
Calendar.RecreateWnd;
end;
end;
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -