jvtmtimeline.pas

East make Tray Icon in delphi

function TJvCustomTMTimeline.GetBorderStyle: TBorderStyle;
begin
  Result := inherited BorderStyle;
end;

procedure TJvCustomTMTimeline.SetBorderStyle(const Value: TBorderStyle);
begin
  if BorderStyle <> Value then
  begin
    inherited BorderStyle := Value;
    FLeftBtn.Flat := BorderStyle = bsNone;
    FRightBtn.Flat := BorderStyle = bsNone;
  end;
end;

procedure TJvCustomTMTimeline.SetImages(const Value: TImageList);
begin
  if FImages <> Value then
  begin
    if Assigned(FImages) then
      FImages.UnRegisterChanges(FChangeLink);
    FImages := Value;
    if Assigned(FImages) then
      FImages.RegisterChanges(FChangeLink);
    Invalidate;
  end;
end;

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

function TJvCustomTMTimeline.GetImageIndex(ADate: TDate): Integer;
begin
  Result := FDateImages.IndexOf(IntToStr(Trunc(ADate)));
  if Result > -1 then
    Result := Integer(FDateImages.Objects[Result]);
end;

procedure TJvCustomTMTimeline.SetImageIndex(ADate: TDate;
  const Value: Integer);
var
  I: Integer;
begin
  I := FDateImages.IndexOf(IntToStr(Trunc(ADate)));
  if I < 0 then
    I := FDateImages.Add(IntToStr(Trunc(ADate)));
  FDateImages.Objects[I] := TObject(Value);
  Invalidate;
end;

function TJvCustomTMTimeline.GetObjects(ADate: TDate): TObject;
var
  I: Integer;
begin
  Result := nil;
  I := FObjects.IndexOf(IntToStr(Trunc(ADate)));
  if I > -1 then
    Result := FObjects.Objects[I];
end;

procedure TJvCustomTMTimeline.SetObjects(ADate: TDate; const Value: TObject);
var
  I: Integer;
begin
  I := FObjects.IndexOf(IntToStr(Trunc(ADate)));
  if I < 0 then
    I := FObjects.Add(IntToStr(Trunc(ADate)));
  if Value = nil then
    FObjects.Delete(I)
  else
    FObjects.Objects[I] := Value;
  Invalidate;
end;

procedure TJvCustomTMTimeline.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvCustomTMTimeline.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ADate: TDate;
begin
  inherited MouseMove(Shift, X, Y);
  ADate := DateFromPos(X);
  if DateHasImage(ADate) then
    inherited Cursor := FImageCursor
  else
    Cursor := FRealCursor;
end;

procedure TJvCustomTMTimeline.SetImageCursor(const Value: TCursor);
begin
  if FImageCursor <> Value then
  begin
    FImageCursor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTMTimeline.SetSelection(const Value: TJvTLSelFrame);
begin
  FSelection.Assign(Value);
end;

procedure TJvCustomTMTimeline.GetDlgCode(var Code: TDlgCodes);
begin
  Include(Code, dcWantArrows);
  Exclude(Code, dcNative);
end;

procedure TJvCustomTMTimeline.EnabledChanged;
begin
  inherited EnabledChanged;
  // asn: VisualCLX inherited Create emits EnableChanged event
  if Assigned(FRightBtn) then
  begin
    FLeftBtn.Enabled := Enabled;
    FRightBtn.Enabled := Enabled;
  end;
  Invalidate;
end;

procedure TJvCustomTMTimeline.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if not Enabled or ReadOnly then
    Exit;
  // handling keys in KeyDown gives automatic
  // scrolling when holding the key down
  case Key of
    VK_LEFT:
      if ssCtrl in Shift then
        ScrollDate(nil, -LargeChange)
      else
      if ssShift in Shift then
      begin
        SelDate := SelDate - 1;
        // make sure the selection is visible:
        if SelDate > GetLastVisibleDate then
          Self.Date := SelDate - GetVisibleDays + 1;
        if SelDate < Self.Date then
          Self.Date := SelDate;
        Click;
      end
      else
        ScrollDate(nil, -SmallChange);
    VK_RIGHT:
      if ssCtrl in Shift then
        ScrollDate(nil, LargeChange)
      else
      if ssShift in Shift then
      begin
        SelDate := SelDate + 1;
        // make sure the selection is visible:
        if SelDate > GetLastVisibleDate then
          Self.Date := SelDate - GetVisibleDays + 1;
        if SelDate < Self.Date then
          Self.Date := SelDate;
        Click;
      end
      else
        ScrollDate(nil, SmallChange);
  end;
end;

procedure TJvCustomTMTimeline.SetTodayColor(const Value: TColor);
begin
  if FTodayColor <> Value then
  begin
    FTodayColor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTMTimeline.SetRightClickSelect(const Value: Boolean);
begin
  if FRightClickSelect <> Value then
    FRightClickSelect := Value;
end;

procedure TJvCustomTMTimeline.SetMaxDate(const Value: TDate);
begin
  if Trunc(FMaxDate) <> Trunc(Value) then
  begin
    FMaxDate := Trunc(Value);
    if FMaxDate <= 0 then
      Exit;
    if FMaxDate < Trunc(Self.Date) then
      Self.Date := FMaxDate;
    if FMaxDate < Trunc(FSelDate) then
      SelDate := FMaxDate;
  end;
end;

procedure TJvCustomTMTimeline.SetMinDate(const Value: TDate);
begin
  if Trunc(FMinDate) <> Trunc(Value) then
  begin
    FMinDate := Trunc(Value);
    if FMinDate <= 0 then
      Exit;
    if FMinDate > Trunc(Self.Date) then
      Self.Date := FMinDate;
    if FMinDate > Trunc(FSelDate) then
      SelDate := FMinDate;
  end;
end;

procedure TJvCustomTMTimeline.SetLargeChange(const Value: Word);
begin
  FLargeChange := Value;
end;

procedure TJvCustomTMTimeline.SetSmallChange(const Value: Word);
begin
  FSmallChange := Value;
end;

procedure TJvCustomTMTimeline.ClearObjects;
begin
  while FObjects.Count > 0 do
  begin
    FObjects.Objects[0].Free;
    FObjects.Delete(0);
  end;
  Invalidate;
end;

procedure TJvCustomTMTimeline.ClearImages;
begin
  FDateImages.Clear;
end;

function TJvCustomTMTimeline.GetLastVisibleDate: TDate;
var
  Tmp: Integer;
begin
  if not ReadOnly then
    Tmp := FButtonWidth * 2
  else
    Tmp := 1;
  Result := FDate + ((Width - Tmp) div DayWidth) - 1;
end;

procedure TJvCustomTMTimeline.SetButtonWidth(const Value: Integer);
begin
  if FButtonWidth <> Value then
  begin
    FButtonWidth := Value;
    FLeftBtn.Width := FButtonWidth;
    FRightBtn.Width := FButtonWidth;
    Invalidate;
  end;
end;

procedure TJvCustomTMTimeline.LoadFromFile(const Filename: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone);
  try
    LoadFromStream(F);
  finally
    F.Free;
  end;
end;

procedure WriteInt(Stream: TStream; Value: Integer);
begin
  Stream.Write(Value, SizeOf(Value));
end;

procedure WriteStr(Stream: TStream; const Value: string);
var
  I: Integer;
begin
  I := Length(Value);
  WriteInt(Stream, I);
  if I > 0 then
    Stream.Write(Value[1], I);
end;

function ReadInt(Stream: TStream): Integer;
begin
  Stream.Read(Result, SizeOf(Result));
end;

function ReadStr(Stream: TStream): string;
var
  I: Integer;
begin
  I := ReadInt(Stream);
  SetLength(Result, I);
  if I > 0 then
    Stream.Read(Result[1], I);
end;

function TJvCustomTMTimeline.ReadMagic(Stream: TStream): Boolean;
begin
  Result := AnsiSameStr(ReadStr(Stream), cMagic);
end;

procedure TJvCustomTMTimeline.LoadFromStream(Stream: TStream);
var
  O: TObject;
  I: Integer;
begin
  ClearImages;
  ClearObjects;
  if not ReadMagic(Stream) then
    raise EStreamError.CreateRes(@SInvalidImage);
  FDateImages.Text := ReadStr(Stream);
  for I := 0 to FDateImages.Count - 1 do
    FDateImages.Objects[I] := TObject(ReadInt(Stream));
  FObjects.Text := ReadStr(Stream);
  for I := 0 to FObjects.Count - 1 do
  begin
    O := nil;
    LoadObject(Stream, O);
    FObjects.Objects[I] := O;
  end;
end;

procedure TJvCustomTMTimeline.SaveToStream(Stream: TStream);
var
  I: Integer;
begin
  WriteStr(Stream, cMagic);
  WriteStr(Stream, FDateImages.Text);
  for I := 0 to FDateImages.Count - 1 do
    WriteInt(Stream, Integer(FDateImages.Objects[I]));
  WriteStr(Stream, FObjects.Text);
  for I := 0 to FObjects.Count - 1 do
    SaveObject(Stream, FObjects.Objects[I]);
end;

procedure TJvCustomTMTimeline.SaveToFile(const Filename: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(Filename, fmCreate);
  try
    SaveToStream(F);
  finally
    F.Free;
  end;
end;

procedure TJvCustomTMTimeline.LoadObject(Stream: TStream; var AObject: TObject);
begin
  if Assigned(FOnReadObject) then
    FOnReadObject(Self, Stream, AObject);
end;

procedure TJvCustomTMTimeline.SaveObject(Stream: TStream; const AObject: TObject);
begin
  if Assigned(FOnWriteObject) then
    FOnWriteObject(Self, Stream, AObject);
end;

procedure TJvCustomTMTimeline.SetObjectsFontStyle(const Value: TFontStyles);
begin
  if FObjectsFontStyle <> Value then
  begin
    FObjectsFontStyle := Value;
    Invalidate;
  end;
end;

function TJvCustomTMTimeline.DoMouseWheelDown(Shift: TShiftState;
  {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelDown(Shift, MousePos);
  if not Result then
    ScrollDate(Self, -1);
end;

function TJvCustomTMTimeline.DoMouseWheelUp(Shift: TShiftState;
  {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelUp(Shift, MousePos);
  if not Result then
    ScrollDate(Self, 1);
end;

function TJvCustomTMTimeline.GetVisibleDays: Integer;
begin
  Result := Trunc(GetLastVisibleDate - Self.Date) + 1;
end;

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

procedure TJvCustomTMTimeline.SetShowToday(const Value: Boolean);
begin
  if FShowToday <> Value then
  begin
    FShowToday := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTMTimeline.SetShowWeeks(const Value: Boolean);
begin
  if FShowWeeks <> Value then
  begin
    FShowWeeks := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTMTimeline.SetLineColor(const Value: TColor);
begin
  if FLineColor <> Value then
  begin
    FLineColor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTMTimeline.CursorChanged;
begin
  inherited CursorChanged;
  FRealCursor := Cursor;
end;

function TJvCustomTMTimeline.DateHasImage(ADate: TDateTime): Boolean;
var
  I: Integer;
begin
  Result := False;
  if Assigned(Images) then
  begin
    I := ImageIndex[ADate];
    Result := (I >= 0) and (I < Images.Count);
  end;
end;

procedure TJvCustomTMTimeline.SetShowTodayIcon(const Value: Boolean);
begin
  if FShowTodayIcon <> Value then
  begin
    FShowTodayIcon := Value;
    Invalidate;
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.