jvqtimeline.pas

East make Tray Icon in delphi

    property OnLoadItem;
    property OnItemMoved;
    property OnItemMouseMove;
    property OnItemMoving;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Math, 
  DateUtils, 
  JvQJVCLUtils, JvQConsts, JvQThemes;

{$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

// 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;



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);

begin
  if TimeLine = nil then
    Exit;
  if not Visible then
    Exit;
 
    //  TimeLine.FSelectedItem := nil; { fixes begindrag bug ? }
    DrawFrameControl(Canvas.Handle, Rect(0, 0, Width, Height), DFC_SCROLL,
      CFlat[Flat] or CPushed[FPushed] or Directions[Direction]);
end;

procedure TJvTLScrollBtn.UpdatePlacement;
begin
  if TimeLine = nil then
    Exit;
  TimeLine.UpdateOffset;
  case FDirection of
    scrollLeft:
      begin
        SetBounds(FScrollEdgeOffset, TimeLine.Height - FScrollEdgeOffset -
          TimeLine.FScrollHeight,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akLeft, akBottom];
      end;
    scrollRight:
      begin
        SetBounds(TimeLine.Width - FScrollEdgeOffset - TimeLine.FScrollWidth * 2,
          TimeLine.Height - FScrollEdgeOffset - TimeLine.FScrollHeight,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akRight, akBottom];
      end;
    scrollUp:
      begin
        Anchors := [];
        SetBounds(TimeLine.Width - FScrollEdgeOffset - TimeLine.FScrollWidth,
          TimeLine.FItemOffset + FScrollEdgeOffset,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akRight, akTop];
      end;
    scrollDown:
      begin
        SetBounds(TimeLine.Width - FScrollEdgeOffset - TimeLine.FScrollWidth,
          TimeLine.Height - FScrollEdgeOffset - TimeLine.FScrollHeight * 2,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akRight, akBottom];
      end;
  end;
end;

procedure TJvTLScrollBtn.SetDirection(const Value: TJvScrollArrow);
begin
  FDirection := Value;
  if (TimeLine <> nil) and (TimeLine.Parent <> nil )then
  begin
    UpdatePlacement;
    Invalidate;
  end;
end;

procedure TJvTLScrollBtn.SetFlat(const Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TJvTLScrollBtn.SeTJvTimeLine(const Value: TJvCustomTimeLine);
begin
  FTimeLine := Value;
  Invalidate;
end;

procedure TJvTLScrollBtn.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if RepeatClick then
  begin
    if FTimer = nil then
      FTimer := TTimer.Create(Self);

    FTimer.OnTimer := OnTimer;
    FTimer.Interval := FInitRepeatPause;
    FTimer.Enabled := True;
  end;
  FPushed := True;
  Invalidate;
  //  Click;
end;

procedure TJvTLScrollBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  FPushed := False;
  Invalidate;
  if FTimer <> nil then
    FTimer.Enabled := False;
end;

procedure TJvTLScrollBtn.Click;
var
  ScrollPos: Integer;
  ScrollCode: TScrollCode;
  ShiftState: TShiftState; 

  function GetScrollCode(LargeChange: Boolean): TScrollCode;
  begin
    case Direction of
      scrollLeft:
        if LargeChange then
          Result := scPageUp
        else
          Result := scLineUp;
      scrollRight:
        if LargeChange then
          Result := scPageDown
        else
          Result := scLineDown;
      scrollUp: Result := scLineUp;
    else
      Result := scLineDown;
    end;
  end;

begin
  if TimeLine = nil then
    Exit;