jvtmtimeline.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTMTimeLine.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  A component that mimicks the time line in MS Team Manager

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTMTimeLine.pas,v 1.43 2005/02/17 10:20:57 marquardt Exp $

unit JvTMTimeLine;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  Windows, Messages, Controls, Buttons, Graphics, ExtCtrls, Forms, ImgList,
  {$IFDEF BCB}
  JvTypes, // TDate / TTime macros
  {$ENDIF BCB}
  JvComponent, JvExControls;

type
  TJvTLSelFrame = class(TPersistent)
  private
    FVisible: Boolean;
    FPen: TPen;
    FOnChange: TNotifyEvent;
    procedure SetPen(const Value: TPen);
    procedure SetVisible(const Value: Boolean);
    procedure PenChange(Sender: TObject);
  protected
    procedure DoChange; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Pen: TPen read FPen write SetPen;
    property Visible: Boolean read FVisible write SetVisible default True;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TJvBtnDown = (bdNone, bdLeft, bdRight);
  TJvObjectReadEvent = procedure(Sender: TObject; Stream: TStream; var AObject: TObject) of object;
  TJvObjectWriteEvent = procedure(Sender: TObject; Stream: TStream; const AObject: TObject) of object;

  TJvCustomTMTimeline = class(TJvCustomPanel)
  private
    FTimer: TTimer;
    FImages: TImageList;
    FChangeLink: TChangeLink;
    FDateImages: TStringlist;
    FObjects: TStringlist;
    FLeftBtn: TSpeedButton;
    FRightBtn: TSpeedButton;
    FMonthFont: TFont;
    FBtnDown: TJvBtnDown;
    FReadOnly: Boolean;
    FRightClickSelect: Boolean;
    FDayWidth: Integer;
    FButtonWidth: Integer;
    FDate: TDate;
    FSelDate: TDate;
    FMinDate: TDate;
    FMaxDate: TDate;
    FImageCursor: TCursor;
    FRealCursor: TCursor;
    FTodayColor: TColor;
    FSelection: TJvTLSelFrame;
    FOnChange: TNotifyEvent;
    FLargeChange: Word;
    FSmallChange: Word;
    FOnWriteObject: TJvObjectWriteEvent;
    FOnReadObject: TJvObjectReadEvent;
    FObjectsFontStyle: TFontStyles;
    FShowWeeks: Boolean;
    FShowMonths: Boolean;
    FShowToday: Boolean;
    FLineColor: TColor;
    FShift: TShiftState;
    FShowTodayIcon: Boolean;
    function GetRectForDate(ADate: TDate): TRect;
    function DateFromPos(APos: Integer): TDate;
    procedure DoTimer(Sender: TObject);
    procedure SetFirstDate(const Value: TDate);
    procedure SetReadOnly(const Value: Boolean);
    procedure SetMonthFont(const Value: TFont);
    procedure SetSelDate(const Value: TDate);
    procedure SetDayWidth(const Value: Integer);
    function GetBorderStyle: TBorderStyle;
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetImages(const Value: TImageList);
    procedure DoChange(Sender: TObject);
    function GetImageIndex(ADate: TDate): Integer;
    procedure SetImageIndex(ADate: TDate; const Value: Integer);
    procedure DrawDates(ACanvas: TCanvas);
    procedure DrawSelectionFrame(ACanvas: TCanvas; ARect: TRect);
    procedure DrawImage(ACanvas: TCanvas; ADate: TDate; const ARect: TRect);
    procedure DrawToday(ACanvas: TCanvas; const ARect: TRect);
    procedure SetImageCursor(const Value: TCursor);
    procedure SetSelection(const Value: TJvTLSelFrame);
    procedure DoLMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoRMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    // this is needed so we receive the arrow keys

    procedure DrawFrame(ACanvas: TCanvas; AColor: TColor;
      ALineWidth: Integer; ARect: TRect);
    procedure SetTodayColor(const Value: TColor);
    procedure SetLineColor(const Value: TColor);
    procedure SetRightClickSelect(const Value: Boolean);
    procedure SetMaxDate(const Value: TDate);
    procedure SetMinDate(const Value: TDate);
    procedure SetLargeChange(const Value: Word);
    procedure SetSmallChange(const Value: Word);
    function GetObjects(ADate: TDate): TObject;
    procedure SetObjects(ADate: TDate; const Value: TObject);
    procedure SetButtonWidth(const Value: Integer);
    procedure SetObjectsFontStyle(const Value: TFontStyles);
    procedure SetShowMonths(const Value: Boolean);
    procedure SetShowToday(const Value: Boolean);
    procedure SetShowWeeks(const Value: Boolean);
    function ReadMagic(Stream: TStream): Boolean;
    procedure StartTimer;
    procedure StopTimer;
    function DateHasImage(ADate: TDateTime): Boolean;
    procedure SetShowTodayIcon(const Value: Boolean);
  protected
    procedure GetDlgCode(var Code: TDlgCodes); override;
    procedure CursorChanged; override;
    procedure EnabledChanged; override;
    procedure Paint; override;
    function DoMouseWheelDown(Shift: TShiftState; {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Change; virtual;
    procedure LoadObject(Stream: TStream; var AObject: TObject); virtual;
    procedure SaveObject(Stream: TStream; const AObject: TObject); virtual;
    function GetLastVisibleDate: TDate;
    function GetVisibleDays: Integer;

    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 12;
    property Cursor;
    property DayWidth: Integer read FDayWidth write SetDayWidth default 19;
    property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline];
    property ImageCursor: TCursor read FImageCursor write SetImageCursor default crHandPoint;
    property Images: TImageList read FImages write SetImages;
    property LargeChange: Word read FLargeChange write SetLargeChange default 30;
    property Date: TDate read FDate write SetFirstDate;
    property SelDate: TDate read FSelDate write SetSelDate;
    property MaxDate: TDate read FMaxDate write SetMaxDate;
    property MinDate: TDate read FMinDate write SetMinDate;
    property MonthFont: TFont read FMonthFont write SetMonthFont;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
    property RightClickSelect: Boolean read FRightClickSelect write SetRightClickSelect;
    property SmallChange: Word read FSmallChange write SetSmallChange default 7;
    property Selection: TJvTLSelFrame read FSelection write SetSelection;
    property TodayColor: TColor read FTodayColor write SetTodayColor default clAqua;
    property LineColor: TColor read FLineColor write SetLineColor default clBlack;
    property ShowToday: Boolean read FShowToday write SetShowToday default True;
    property ShowTodayIcon: Boolean read FShowTodayIcon write SetShowTodayIcon default True;
    property ShowWeeks: Boolean read FShowWeeks write SetShowWeeks default True;
    property ShowMonths: Boolean read FShowMonths write SetShowMonths default True;
    property LastVisibleDate: TDate read GetLastVisibleDate;
    property VisibleDays: Integer read GetVisibleDays;
    property Height default 56;
    property Color default clWindow;
    property RightButton: TSpeedButton read FRightBtn;
    property LeftButton: TSpeedButton read FLeftBtn;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnReadObject: TJvObjectReadEvent read FOnReadObject write FOnReadObject;
    property OnWriteObject: TJvObjectWriteEvent read FOnWriteObject write FOnWriteObject;
    property Align default alTop;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // this procedure resets all imageindexes to -1
    procedure ClearImages;
    // this procedure frees all the objects in the Objects array
    procedure ClearObjects;
    // scrools the display Delta number of days. Delta can be either negative or positive
    procedure ScrollDate(Sender: TObject; Delta: Integer);
    // this procedure loads data from a stream and calls the OnReadObject event
    procedure LoadFromStream(Stream: TStream);
    // this procedure saves data to a stream and calls the OnWriteObject event
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(const Filename: string);
    procedure SaveToFile(const Filename: string);
    // gets / sets the imageindex for a specific date
    property ImageIndex[ADate: TDate]: Integer read GetImageIndex write SetImageIndex;
    // gets / sets the TObject for a specific date
    property Objects[ADate: TDate]: TObject read GetObjects write SetObjects;
  end;

  TJvTMTimeline = class(TJvCustomTMTimeline)
  public
    {$IFDEF COMPILER6_UP}
    property RightButton;
    property LeftButton;
    {$ENDIF COMPILER6_UP}
  published
    // gets / sets the borderstyle of the control and the scroll-buttons
    property BorderStyle;
    // gets / sets the width of the buttons
    property ButtonWidth;
    // gets / sets the selected date
    property SelDate;
    // gets / sets the width of each day
    property DayWidth;
    // gets / sets the cursor to use when a date has an image associated
    property ImageCursor;
    // sets / gets the imagelist associated with the control
    property Images;
    // sets the interval for large changes (ctrl+click or ctrl+arrows)
    property LargeChange;
    // gets / sets the first visible date on the left edge
    // OnChange is called when this date changes
    property Date;
    // sets the maximum date that users can scroll to
    property MaxDate;
    // sets the minimum date that users can scroll to
    property MinDate;
    // gets / sets the font used for the month display
    property MonthFont;
    // gets / sets the fontstyle for Objects that are non-nil
    property ObjectsFontStyle;
    property ReadOnly;
    // gets / sets whether a right-click changes the Date property and moves the selection frame
    property RightClickSelect;
    // sets the interval for small changes (left-click or arrows)
    property SmallChange;
    // gets / sets the properties for the selection frame
    property Selection;
    // displays todays date in a different color
    property ShowToday;
    // displays todays date with a double-diamond icon
    property ShowTodayIcon;
    // shows / hides the dotted week separator
    property ShowWeeks;
    // shows the month separator line
    property ShowMonths;
    // gets / sets the background color for the today item
    property TodayColor;
    // gets / sets color of lines (dotted and solid)
    property LineColor;
    // this returns the date of the last fully visible date in the control
    property LastVisibleDate;
    // this returns the number of fully visible days in the control
    property VisibleDays;
    property Action;
    property Align default alTop;
    property Anchors;
    property Constraints;
    property Cursor;
    property Enabled;
    property Font;
    property Height;
    property Hint;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Color;
    // triggered when the display is scrolled or when the left-most date changes
    property OnChange;
    // triggered when the control is clicked
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    // triggered for each object when reading from a file
    property OnReadObject;
    // triggered for each object when writing to a file
    property OnWriteObject;
    property OnStartDrag;
    {$IFDEF VCL}
    property OnStartDock;
    property OnEndDock;
    {$ENDIF VCL}
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvTMTimeLine.pas,v $';
    Revision: '$Revision: 1.43 $';
    Date: '$Date: 2005/02/17 10:20:57 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Consts,
  JvJVCLUtils, JvThemes;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvTMTimeLine.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvTMTimeLine.res}
{$ENDIF UNIX}

{$IFDEF VisualCLX}
resourcestring
  SInvalidImage = 'Invalid Image';
{$ENDIF VisualCLX}

const
  cMagic = 'Jv.TMTIMELINE1';

//=== { TJvTLSelFrame } ======================================================

constructor TJvTLSelFrame.Create;
begin
  inherited Create;
  FPen := TPen.Create;
  FPen.OnChange := PenChange;
  FVisible := True;
end;

destructor TJvTLSelFrame.Destroy;
begin
  FPen.Free;
  inherited Destroy;
end;

procedure TJvTLSelFrame.Assign(Source: TPersistent);
begin
  if Source is TJvTLSelFrame then
  begin
    Pen := TJvTLSelFrame(Source).Pen;
    Visible := TJvTLSelFrame(Source).Visible;
    PenChange(Self);
  end
  else
    inherited Assign(Source);
end;

procedure TJvTLSelFrame.PenChange(Sender: TObject);
begin
  DoChange;
end;

procedure TJvTLSelFrame.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvTLSelFrame.SetPen(const Value: TPen);
begin
  FPen.Assign(Value);
  DoChange;
end;

procedure TJvTLSelFrame.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    DoChange;
  end;
end;

//=== { TJvCustomTMTimeline } ================================================

constructor TJvCustomTMTimeline.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF VCL}
  DoubleBuffered := True;
  {$ENDIF VCL}
  ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
  IncludeThemeStyle(Self, [csNeedsBorderPaint]);
  {$IFDEF VisualCLX}
  ControlStyle := ControlStyle - [csNoFocus];
  InputKeys := InputKeys + [ikArrows];
  {$ENDIF VisualCLX}

  FSelection := TJvTLSelFrame.Create;
  FSelection.Pen.Width := 2;
  FSelection.OnChange := DoChange;

  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := DoChange;

  FDateImages := TStringlist.Create;
  FDateImages.Sorted := True;
  FObjects := TStringlist.Create;
  FObjects.Sorted := True;

  FMonthFont := TFont.Create;
  FMonthFont.Style := [fsItalic, fsBold];
  {$IFDEF MSWINDOWS}
  FMonthFont.Name := 'Times New Roman';
  FMonthFont.Size := 18;
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  FMonthFont.Name := 'Helvetica';
  FMonthFont.Height  := 24;
  {$ENDIF UNIX}

  FObjectsFontStyle := [fsUnderline];
  FButtonWidth := 12;
  FDate := SysUtils.Date - 7;
  FSelDate := FDate - 1;
  FDayWidth := 19;
  FImageCursor := crHandPoint;
  FSmallChange := 7;
  FLargeChange := 30;
  FTodayColor := clAqua;
  FLineColor := clBlack;
  FShowToday := True;
  FShowTodayIcon := True;
  FShowWeeks := True;
  FShowMonths := True;
  {$IFDEF MSWINDOWS}
  Font.Size := 7;
  Font.Name := 'Times New Roman';
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Font.Name := 'Helvetica';
  Font.Height := 11;
  {$ENDIF UNIX}

  FLeftBtn := TSpeedButton.Create(Self);