jvtfmonths.pas

East make Tray Icon in delphi

    TxtRect := R;
    Windows.InflateRect(TxtRect, -1, -1);

    with ACanvas do
    begin
      Brush.Color := DWTitleAttr.Color;
      FillRect(R);

      case DWTitleAttr.FrameAttr.Style of
        fs3DRaised:
          Draw3DFrame(ACanvas, R, clBtnHighlight, clBtnShadow);
        fs3DLowered:
          Draw3DFrame(ACanvas, R, clBtnShadow, clBtnHighlight);
        fsFlat:
          begin
            Pen.Color := DWTitleAttr.FrameAttr.Color;
            Pen.Width := DWTitleAttr.FrameAttr.Width;
            if Col = 0 then
            begin
              MoveTo(R.Left, R.Top);
              LineTo(R.Left, R.Bottom);
            end;
            PolyLine([Point(R.Right - 1, R.Top),
              Point(R.Right - 1, R.Bottom - 1),
                Point(R.Left - 1, R.Bottom - 1)]);
          end;
        fsNone:
          begin
            Pen.Color := DWTitleAttr.FrameAttr.Color;
            Pen.Width := 1;
            LineBottom := R.Bottom - 1;
            for I := 1 to DWTitleAttr.FrameAttr.Width do
            begin
              MoveTo(R.Left, LineBottom);
              LineTo(R.Right, LineBottom);
              Dec(LineBottom);
            end;
          end;
      end;

      Txt := DWNames.GetDWName(DOWToBorl(CurrDOW));
      if SplitSatSun and (CurrDOW = dowSaturday) then
      begin
        IncDOW(CurrDOW, 1);
        Txt := Txt + '/' + DWNames.GetDWName(DOWToBorl(CurrDOW));
      end;

      Font := DWTitleAttr.TxtAttr.Font;
      DrawAngleText(ACanvas, TxtRect, TextBounds,
        DWTitleAttr.TxtAttr.Rotation,
        DWTitleAttr.TxtAttr.AlignH,
        DWTitleAttr.TxtAttr.AlignV, Txt);
    end;

    if Assigned(FOnDrawDWTitle) then
      FOnDrawDWTitle(Self, ACanvas, R, CurrDOW, Txt);

    IncDOW(CurrDOW, 1);
  end;

  with ACanvas do
  begin
    Pen.Assign(OldPen);
    Brush.Assign(OldBrush);
    Font.Assign(OldFont);
    OldPen.Free;
    OldBrush.Free;
    OldFont.Free;
  end;
end;

procedure TJvTFMonths.DWNamesChange(Sender: TObject);
begin
  Invalidate;
end;

function TJvTFMonths.GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr;
begin
  if CellIsSelected(ACell) then
    Result := SelCellAttr
  else
  if CellIsExtraDay(ACell) then
    Result := ExtraDayCellAttr
  else
  if CellIsOffDay(ACell) then
    Result := OffDayCellAttr
  else
    Result := CellAttr;
end;

function TJvTFMonths.GetCellTitleText(Cell: TJvTFGlanceCell): string;
begin
  if CellIsExtraDay(Cell) and (IsFirstOfMonth(Cell.CellDate) or
    EqualDates(Cell.CellDate, OriginDate)) then
    Result := FormatDateTime('mmm d', Cell.CellDate)
  else
    Result := FormatDateTime('d', Cell.CellDate);
end;

function TJvTFMonths.GetDataTop: Integer;
begin
  Result := inherited GetDataTop;
  if DWTitleAttr.Visible then
    Inc(Result, DWTitleAttr.Height);
end;

function TJvTFMonths.GetMonth: Word;
begin
  Result := ExtractMonth(DisplayDate);
end;

function TJvTFMonths.GetYear: Word;
begin
  Result := ExtractYear(DisplayDate);
end;

procedure TJvTFMonths.Navigate(AControl: TJvTFControl;
  SchedNames: TStringList; Dates: TJvTFDateList);
begin
  inherited Navigate(AControl, SchedNames, Dates);
  if Dates.Count > 0 then
    DisplayDate := Dates[0];
end;

procedure TJvTFMonths.NextMonth;
var
  Temp: TDateTime;
begin
  Temp := DisplayDate;
  IncMonths(Temp, 1);
  DisplayDate := Temp;
end;

procedure TJvTFMonths.NextWeek;
var
  Temp: TDateTime;
begin
  Temp := DisplayDate;
  IncWeeks(Temp, 1);
  DisplayDate := Temp;
end;

procedure TJvTFMonths.PrevMonth;
var
  Temp: TDateTime;
begin
  Temp := DisplayDate;
  IncMonths(Temp, -1);
  DisplayDate := Temp;
end;

procedure TJvTFMonths.PrevWeek;
var
  Temp: TDateTime;
begin
  Temp := DisplayDate;
  IncWeeks(Temp, -1);
  DisplayDate := Temp;
end;

procedure TJvTFMonths.ScrollNext;
begin
  if ScrollSize = mssMonth then
    NextMonth
  else
    NextWeek;
end;

procedure TJvTFMonths.ScrollPrev;
begin
  if ScrollSize = mssMonth then
    PrevMonth
  else
    PrevWeek;
end;

procedure TJvTFMonths.SetColCount(Value: Integer);
begin
  Value := Lesser(Value, 7);
  inherited SetColCount(Value);
end;

procedure TJvTFMonths.SetDisplayDate(Value: TDate);
begin
  FDisplayDate := Value;
  if ScrollSize = mssMonth then
    StartDate := FirstOfMonth(Value)
  else
    StartDate := Value;
  UpdateTitle;
end;

procedure TJvTFMonths.SetDWNames(Value: TJvTFDWNames);
begin
  FDWNames.Assign(Value);
end;

procedure TJvTFMonths.SetDWTitleAttr(Value: TJvTFGlanceTitle);
begin
  FDWTitleAttr.Assign(Value);
end;

procedure TJvTFMonths.SetExtraDayCellAttr(Value: TJvTFGlanceCellAttr);
begin
  FExtraDayCellAttr.Assign(Value);
end;

procedure TJvTFMonths.SetMonth(Value: Word);
var
  Y, M, D: Word;
begin
  EnsureMonth(Value);

  DecodeDate(DisplayDate, Y, M, D);
  if Value <> M then
    DisplayDate := EncodeDate(Y, Value, D);
end;

procedure TJvTFMonths.SetOffDayCellAttr(Value: TJvTFGlanceCellAttr);
begin
  FOffDayCellAttr.Assign(Value);
end;

procedure TJvTFMonths.SetOffDays(Value: TTFDaysOfWeek);
begin
  if Value <> FOffDays then
  begin
    FOffDays := Value;
    Invalidate;
  end;
end;

procedure TJvTFMonths.SetSplitSatSun(Value: Boolean);
begin
  if Value <> FSplitSatSun then
  begin
    if DOWShowing(dowSunday) or DOWShowing(dowSaturday) then
      if Value then
      begin
        if StartOfWeek = dowSunday then
          StartOfWeek := dowMonday;
        ColCount := ColCount - 1;
      end
      else
        ColCount := ColCount + 1;

    FSplitSatSun := Value;
    Cells.ReconfigCells;
  end;
end;

procedure TJvTFMonths.SetStartOfWeek(Value: TTFDayOfWeek);
begin
  if SplitSatSun and (Value = dowSunday) then
    Value := dowSaturday;
  inherited SetStartOfWeek(Value);
end;

procedure TJvTFMonths.SetYear(Value: Word);
var
  Y, M, D: Word;
begin
  DecodeDate(DisplayDate, Y, M, D);
  if Value <> Y then
    DisplayDate := EncodeDate(Value, M, D);
end;

procedure TJvTFMonths.UpdateTitle;
var
  NewTitle: string;
begin
  NewTitle := FormatDateTime('mmmm yyyy', DisplayDate);
  if NewTitle <> TitleAttr.Title then
  begin
    if Assigned(FOnUpdateTitle) then
      FOnUpdateTitle(Self, NewTitle);
    TitleAttr.Title := NewTitle;
  end;
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.