jvtfglance.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: JvTFGlance.PAS, released on 2003-08-01.

The Initial Developer of the Original Code is Unlimited Intelligence Limited.
Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
All Rights Reserved.

Contributor(s):
Mike Kolter (original code)

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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTFGlance.pas,v 1.31 2005/02/17 10:20:56 marquardt Exp $

unit JvTFGlance;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  SysUtils, Classes, Windows, Messages, Graphics, Controls, Forms, Dialogs, ImgList,
  {$IFDEF BCB}
  JvTypes, // TDate/TTime
  {$ENDIF BCB}
  JvTFUtils, JvTFManager;

type
  EJvTFGlanceError = class(Exception);
  EGlanceViewerError = class(EJvTFGlanceError);

  TJvTFGlanceCell = class;
  TJvTFGlanceCells = class;
  TJvTFCustomGlance = class;
  TJvTFGlanceViewer = class;
  TJvTFCellPics = class;

  TJvTFUpdateTitleEvent = procedure(Sender: TObject; var NewTitle: string)
    of object;

  TJvTFCellPic = class(TCollectionItem)
  private
    FPicName: string;
    FPicIndex: Integer;
    FPicPoint: TPoint;
    FHints: TStringList;
    function GetHints: TStrings;
    procedure SetPicName(const Value: string);
    procedure SetPicIndex(Value: Integer);
    procedure SetHints(Value: TStrings);
  protected
    function GetDisplayName: string; override;
    procedure Change; virtual;
    procedure SetPicPoint(X, Y: Integer);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function PicCollection: TJvTFCellPics;
    property PicPoint: TPoint read FPicPoint;
  published
    property PicName: string read FPicName write SetPicName;
    property PicIndex: Integer read FPicIndex write SetPicIndex;
    property Hints: TStrings read GetHints write SetHints;
  end;

  TJvTFCellPics = class(TCollection)
  private
    function GetItem(Index: Integer): TJvTFCellPic;
    procedure SetItem(Index: Integer; Value: TJvTFCellPic);
  protected
    FGlanceCell: TJvTFGlanceCell;
    function GetOwner: TPersistent; override;
  public
    constructor Create(AGlanceCell: TJvTFGlanceCell);
    function Add: TJvTFCellPic;
    property GlanceCell: TJvTFGlanceCell read FGlanceCell;
    procedure Assign(Source: TPersistent); override;
    property Items[Index: Integer]: TJvTFCellPic read GetItem write SetItem; default;
    function PicByName(const PicName: string): TJvTFCellPic;
    function GetPicIndex(const PicName: string): Integer;
    function AddPic(const PicName: string; PicIndex: Integer): TJvTFCellPic;
  end;

  TJvTFSplitOrientation = (soHorizontal, soVertical);

  TJvTFGlanceCell = class(TCollectionItem)
  private
    FColor: TColor;
    FCellDate: TDate;
    FColIndex: Integer;
    FRowIndex: Integer;
    FCellPics: TJvTFCellPics;
    FCanSelect: Boolean;
    FSchedules: TStringList;
    FTitleText: string;

    FSplitRef: TJvTFGlanceCell;
    FSplitOrientation: TJvTFSplitOrientation;
    FIsSubCell: Boolean;

    procedure SetColor(Value: TColor);
    procedure SetCellPics(Value: TJvTFCellPics);
    procedure SetCanSelect(Value: Boolean);
    function GetSchedule(Index: Integer): TJvTFSched;
    procedure SetSplitOrientation(Value: TJvTFSplitOrientation);
    function GetParentCell: TJvTFGlanceCell;
    function GetSubCell: TJvTFGlanceCell;
  protected
    // (rom) bad names
    FDestroying: Boolean;
    FCellCollection: TJvTFGlanceCells;
    function GetDisplayName: string; override;
    procedure InternalSetCellDate(Value: TDate);
    procedure SetCellDate(Value: TDate);
    procedure SetColIndex(Value: Integer);
    procedure SetRowIndex(Value: Integer);
    procedure Change; virtual;
    procedure SetTitleText(const Value: string);
    procedure Split;
    procedure Combine;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property CellCollection: TJvTFGlanceCells read FCellCollection;

    function ScheduleCount: Integer;
    property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
    function IndexOfSchedule(const SchedName: string; SchedDate: TDate): Integer;
    function IndexOfSchedObj(ASched: TJvTFSched): Integer;
    procedure CheckConnections;
    function IsSchedUsed(ASched: TJvTFSched): Boolean;
    property TitleText: string read FTitleText;
    property SplitOrientation: TJvTFSplitOrientation read FSplitOrientation
      write SetSplitOrientation default soHorizontal;
    property SplitRef: TJvTFGlanceCell read FSplitRef;
    function IsParent: Boolean;
    function IsSubCell: Boolean;
    function IsSplit: Boolean;
    property ParentCell: TJvTFGlanceCell read GetParentCell;
    property SubCell: TJvTFGlanceCell read GetSubCell;
  published
    property Color: TColor read FColor write SetColor;
    property CellDate: TDate read FCellDate write SetCellDate;
    property ColIndex: Integer read FColIndex;
    property RowIndex: Integer read FRowIndex;
    property CellPics: TJvTFCellPics read FCellPics write SetCellPics;
    property CanSelect: Boolean read FCanSelect write SetCanSelect;
  end;

{ TODO: Clean up AddError, DestroyError, etc. in TJvTFGlanceCells and TJvTFGlanceCell }
  TJvTFGlanceCells = class(TCollection)
  private
    FGlanceControl: TJvTFCustomGlance;
    FDestroying: Boolean;
    function GetItem(Index: Integer): TJvTFGlanceCell;
    procedure SetItem(Index: Integer; Value: TJvTFGlanceCell);
    function GetCell(ColIndex, RowIndex: Integer): TJvTFGlanceCell;
  protected
    // (rom) bad names
    FAllowAdd: Boolean;
    FAllowDestroy: Boolean;
    FCheckingAllConnections: Boolean;
    FConfiguring: Boolean;
    function GetOwner: TPersistent; override;
    function InternalAdd: TJvTFGlanceCell;
    procedure AddError; dynamic;
    procedure DestroyError; dynamic;
    procedure EnsureCellCount;
    procedure EnsureCells;
    procedure ConfigCells; virtual;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AGlanceControl: TJvTFCustomGlance);
    destructor Destroy; override;
    function Add: TJvTFGlanceCell;
    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
    procedure Assign(Source: TPersistent); override;
    property Items[Index: Integer]: TJvTFGlanceCell read GetItem write SetItem; default;
    property AllowAdd: Boolean read FAllowAdd;
    property AllowDestroy: Boolean read FAllowDestroy;
    property Cells[ColIndex, RowIndex: Integer]: TJvTFGlanceCell read GetCell;
    procedure CheckConnections;
    property Configuring: Boolean read FConfiguring;
    procedure ReconfigCells;

    function IsSchedUsed(ASched: TJvTFSched): Boolean;
  end;

  TJvTFFrameStyle = (fs3DRaised, fs3DLowered, fsFlat, fsNone);
  TJvTFFrameAttr = class(TPersistent)
  private
    FStyle: TJvTFFrameStyle;
    FColor: TColor;
    FWidth: Integer;
    FControl: TJvTFControl;
    FOnChange: TNotifyEvent;
    procedure SetStyle(Value: TJvTFFrameStyle);
    procedure SetColor(Value: TColor);
    procedure SetWidth(Value: Integer);
  protected
    procedure Change; virtual;
  public
    constructor Create(AOwner: TJvTFControl);
    procedure Assign(Source: TPersistent); override;
    property Control: TJvTFControl read FControl;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Style: TJvTFFrameStyle read FStyle write SetStyle default fsFlat;
    property Color: TColor read FColor write SetColor default clBlack;
    property Width: Integer read FWidth write SetWidth default 1;
  end;

  TJvTFGlanceFrameAttr = class(TJvTFFrameAttr)
  private
    FGlanceControl: TJvTFCustomGlance;
  protected
    procedure Change; override;
  public
    constructor Create(AOwner: TJvTFCustomGlance);
    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
  end;

  TJvTFTextAttr = class(TPersistent)
  private
    FFont: TFont;
    FOnChange: TNotifyEvent;
    FRotation: Integer;
    FAlignH: TAlignment;
    FAlignV: TJvTFVAlignment;
    procedure SetFont(Value: TFont);
    procedure SetRotation(Value: Integer);
    procedure SetAlignH(Value: TAlignment);
    procedure SetAlignV(Value: TJvTFVAlignment);
  protected
    procedure FontChange(Sender: TObject);
    procedure DoChange; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Font: TFont read FFont write SetFont;
    property Rotation: Integer read FRotation write SetRotation default 0;
    property AlignH: TAlignment read FAlignH write SetAlignH default taLeftJustify;
    property AlignV: TJvTFVAlignment read FAlignV write SetAlignV default vaCenter;
  end;

  TJvTFGlanceTitlePicAttr = class(TPersistent)
  private
    FAlignH: TAlignment;
    FAlignV: TJvTFVAlignment;
    FOnChange: TNotifyEvent;
    procedure SetAlignH(Value: TAlignment);
    procedure SetAlignV(Value: TJvTFVAlignment);
  protected
    procedure DoChange;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property AlignH: TAlignment read FAlignH write SetAlignH default taLeftJustify;
    property AlignV: TJvTFVAlignment read FAlignV write SetAlignV default vaCenter;
  end;

  TJvTFTitleAlign = alTop..alRight;
  TJvTFGlanceTitleAttr = class(TPersistent)
  private
    FAlign: TJvTFTitleAlign;
    //FDayFormat: string;
    FColor: TColor;
    FHeight: Integer;
    FVisible: Boolean;
    FFrameAttr: TJvTFGlanceFrameAttr;
    FGlanceControl: TJvTFCustomGlance;
    FDayTxtAttr: TJvTFTextAttr;
    FPicAttr: TJvTFGlanceTitlePicAttr;
    procedure SetAlign(Value: TJvTFTitleAlign);
    //procedure SetDayFormat(Value: string);
    procedure SetColor(Value: TColor);
    procedure SetHeight(Value: Integer);
    procedure SetVisible(Value: Boolean);
    procedure SetFrameAttr(Value: TJvTFGlanceFrameAttr);
    procedure SetDayTxtAttr(Value: TJvTFTextAttr);
    procedure SetPicAttr(Value: TJvTFGlanceTitlePicAttr);
  protected
    procedure Change;
    procedure TxtAttrChange(Sender: TObject);
    procedure PicAttrChange(Sender: TObject);
  public
    constructor Create(AOwner: TJvTFCustomGlance);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
  published
    property Align: TJvTFTitleAlign read FAlign write SetAlign default alTop;
    //property DayFormat: string read FDayFormat write SetDayFormat;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property Height: Integer read FHeight write SetHeight default 20;
    property Visible: Boolean read FVisible write SetVisible default True;
    property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
    property DayTxtAttr: TJvTFTextAttr read FDayTxtAttr write SetDayTxtAttr;
    property PicAttr: TJvTFGlanceTitlePicAttr read FPicAttr write SetPicAttr;
  end;

  TJvTFGlanceCellAttr = class(TPersistent)
  private
    FColor: TColor;
    FFrameAttr: TJvTFGlanceFrameAttr;
    FTitleAttr: TJvTFGlanceTitleAttr;
    FGlanceControl: TJvTFCustomGlance;
    FFont: TFont;
    FDrawBottomLine: Boolean;
    procedure SetColor(Value: TColor);
    procedure SetFrameAttr(Value: TJvTFGlanceFrameAttr);
    procedure SetTitleAttr(Value: TJvTFGlanceTitleAttr);
    procedure SetFont(Value: TFont);
    procedure SetDrawBottomLine(Value: Boolean);
  protected
    procedure FontChange(Sender: TObject);
    procedure Change;
  public
    constructor Create(AOwner: TJvTFCustomGlance);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
  published
    property Color: TColor read FColor write SetColor default clWhite;
    property Font: TFont read FFont write SetFont;
    property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
    property TitleAttr: TJvTFGlanceTitleAttr read FTitleAttr write SetTitleAttr;
    property DrawBottomLine: Boolean read FDrawBottomLine write SetDrawBottomLine;
  end;

  TJvTFGlanceTitle = class(TPersistent)
  private
    FColor: TColor;
    FHeight: Integer;
    FVisible: Boolean;
    FGlanceControl: TJvTFCustomGlance;
    FFrameAttr: TJvTFGlanceFrameAttr;
    FTxtAttr: TJvTFTextAttr;
    FOnChange: TNotifyEvent;
    procedure SetColor(Value: TColor);
    procedure SetHeight(Value: Integer);
    procedure SetVisible(Value: Boolean);
    procedure SetFrameAttr(Value: TJvTFGlanceFrameAttr);
    procedure SetTxtAttr(Value: TJvTFTextAttr);
  protected
    procedure Change;
    procedure TxtAttrChange(Sender: TObject);
  public
    constructor Create(AOwner: TJvTFCustomGlance);
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Color: TColor read FColor write SetColor default clBtnFace;
    property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
    property Height: Integer read FHeight write SetHeight default 40;
    property Visible: Boolean read FVisible write SetVisible default True;
    property TxtAttr: TJvTFTextAttr read FTxtAttr write SetTxtAttr;
  end;

  TJvTFGlanceMainTitle = class(TJvTFGlanceTitle)
  private
    FTitle: string;
    procedure SetTitle(const Value: string);
  public
    constructor Create(AOwner: TJvTFCustomGlance);
    procedure Assign(Source: TPersistent); override;
  published
    property Title: string read FTitle write SetTitle;
  end;

  TJvTFGlanceCoord = record
    Col: Integer;
    Row: Integer;
    Cell: TJvTFGlanceCell;
    CellX: Integer;
    CellY: Integer;
    AbsX: Integer;
    AbsY: Integer;
    DragAccept: Boolean;
    InCellTitle: Boolean;
    CellTitlePic: TJvTFCellPic;
    Appt: TJvTFAppt;
  end;

  TJvTFGlanceSelOrder = (soColMajor, soRowMajor, soRect);

  TJvTFGlanceSelList = class(TJvTFDateList)
  private
    FGlanceControl: TJvTFCustomGlance;
  public
    constructor Create(AOwner: TJvTFCustomGlance);
    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
  end;

  TJvTFGlanceDrawTitleEvent = procedure(Sender: TObject; ACanvas: TCanvas;
    ARect: TRect) of object;
  TJvTFGlanceDrawCellEvent = procedure(Sender: TObject; ACanvas: TCanvas;
    ACellRect, ATitleRect, ABodyRect: TRect; Attr: TJvTFGlanceCellAttr;
    Cell: TJvTFGlanceCell) of object;

  TJvTFGlanceDropApptEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
    var NewStartDate, NewEndDate: TDate; var Confirm: Boolean) of object;

  TJvTFUpdateCellTitleTextEvent = procedure(Sender: TObject; Cell: TJvTFGlanceCell;
    var NewText: string) of object;

  TJvTFCustomGlance = class(TJvTFControl)
  private
    FGapSize: Integer;
    FBorderStyle: TBorderStyle;
    //FStartOfWeek: Word;
    FStartOfWeek: TTFDayOfWeek;

    FRowCount: Integer;
    FColCount: Integer;
    FCells: TJvTFGlanceCells;
    FStartDate: TDate;
    FOriginDate: TDate;