jvqtimeline.pas

East make Tray Icon in delphi

procedure TJvCustomTimeLine.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  ReselectFocusedNode: Boolean;
  FNewDate: TDateTime;
  FNewLevel: Integer;
begin
  if (Button = mbLeft) and (tlMouseDown in FStates) then
    Exclude(FStates, tlMouseDown)
  else
  begin
    inherited MouseUp(Button, Shift, X, Y);
    Exit;
  end;

  //OutputDebugString('MouseUp');
  if not (tlDragPending in FStates) then
  begin
    // Don't respond to right/mid clicks
    if not (tlMouseDown in FStates) then
      MoveDragLine(-1);

    if tlClearPending in FStates then
    begin
      ReselectFocusedNode := Assigned(FSelectedItem) and FSelectedItem.Selected;
      ClearSelection;
      if ReselectFocusedNode then
        AddToSelection(FSelectedItem);
      Invalidate;
    end;
    if Assigned(FSelectedItem) and HasMoved(Point(X, Y)) then
    begin
      FNewDate := DateAtPos(X);
      FNewLevel := LevelAtPos(Y);
      ItemMoved(FSelectedItem, FNewDate, FNewLevel);
      FSelectedItem.Date := FNewDate;
      FSelectedItem.Level := FNewLevel;
      Invalidate;
    end;
    FStates := FStates - [tlClearPending];
  end;
  //else
    //OutputDebugString('Drag pending');

  inherited MouseUp(Button, Shift, X, Y);
  FAutoDrag := False;
end;

procedure TJvCustomTimeLine.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if (FStates * [tlDragging, tlMouseDown] <> []) and FLineVisible and FAutoDrag then
  begin
    //OutputDebugString('Move MouseDown');
    MoveDragLine(X);
  end;
  UpdateItemHint(X,Y);
  if not ItemMouseMove(X, Y) then
    inherited MouseMove(Shift, X, Y);
end;

procedure TJvCustomTimeLine.DrawDragLine(X: Integer);
begin
  if not DragLine then
    Exit;
  FCanvas.MoveTo(X, 0);
  FCanvas.LineTo(X, ClientHeight);
end;

procedure TJvCustomTimeLine.MoveDragLine(ANewX: Integer);
begin
  if FOldX <> ANewX then
  begin
    //OutputDebugString(PChar(Format('Old %D New %D', [FOldx, ANewX])));

    // We're drawing directly on the canvas, thus everytime the screen is
    // updated (because for example an item is selected) it may erase
    // some of the lines we already have drawn
    //
    // Thus call UpdateWindow(Handle) (same effect as Repaint) which will
    // draw all outstanding paint events.
    //
    // The screen will then not be updated until we release the mouse.

    if FOldX = -1 then
      UpdateWindow(Handle);

    if FOldX <> -1 then
      DrawDragLine(FOldX);

    if ANewX <> -1 then
      DrawDragLine(ANewX);

    FOldX := ANewX;
  end;
end;

procedure TJvCustomTimeLine.AutoLevels(Complete, ResetLevels: Boolean);
var
  I, J, K, Count: Integer;
begin
  if csDestroying in ComponentState then
    Exit;
  BeginUpdate;
  try
    FList.Clear;

    Count := Items.Count - 1;
    for I := 0 to Count do
    begin
      if ResetLevels then
      begin
        Items[I].Level := 0;
        UpdateItem(Items[I].Index, Canvas);
      end;
      FList.Add(Items[I]);
    end;

    FList.Sort(DateCompare);

    for I := 0 to Count do
    begin
      if Complete then
        K := 0
      else
        K := I + 1;
      for J := K to Count do
        if RectInRect(TJvTimeItem(FList[I]).FRect, TJvTimeItem(FList[J]).FRect) and
          (FList[I] <> FList[J]) then
        begin
          TJvTimeItem(FList[J]).Level := TJvTimeItem(FList[J]).Level + 1;
          UpdateItem(TJvTimeItem(FList[J]).Index, Canvas);
        end;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TJvCustomTimeLine.HighLiteItem(Item: TJvTimeItem);
begin
  if Assigned(Item) and not (csDestroying in ComponentState) then
  begin
    Item.Selected := True;
    UpdateItem(Item.Index, Canvas);
  end;
end;

function TJvCustomTimeLine.LevelAtPos(Pos: Integer): Integer;
begin
  if Pos <= FItemOffset then
    Result := FTopLevel
  else
    Result := (Pos - FItemOffset) div FItemHeight + FTopLevel
end;

function TJvCustomTimeLine.ItemAtPos(X, Y: Integer): TJvTimeItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FTimeItems.Count - 1 do
    if PtInRect(FTimeItems[I].FRect, Point(X, Y)) then
    begin
      Result := FTimeItems[I];
      Exit;
    end;
end;

procedure TJvCustomTimeLine.DrawDays(ACanvas: TCanvas; Days, StartAt: Integer);
var
  aDay, aStop, aStart: Extended;
  I: Integer;
begin
  if csDestroying in ComponentState then
    Exit;
  aDay := FMonthWidth / Days;
  aStop := FMonthWidth;
  aStart := aDay;
  ACanvas.Pen.Width := 1;
  ACanvas.Pen.Style := psSolid;

  if FMonthWidth >= 360 then
    DrawDayNumbers(ACanvas, Days, StartAt);
  I := 1;
  while (aStart < aStop) and (I < Days) do
  begin
    ACanvas.MoveTo(Trunc(StartAt + aStart), FTopOffset);
    ACanvas.LineTo(Trunc(StartAt + aStart), FTopOffset + FDayLineLength);
    aStart := aStart + aDay;
    Inc(I);
  end;
end;

procedure TJvCustomTimeLine.DrawDayNumbers(ACanvas: TCanvas; Days, StartAt:
  Integer);
var
  I: Integer;
  LRect: TRect;
  DayWidth: Extended;
  sDay: string;
begin
  if csDestroying in ComponentState then
    Exit;
  ACanvas.Font.Size := Font.Size - 2;
  DayWidth := FMonthWidth / Days;
  with ACanvas do
    for I := 1 to Days do
    begin
      sDay := IntToStr(I);
      LRect.Left := Round((I - 1) * DayWidth) + (StartAt + Round(DayWidth) div 2
        - TextWidth(sDay) div 2);
      LRect.Right := LRect.Left + TextWidth(sDay);
      LRect.Top := FTopOffset + FDayTextTop;
      LRect.Bottom := LRect.Top + TextHeight(sDay);  
      DrawText(ACanvas, sDay, Length(sDay), LRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE); 

    end;
  ACanvas.Font.Size := Font.Size + 2;
end;

procedure TJvCustomTimeLine.DrawMonth(ACanvas: TCanvas; StartAt, M: Integer);
begin
  if csDestroying in ComponentState then
    Exit;
  ACanvas.Pen.Width := 1;
  if (FYearWidth >= 140) or (M mod 3 = 1) then
    { draw every month only if it fits }
  begin
    ACanvas.MoveTo(StartAt, FTopOffset);
    ACanvas.LineTo(StartAt, FTopOffset + FMonthLineLength);
  end;
  ACanvas.Pen.Width := 1;
end;

procedure TJvCustomTimeLine.DrawMonthName(ACanvas: TCanvas; Month, StartAt:
  Integer);
var
  LRect: TRect;
  AName: string;
begin
  if csDestroying in ComponentState then
    Exit;
  if FMonthWidth > 120 then
    AName := LongMonthNames[Month]
  else
    AName := ShortMonthNames[Month];

  with ACanvas do
  begin
    ACanvas.Font.Assign(Self.Font);
    LRect.Left := StartAt + Round(FMonthWidth) div 2 - TextWidth(AName) div 2;
    LRect.Right := LRect.Left + TextWidth(AName);
    LRect.Top := FTopOffset + FMonthTextTop;
    LRect.Bottom := LRect.Top + TextHeight(AName);  
    DrawText(ACanvas, AName, -1, LRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE); 
  end;
end;

procedure TJvCustomTimeLine.DrawYear(ACanvas: TCanvas; StartAt: Integer; YR: string);
var
  LRect: TRect;
begin
  if csDestroying in ComponentState then
    Exit;
  ACanvas.Font := FYearFont;
  ACanvas.Pen.Width := 1;
  if FYearWidth <= 96 then
    YR := Copy(YR, Length(YR) - 1, Length(YR)); { skip 100's }
  LRect.Left := StartAt - ACanvas.TextWidth(YR) div 2;
  LRect.Top := FTopOffset + FYearTextTop;
  LRect.Right := StartAt + ACanvas.TextWidth(YR) div 2;
  LRect.Bottom := LRect.Top + ACanvas.TextHeight(YR);
  { draw vertical line }
  ACanvas.MoveTo(StartAt, FTopOffset);
  ACanvas.LineTo(StartAt, FTopOffset + FYearLineLength);
  { draw text }
  SetBkMode(ACanvas.Handle, Transparent);
  DrawText(ACanvas.Handle, PChar(YR), Length(YR), LRect,
    DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  with ACanvas.Pen do
  begin
    Width := 1;
    Style := psSolid;
  end;
end;

procedure TJvCustomTimeLine.DrawHorzSupports(ACanvas: TCanvas);
var
  I, J: Integer;
  Tmp: TColor;
begin
  if csDestroying in ComponentState then
    Exit;
  UpdateOffset;
  I := 0;
  J := FItemOffset - 4;
  Tmp := ACanvas.Pen.Color;
  ACanvas.Pen.Color := SupportsColor;
  while I < ClientWidth do
  begin
    ACanvas.MoveTo(I, FTopOffset + Abs(ACanvas.Font.Height) + 8);
    ACanvas.LineTo(I, ClientHeight);
    I := ClientWidth + 1;
    while J < ClientHeight do
    begin
      ACanvas.MoveTo(0, J);
      ACanvas.LineTo(ClientWidth, J);
      Inc(J, ItemHeight);
    end;
  end;
  ACanvas.Pen.Color := Tmp;
end;

procedure TJvCustomTimeLine.DrawVertSupport(ACanvas: TCanvas; StartAt: Integer);
var
  Tmp: TColor;
begin
  if csDestroying in ComponentState then
    Exit;
  UpdateOffset;
  with ACanvas do
  begin
    Tmp := Pen.Color;
    Pen.Color := SupportsColor;
    Pen.Width := 1;
    MoveTo(StartAt, FItemOffset - 4);
    LineTo(StartAt, Height);
    Pen.Color := Tmp;
  end;
end;

procedure TJvCustomTimeLine.DrawTimeLine(ACanvas: TCanvas);
var
  Y, M, D: Word;
  I, fYr: Integer;
  FirstYear: Boolean;
  LastDate: TDateTime;
  R: TRect;
  aShadowLeft, aShadowRight: string;

  procedure AdjustYears(var Y, M: Word);
  begin
    if M = 13 then
    begin
      Inc(Y);
      M := 1;
    end
    else
    if M = 0 then
    begin
      Dec(Y);
      M := 12;
    end;
  end;

begin
  if csDestroying in ComponentState then
    Exit;
  FYearList.Clear;
  UpdateOffset;
  { draw the top horizontal line }
  with ACanvas do
  begin
    Font := Self.Font;
    Brush.Color := Color;
    Pen.Color := Self.Font.Color;
    FillRect(ClientRect);
    MoveTo(0, FTopOffset);
    LineTo(Width, FTopOffset);
    //    MoveTo(0, FTopOffset - 1);
    //    LineTo(Width, FTopOffset - 1);
  end;

  { draw years and months }
  I := 0;
  DecodeDate(FFirstDate, Y, M, D);
  aShadowLeft := IntToStr(Y);
  fYr := Y;
  DecodeDate(GetLastDate, Y, M, D);
  aShadowRight := IntToStr(Y);
  SetBkMode(ACanvas.Handle, TRANSPARENT);
  LastDate := FFirstDate;
  FirstYear := True;
  while LastDate <= (GetLastDate + 5) do
  begin
    DecodeDate(LastDate, Y, M, D);
    if M <> 1 then
    begin { not a new year, so it's a month }
      DrawMonth(ACanvas, I, M);
      if FSupportLines and ((FYearWidth >= 140) or (M mod 3 = 1)) then
        DrawVertSupport(ACanvas, I);
      if FShowMonths and (FYearWidth >= 140) then
        DrawMonthName(ACanvas, M, I);
      if FShowDays and (FYearWidth >= 1200) then
        DrawDays(ACanvas, MonthDays[IsLeapYear(Y), M], I);
    end
    else
    begin { this is a new year }
      FYearList.Add(Pointer(I));
      if FirstYear then
      begin
        fYr := Y;
        FirstYear := False;
      end;
      if FSupportLines then
        DrawVertSupport(ACanvas, I);
      { draw text for january here }
      if FShowMonths and (FYearWidth >= 144) then
        DrawMonthName(ACanvas, M, I);
      if FShowDays and (FYearWidth >= 1200) then
        DrawDays(ACanvas, MonthDays[IsLeapYear(Y), M], I);
    end;
    Inc(I, Trunc(FMonthWidth));

    Inc(M);
    AdjustYears(Y, M);
    LastDate := EncodeDate(Y, M, 1);
  end;

  { draw years after all the others }
  if FHelperYears then
  begin
    ACanvas.Font := Self.Font;
    R := Rect(4, 4, ACanvas.TextWidth(aShadowLeft) + 8, FTopOffset);
    DrawText(ACanvas.Handle, PChar(aShadowLeft), -1, R, DT_VCENTER or
      DT_SINGLELINE);
    ACanvas.Font := Self.Font;
    R := Rect(Width - (ACanvas.TextWidth(aShadowRight) + 8), 4, Width,
      FTopOffset);
    DrawText(ACanvas.Handle, PChar(aShadowRight), -1, R,
      DT_VCENTER or DT_SINGLELINE);
  end;
  for I := 0 to FYearList.Count - 1 do
  begin
    DrawYear(ACanvas, Integer(FYearList[I]), IntToStr(fYr));
    Inc(fYr);
  end;
  if HorzSupports then
    DrawHorzSupports(ACanvas);
  UpdateItems;
  DrawScrollButtons;
  if FShowHiddenItemHints then
  begin
    DrawLeftItemHint(ACanvas);
    DrawRightItemHint(ACanvas);
  end;
end;

procedure TJvCustomTimeLine.DrawLeftItemHint(ACanvas: TCanvas);
var
  R: TRect;
begin
  if csDestroying in ComponentState then
    Exit;
  if HasItemsToLeft then
  begin
    R := FArrows[scrollLeft].BoundsRect;
    OffsetRect(R, 0, -FItemHintImageList.Height - 2);
    FItemHintImageList.Draw(ACanvas, R.Left, R.Top, 0);
    //    R := Rect(FScrollEdgeOffset,Height - FScrollEdgeOffset - FScrollHeight * 2,Width,
    //      Height);
    //    SetBkMode(ACanvas.Handle,TRANSPARENT);