jvtimeline.pas

East make Tray Icon in delphi

    property Hint;
    property Left;
    property PopupMenu;
    property ParentShowHint;
    property ShowHint;
    property Top;
    property Visible;
    property Width;
    property Font;
    property ScrollArrows;
    property TabStop;
    property TabOrder;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnDblClick;
    property OnClick;


    property BorderStyle;
    {$IFDEF VCL}
    property AutoSize;
    property DragCursor;
    property DragMode;
    property OnEndDrag;
    property OnStartDrag;
    property OnDragOver;
    property OnDragDrop;
    {$ENDIF VCL}
    property MultiSelect;
    property Flat;
    property YearFont;
    property YearWidth;
    property TopOffset;
    property ShowDays;
    property ShowHiddenItemHints;
    property ShowItemHint;
    property ShowMonthNames;
    property FirstVisibleDate;
    property Images;
    property Items;
    property ItemHeight;
    //    property ItemAlign;
    property VertSupports;
    property HorzSupports;
    property SupportsColor;
    property Style;
    property TopLevel;
    property OnItemClick;
    property OnItemDblClick;
    property OnSize;
    property OnHorzScroll;
    property OnVertScroll;
    property OnDrawItem;
    property OnMeasureItem;
    property OnSaveItem;
    property OnLoadItem;
    property OnItemMoved;
    property OnItemMouseMove;
    property OnItemMoving;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvTimeLine.pas,v $';
    Revision: '$Revision: 1.48 $';
    Date: '$Date: 2005/03/09 14:57:31 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Math,
  {$IFDEF COMPILER6_UP}
  DateUtils,
  {$ENDIF COMPILER6_UP}
  JvJVCLUtils, JvConsts, JvThemes;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvTimeLine.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvTimeLine.res}
{$ENDIF UNIX}

const
  FDayLineLength = 4;
  FDayTextTop = 5;
  FMonthLineLength = 10;
  FMonthTextTop = 24;
  FYearLineLength = 24;
  FYearTextTop = 32;
  FScrollEdgeOffset = 8;

var
  FInitRepeatPause: Cardinal = 140;
  FRepeatPause: Cardinal = 30;

function MonthCount(Date1, Date2: TDateTime): Integer;
var
  Y1, M1, D1, Y2, M2, D2: Word;
begin
  DecodeDate(Date1, Y1, M1, D1);
  DecodeDate(Date2, Y2, M2, D2);
  Result := (Y2 - Y1) * 12 + (M2 - M1);
  if (D1 = 1) and (D2 = 1) then
    Dec(Result);
end;

function PixelsForDays(Date: TDateTime; PixelsPerMonth: Integer): Integer;
var
  Y, M, D: Word;
begin
  DecodeDate(Date - 1, Y, M, D);
  Result := D * PixelsPerMonth div MonthDays[IsLeapYear(Y), M];
end;

function DateCompare(Item1, Item2: Pointer): Integer;
begin
  Result := Trunc(TJvTimeItem(Item1).Date - TJvTimeItem(Item2).Date);
end;

function RectInRect(const Rect1, Rect2: TRect): Boolean;
var
  R: TRect;
begin
  Result := IntersectRect(R, Rect1, Rect2);
end;

//PRY 2002.06.04
{$IFDEF COMPILER5}
function IncYear(const AValue: TDateTime;
  const ANumberOfYears: Integer): TDateTime;
begin
  Result := IncMonth(AValue, ANumberOfYears * 12);
end;
{$ENDIF COMPILER5}
// PRY END

//=== { TJvTimeItem } ========================================================

constructor TJvTimeItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FParent := TJvTimeItems(Collection);
  FEnabled := True;
  FCaption := '';
  FDate := Trunc(Now);
  FColor := clWindow;
  FTextColor := clBlack;
  FRect := Rect(0, 0, 0, 0);
  FSelected := False;
  FImageIndex := Collection.Count - 1;
  FLevel := FImageIndex;
  FWidth := 50;
  FStyle := asPixels;
  FImageOffset := 0;
  Update;
end;

destructor TJvTimeItem.Destroy;
begin
  inherited Destroy;
end;

procedure TJvTimeItem.Remove;
begin
  InvalidateRect(FParent.FTimeLine.Handle, @FRect, True);
  // (rom) suspicious
  inherited Free;
end;

procedure TJvTimeItem.Assign(Source: TPersistent);
begin
  if Source is TJvTimeItem then
  begin
    Caption := TJvTimeItem(Source).Caption;
    ImageIndex := TJvTimeItem(Source).ImageIndex;
    Date := TJvTimeItem(Source).Date;
    Level := TJvTimeItem(Source).Level;
    Width := TJvTimeItem(Source).Width;
    Hint := TJvTimeItem(Source).Hint;
    Color := TJvTimeItem(Source).Color;
    TextColor := TJvTimeItem(Source).TextColor;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTimeItem.Update;
begin
  InvalidateRect(FParent.FTimeLine.Handle, @FRect, True);
  FParent.FTimeLine.UpdateItem(Index, FParent.FTimeLine.Canvas);
  InvalidateRect(FParent.FTimeLine.Handle, @FRect, True);
end;

function TJvTimeItem.GetDisplayName: string;
begin
  Result := Caption;
  if Result = '' then
    Result := inherited GetDisplayName;
end;

procedure TJvTimeItem.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetImageOffset(Value: Integer);
begin
  if FImageOffset <> Value then
  begin
    FImageOffset := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetStyle(Value: TJvTimeItemType);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetSelected(Value: Boolean);
begin
  if FSelected <> Value then
  begin
    FSelected := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetDate(Value: TDateTime);
begin
  if FDate <> Value then
  begin
    FDate := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetCaption(Value: string);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetTextColor(Value: TColor);
begin
  if FTextColor <> Value then
  begin
    FTextColor := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetImageIndex(Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetWidth(Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Update;
  end;
end;

procedure TJvTimeItem.SetLevel(Value: Integer);
begin
  if FLevel <> Value then
  begin
    FLevel := Value;
    FParent.FTimeLine.Repaint;
  end;
end;

function TJvTimeItem.GetBounds(Index: Integer): Integer;
begin
  case Index of
    0:
      Result := FRect.Left;
    1:
      Result := FRect.Top;
  else
    Result := 0;
  end;
end;

procedure TJvTimeItem.SetBounds(Index: Integer; Value: Integer);
begin
  case Index of
    0:
      if FRect.Left <> Value then
      begin
        OffsetRect(FRect, Value - FRect.Left, 0);
        Date := FParent.FTimeLine.DateAtPos(FRect.Left);
        FParent.FTimeLine.Invalidate;
      end;
    1:
      if FRect.Top <> Value then
      begin
        FParent.FTimeLine.UpdateOffset;
        if Value < FParent.FTimeLine.FItemOffset then
          Value := FParent.FTimeLine.FItemOffset;
        OffsetRect(FRect, 0, Value - FRect.Top);
        Level := FParent.FTimeLine.LevelAtPos(FRect.Top);
        FParent.FTimeLine.Invalidate;
      end;
  end;
end;

//=== { TJvTimeItems } =======================================================

constructor TJvTimeItems.Create(TimeLine: TJvCustomTimeLine);
begin
  inherited Create(TJvTimeItem);
  FTimeLine := TimeLine;
end;

function TJvTimeItems.Add: TJvTimeItem;
begin
  Result := TJvTimeItem(inherited Add);
  Update(Result);
end;

procedure TJvTimeItems.Refresh;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].Update;
end;

function TJvTimeItems.GetItem(Index: Integer): TJvTimeItem;
begin
  Result := TJvTimeItem(inherited GetItem(Index));
end;

procedure TJvTimeItems.SetItem(Index: Integer; Value: TJvTimeItem);
begin
  inherited SetItem(Index, Value);
end;

function TJvTimeItems.GetOwner: TPersistent;
begin
  Result := FTimeLine;
end;

procedure TJvTimeItems.Update(Item: TCollectionItem);
begin
  if Item <> nil then
    FTimeLine.UpdateItem(Item.Index, FTimeLine.Canvas)
  else
    FTimeLine.UpdateItems;
end;

//=== { TJvTLScrollBtn } =====================================================

constructor TJvTLScrollBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csCaptureMouse, csClickEvents, csOpaque] -
    [csDoubleClicks];
end;

{$IFDEF JVCLThemesEnabled}

procedure TJvTLScrollBtn.MouseEnter(Control: TControl);
begin
  if ThemeServices.ThemesEnabled and not (FMouseInControl) and not (csDesigning in ComponentState) then
  begin
    FMouseInControl := True;
    Invalidate;
  end;
  inherited MouseEnter(Control);
end;

procedure TJvTLScrollBtn.MouseLeave(Control: TControl);
begin
  inherited MouseLeave(Control);
  if ThemeServices.ThemesEnabled and FMouseInControl then
  begin
    FMouseInControl := False;
    Invalidate;
  end;
end;

{$ENDIF JVCLThemesEnabled}

procedure TJvTLScrollBtn.Paint;
const
  Directions: array [TJvScrollArrow] of Integer =
    (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT, DFCS_SCROLLUP, DFCS_SCROLLDOWN);
  CFlat: array [Boolean] of Word = (0, DFCS_FLAT);
  CPushed: array [Boolean] of Word = (0, DFCS_PUSHED);
{$IFDEF JVCLThemesEnabled}
var
  Button: TThemedScrollBar;
  Details: TThemedElementDetails;
{$ENDIF JVCLThemesEnabled}
begin
  if TimeLine = nil then
    Exit;
  if not Visible then
    Exit;

  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
  begin
    if FPushed then
      Button := tsArrowBtnLeftPressed
    else
    if FMouseInControl then
      Button := tsArrowBtnLeftHot
    else
      Button := tsArrowBtnLeftNormal;

    case Direction of
      scrollRight:
        Button := TThemedScrollBar(Ord(tsArrowBtnRightNormal) + Ord(Button) - Ord(tsArrowBtnLeftNormal));
      scrollUp: