⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvcalendar.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:
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 + -