jvtimeline.pas

East make Tray Icon in delphi

procedure TJvCustomTimeLine.SetTimeItems(Value: TJvTimeItems);
begin
  FTimeItems.Assign(Value);
end;

procedure TJvCustomTimeLine.SetImages(Value: TCustomImageList);
begin
  if FImages <> Value then
  begin
    if FImages <> nil then
    begin
      FImages.RemoveFreeNotification(Self);
      FImages.UnRegisterChanges(FImageChangeLink);
    end;
    FImages := Value;
    if FImages <> nil then
    begin
      FImages.FreeNotification(Self);
      FImages.RegisterChanges(FImageChangeLink);
    end;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetSelectedItem(Value: TJvTimeItem);
begin
  if FSelectedItem <> Value then
  begin
    if Value <> nil then
      Value.Selected := True;
    UpdateItems;
  end;
end;

procedure TJvCustomTimeLine.SetStyle(Value: TJvTimeLineStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetItemHeight(Value: Integer);
begin
  if FItemHeight <> Value then
  begin
    FItemHeight := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetShowMonths(Value: Boolean);
begin
  if FShowMonths <> Value then
  begin
    FShowMonths := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetShowDays(Value: Boolean);
begin
  if FShowDays <> Value then
  begin
    FShowDays := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetSupportLines(Value: Boolean);
begin
  if FSupportLines <> Value then
  begin
    FSupportLines := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.ImagesChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvCustomTimeLine.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FImages) then
    Images := nil;
end;

procedure TJvCustomTimeLine.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  // Copied a lot from (Mike Linschke's) virtualtree.
  // Some stuff maybe unnecessairy or overkill/wrong.

    IsHit, // the node's caption or images are hit
    ItemSelected, // the new node (if any) is selected
    ShiftEmpty: Boolean; // ShiftState = []
  ShiftState: TShiftState;
  LastSelected: TJvTimeItem;
  LSelectedItem: TJvTimeItem;
begin
  //OutputDebugString('MouseDown');
  if Button = mbLeft then
    Include(FStates, tlMouseDown);

  // Get the currently focused node to make multiple multi-selection blocks possible.
  LastSelected := FSelectedItem;
  ShiftState := Shift * [ssCtrl, ssShift];
  ShiftEmpty := ShiftState = [];
  FAutoDrag := (DragMode = dmAutomatic) or Dragging;
  LSelectedItem := ItemAtPos(X, Y);
  IsHit := Assigned(LSelectedItem);
  ItemSelected := IsHit; // and LSelectedItem.Selected;

  if ItemSelected and ItemMoving(LSelectedItem) then
  begin
    FStartPos := Point(X, Y);
    FLineVisible := True;
  end
  else
    LSelectedItem := nil;

  // pending clearance
  if MultiSelect and ShiftEmpty and IsHit and FAutoDrag then
    Include(FStates, tlClearPending);


  if (not IsHit and MultiSelect and ShiftEmpty) or
    (IsHit and (ShiftEmpty or not MultiSelect)) then
  begin
    if ItemSelected then
    begin
      ClearSelection;
      AddToSelection(LSelectedItem);
    end
    else
      ClearSelection;
  end;

  // focus change
  if not Focused and CanFocus then
    SetFocus;

  // Handle selection and node focus change.
  if IsHit then
  begin
    if MultiSelect and not Dragging and not ShiftEmpty then
      HandleClickSelection(LastSelected, LSelectedItem, ShiftState)
    else
    begin
      if ShiftEmpty then
        FRangeAnchor := LSelectedItem;

      // If the hit node is not yet selected then do it now.
      if not ItemSelected then
        AddToSelection(LSelectedItem);
    end;

    // Drag'n drop initiation
    // If we lost focus in the interim the button states would be cleared in WM_KILLFOCUS.
    if FAutoDrag then
      BeginDrag(False);
  end;

  inherited MouseDown(Button, Shift, X, Y);

  if (Dragging or FAutoDrag) and FLineVisible and (tlMouseDown in FStates) and
    not (tlDragPending in FStates) then
    MoveDragLine(X);
end;

function TJvCustomTimeLine.HasMoved(P: TPoint): Boolean;
begin
  Result := FAutoDrag or Dragging and ((Abs(FStartPos.X - P.X) > 10) or (Abs(FStartPos.Y - P.Y) > ItemHeight div 2));
end;

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);
      {$IFDEF VCL}
      DrawText(ACanvas.Handle, PChar(sDay), -1, LRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      DrawText(ACanvas, sDay, Length(sDay), LRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      {$ENDIF VisualCLX}

    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);
    {$IFDEF VCL}
    DrawText(ACanvas.Handle, PChar(AName), -1, LRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    DrawText(ACanvas, AName, -1, LRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    {$ENDIF VisualCLX}
  end;
end;

procedure TJvCustomTimeLine.DrawYear(ACanvas: TCanvas; StartAt: Integer; YR: string);
var
  LRect: TRect;
begin