jvqtimeline.pas

East make Tray Icon in delphi

    //    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,  itImage,  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  (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[IsLeapYear(YR), em] then
    xday := MonthDays[IsLeapYear(YR), em];
  Result := EncodeDate(YR, em, xday);
end;

function TJvCustomTimeLine.PosAtDate(Date: TDateTime): Integer;
var
  M, D: Integer;
begin
  M := MonthCount(FFirstDate, Date);
  D := PixelsForDays(Date, Round(FMonthWidth));
  Result := Round((M * FMonthWidth + D) + FMonthWidth / 60);
  { add in a little to place in "center" }
end;

procedure TJvCustomTimeLine.LoadFromFile(FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TJvCustomTimeLine.SaveToFile(FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TJvCustomTimeLine.LoadFromStream(Stream: TStream);
var
  I: Integer;
  Ch: Char;
  S: string;
  Item: TJvTimeItem;
begin

  I := 0;
  Item := Items.Add;
  while Stream.Position < Stream.Size do
  begin
    S := '';
    Stream.Read(Ch, 1);
    while Ch <> Cr do
    begin
      S := S + Ch;
      Stream.Read(Ch, 1);
    end;
    case I of
      0: // Caption
        Item.Caption := S;
      1: // Color
        Item.Color := StrToInt(S);
      2: // Date
        Item.Date := StrToDateTime(S);
      3: // Hint
        Item.Hint := S;
      4: // ImageIndex
        Item.ImageIndex := StrToInt(S);
      5: // Level
        Item.Level := StrToInt(S);
      6: // Selected
        Item.Selected := Boolean(StrToInt(S));
      7: // TextColor
        Item.TextColor := StrToInt(S);
      8: // Width
        begin
          Item.Width := StrToInt(S);
          LoadItem(Item, Stream);
          I := -1;
          Item := Items.Add;
        end;
    end; { case }
    Inc(I);
  end;
  Item.Free; { always one too many }
end;

procedure TJvCustomTimeLine.SaveToStream(Stream: TStream);
var
  I: Integer;
  S: string;
begin
  for I := 0 to Items.Count - 1 do
  begin
    with Items[I] do
    begin
      S := Caption + Cr;
      Stream.Write(S[1], Length(S));

      S := IntToStr(ColorToRGB(Color)) + Cr;
      Stream.Write(S[1], Length(S));

      S := DateTimeToStr(Date) + Cr;
      Stream.Write(S[1], Length(S));

      S := Hint + Cr;
      Stream.Write(S[1], Length(S));

      S := IntToStr(ImageIndex) + Cr;
      Stream.Write(S[1], Length(S));

      S := IntToStr(Level) + Cr;
      Stream.Write(S[1], Length(S));

      S := IntToStr(Ord(Selected)) + Cr;
      Stream.Write(S[1], Length(S));

      S := IntToStr(ColorToRGB(TextColor)) + Cr;
      Stream.Write(S[1], Length(S));

      S := IntToStr(Width) + Cr;
      Stream.Write(S[1], Length(S));
      { let the user save his data stuff }
      SaveItem(Items[I], Stream);
    end;
  end;
  S := Cr;
  Stream.Write(S[1], 1);
end;

procedure TJvCustomTimeLine.BeginUpdate;
begin
  Inc(FUpdate);
end;

procedure TJvCustomTimeLine.EndUpdate;
begin
  Dec(FUpdate);
  if FUpdate = 0 then
    Repaint;
end;

procedure TJvCustomTimeLine.ItemMoved(Item: TJvTimeItem; var NewDate: TDateTime; var NewLevel: Integer);
begin
  if Assigned(FOnItemMoved) then
    FOnItemMoved(Self, Item, NewDate, NewLevel);
end;

function TJvCustomTimeLine.ItemMouseMove(X, Y: Integer): Boolean;
var
  AItem: TJvTimeItem;
begin
  Result := False;
  if Assigned(FOnItemMouseMove) then
  begin
    AItem := ItemAtPos(X, Y);
    if AItem <> nil then
    begin
      FOnItemMouseMove(Self, AItem, X, Y);
      Result := True;
    end;
  end;
end;

function TJvCustomTimeLine.ItemMoving(Item: TJvTimeItem): Boolean;
begin
  Result := True;
  if Assigned(FOnItemMoving) then
    FOnItemMoving(Self, Item, Result);
end;



function TJvCustomTimeLine.HasItemsToLeft: Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Items.Count - 1 do
    if Items[I].Left <= 0 then
      Exit;
  Result := False;
end;

function TJvCustomTimeLine.HasItemsToRight: Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Items.Count - 1 do
    if Items[I].Left >= ClientWidth - 8 then
      Exit;
  Result := False;
end;

procedure TJvCustomTimeLine.SetHorzSupport(const Value: Boolean);
begin
  if FHorzSupport <> Value then
  begin
    FHorzSupport := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  I: TJvScrollArrow;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  for I := Low(TJvScrollArrow) to High(TJvScrollArrow) do
    if FArrows[I] <> nil then
      FArrows[I].UpdatePlacem