jvtimeline.pas

East make Tray Icon in delphi

  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);
    //    ACanvas.Font.Style := [fsBold];
    //    DrawText(ACanvas.Handle,PChar('...'),-1,R,DT_SINGLELINE or DT_NOCLIP or DT_NOPREFIX);
    //    ACanvas.TextRect(R,R.Left,R.Top,'...');
    (*    // this should be 32 pixels high:
        UpdateOffset;
        R := Rect(4, FItemOffset div 2 - 8, 8, FItemOffset div 2 + 8);
        //    R := Rect(2,FItemOffset * 2,6,ClientHeight - FItemOffset * 2);
        ACanvas.Brush.Color := clNavy;
        ACanvas.FillRect(R); *)
  end;
end;

procedure TJvCustomTimeLine.DrawRightItemHint(ACanvas: TCanvas);
var
  R: TRect;
begin
  if csDestroying in ComponentState then
    Exit;
  if HasItemsToRight then
  begin
    R := FArrows[scrollRight].BoundsRect;
    OffsetRect(R, 0, -FItemHintImageList.Height - 2);
    FItemHintImageList.Draw(ACanvas, R.Left, R.Top, 1);
  end;
end;

procedure TJvCustomTimeLine.DrawFocus;
var
  Tmp: TColor;
  // R: TRect;
begin
  if csDestroying in ComponentState then
    Exit;
  with Canvas do
  begin
    Tmp := Pen.Color;
    Pen.Color := clNavy;
    Pen.Width := 2;
    Brush.Style := bsClear;
    Rectangle(1, 1, ClientWidth, ClientHeight);
    Pen.Color := Tmp;
    Pen.Width := 1;
  end;
end;

procedure TJvCustomTimeLine.Paint;
begin
  if (FUpdate <> 0) or (csDestroying in ComponentState) then
    Exit;
  DrawTimeLine(Canvas);
  if Focused then
    DrawFocus;
end;

procedure TJvCustomTimeLine.MeasureItem(Item: TJvTimeItem; var ItemHeight:
  Integer);
begin
  if Assigned(FOnMeasureItem) and (Style = tlOwnerDrawVariable) then
    FOnMeasureItem(Self, Item, ItemHeight)
  else
    ItemHeight := FItemHeight;
end;

procedure TJvCustomTimeLine.DrawItem(Item: TJvTimeItem; ACanvas: TCanvas; var R: TRect);
begin
  if Assigned(FOnDrawItem) and (FStyle in [tlOwnerDrawVariable, tlOwnerDrawFixed]) then
    FOnDrawItem(Self, ACanvas, Item, R)
  else
  begin
    ACanvas.Brush.Color := Item.Color;
    ACanvas.Font.Color := Item.TextColor;

    if Assigned(FImages) and (Item.ImageIndex > -1) then
    begin
      if FUpdate = 0 then
      begin
        ACanvas.Brush.Color := Color;
        ACanvas.FillRect(Rect(R.Left + Item.ImageOffset,
          R.Top, R.Left + Item.ImageOffset + FImages.Width,
          R.Top + FImages.Height));
        with FImages do
          Draw(ACanvas, R.Left + Item.ImageOffset, R.Top, Item.ImageIndex,
            {$IFDEF VisualCLX} itImage, {$ENDIF} Item.Enabled);
      end;
      Inc(R.Top, FImages.Height + 4); { adjust top to make room for text drawing }
    end;

    if FUpdate = 0 then
    begin
      if Item.Selected and Item.Enabled and ShowSelection then
      begin
        ACanvas.Brush.Color := clHighLight;
        ACanvas.Font.Color := clHighLightText;
      end
      else
      if not Item.Enabled then
      begin
        ACanvas.Brush.Color := Color;
        ACanvas.Font.Color := Color xor clWhite;
      end
      else
      begin
        ACanvas.Brush.Color := Item.Color;
        ACanvas.Font.Color := Item.TextColor;
      end;

      ACanvas.Pen.Color := Item.TextColor;
      if (Length(Item.Caption) > 0) then
      begin
        R.Bottom := Min(R.Top + ACanvas.TextHeight(Item.Caption), R.Bottom);

        ACanvas.Rectangle(R);
        R.Left := R.Left + 2;
        SetBkMode(ACanvas.Handle, TRANSPARENT);
        DrawTextEx(ACanvas.Handle, PChar(Item.Caption), Length(Item.Caption), R,
          DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_END_ELLIPSIS, nil);
      end
      else
      begin
        R.Bottom := Min(R.Top + ACanvas.TextHeight('Wq'), R.Bottom);
        ACanvas.Rectangle(R);
        if Item.Selected and Item.Enabled then
          ACanvas.DrawFocusRect(R);
      end;
    end;
  end;
end;

procedure TJvCustomTimeLine.VertScroll(ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  if Assigned(FOnVertScroll) then
    FOnVertScroll(Self, ScrollCode, ScrollPos);
end;

procedure TJvCustomTimeLine.HorzScroll(ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  if Assigned(FOnHorzScroll) then
    FOnHorzScroll(Self, ScrollCode, ScrollPos);
end;

procedure TJvCustomTimeLine.ItemClick(Item: TJvTimeItem);
begin
  if Assigned(FOnItemClick) then
    FOnItemClick(Self, Item);
end;

procedure TJvCustomTimeLine.Size;
begin
  if Assigned(FOnSize) then
    FOnSize(Self);
end;

procedure TJvCustomTimeLine.SaveItem(Item: TJvTimeItem; Stream: TStream);
begin
  if Assigned(FOnSaveItem) then
    FOnSaveItem(Self, Item, Stream);
end;

procedure TJvCustomTimeLine.LoadItem(Item: TJvTimeItem; Stream: TStream);
begin
  if Assigned(FOnLoadItem) then
    FOnLoadItem(Self, Item, Stream);
end;

procedure TJvCustomTimeLine.UpdateItem(Index: Integer; ACanvas: TCanvas);
var
  LHeight: Integer;
  LItem: TJvTimeItem;
  LRect: TRect;
begin
  UpdateOffset;
  LItem := FTimeItems[Index];
  ACanvas.Font := Font;
  LHeight := FItemHeight;

  MeasureItem(LItem, LHeight);

  LRect.Left := PosAtDate(LItem.Date);
  LRect.Top := FItemOffset + (LHeight * (LItem.Level - FTopLevel));
  LRect.Bottom := LRect.Top + LHeight;
  if LItem.WidthAs = asPixels then
    LRect.Right := LRect.Left + LItem.Width
  else
    LRect.Right := PosAtDate(LItem.Date + LItem.Width);

  FNewHeight := Max(LRect.Bottom + FTopOffset, FNewHeight);
  if (LItem.Level < FTopLevel) or not RectInRect(LRect, ClientRect) or (FUpdate <> 0) then
    Exit;
  LItem.FRect := LRect;
  DrawItem(LItem, ACanvas, LRect);
  LItem.FRect := LRect;
end;

procedure TJvCustomTimeLine.UpdateItems;
var
  I: Integer;
begin
  if csDestroying in ComponentState then
    Exit;
  FNewHeight := 0;
  for I := 0 to FTimeItems.Count - 1 do
    UpdateItem(I, Canvas);
  if {$IFDEF VCL} FAutoSize and {$ENDIF} (Align in [alTop, alBottom, alNone]) and
    (Height <> FNewHeight + FScrollHeight + 2) and (Items.Count > 0) then
  begin
    Height := FNewHeight + FScrollHeight + 2;
    Size;
  end;
end;

{ very approximate }

function TJvCustomTimeLine.GetLastDate: TDate;
begin
  Result := FFirstDate + ((Width - 1) * (365.22 / (FYearWidth)));
end;

function Ceil(Value: Extended): Integer;
begin
  Result := Trunc(Value);
  if Frac(Value) > 0 then
    Inc(Result);
end;

function TJvCustomTimeLine.DateAtPos(Pos: Integer): TDateTime;
var
  YR, M, D: Word;
  em, xremain, xday: Integer;
begin
  em := Trunc(Pos / FMonthWidth); { elapsed months }
  xremain := Pos mod Trunc(FMonthWidth);
  DecodeDate(FFirstDate, YR, M, D);
  em := M + em;
  YR := YR + em div 12;
  em := em mod 12;
  if em < 1 then
  begin
    em := 12;
    Dec(YR);
  end;

  xday := Ceil(xremain * (MonthDays[IsLeapYear(YR), em] / FMonthWidth));

  if xday <= 0 then
    xday := 1
  else
  if xday > MonthDays[IsLeap