jvtfglance.pas

East make Tray Icon in delphi

    FCellPics: TCustomImageList;

    FTitleAttr: TJvTFGlanceMainTitle;
    FAllowCustomDates: Boolean;

    FCellAttr: TJvTFGlanceCellAttr;
    FSelCellAttr: TJvTFGlanceCellAttr;
    FSelOrder: TJvTFGlanceSelOrder;
    FSel: TJvTFGlanceSelList;
    FUpdatingSel: Boolean;

    FViewer: TJvTFGlanceViewer;

    FOnConfigCells: TNotifyEvent;
    FOnDrawTitle: TJvTFGlanceDrawTitleEvent;
    FOnDrawCell: TJvTFGlanceDrawCellEvent;
    FOnSelChanged: TNotifyEvent;
    FOnDropAppt: TJvTFGlanceDropApptEvent;
    FOnUpdateCellTitleText: TJvTFUpdateCellTitleTextEvent;

    FHintProps: TJvTFHintProps;

    FSchedNames: TStringList;

    FSelAppt: TJvTFAppt;

    function GetSchedNames: TStrings;
    procedure SetBorderStyle(Value: TBorderStyle);

    procedure SetRowCount(Value: Integer);
    procedure SetCells(Value: TJvTFGlanceCells);
    procedure SetStartDate(Value: TDate);
    procedure SetOriginDate(Value: TDate);
    procedure SetTitleAttr(Value: TJvTFGlanceMainTitle);

    procedure SetCellAttr(Value: TJvTFGlanceCellAttr);
    procedure SetTFSelCellAttr(Value: TJvTFGlanceCellAttr);
    procedure SetViewer(Value: TJvTFGlanceViewer);
    procedure SetCellPics(Value: TCustomImageList);

    procedure SetHintProps(Value: TJvTFHintProps);
    procedure SetSchedNames(Value: TStrings);

    procedure SetSelAppt(Value: TJvTFAppt);
  protected
    // (rom) bad names
    FCreatingControl: Boolean;

    FPaintBuffer: TBitmap;
    FSelAnchor: TJvTFGlanceCell;
    FMouseCell: TJvTFGlanceCell;
    FImageChangeLink: TChangeLink;
    FHint: TJvTFHint;

    procedure SetColCount(Value: Integer); virtual;
    procedure SetStartOfWeek(Value: TTFDayOfWeek); virtual;

    procedure EnsureCol(Col: Integer);
    procedure EnsureRow(Row: Integer);
    procedure EnsureCell(ACell: TJvTFGlanceCell);
    function ValidCol(Col: Integer): Boolean;
    function ValidRow(Row: Integer): Boolean;
    function ValidCell(Col, Row: Integer): Boolean;

    procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
    procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ImageListChange(Sender: TObject);
    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); override;

    procedure GlanceTitleChange(Sender: TObject);

    // mouse routines
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DblClick; override;

    procedure CheckApptHint(Info: TJvTFGlanceCoord); virtual;

    // Drag/Drop routines
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure DropAppt(DragInfo: TJvTFDragInfo; X, Y: Integer);

    // selection routines
    procedure UpdateSelection;
    procedure SelChange(Sender: TObject); virtual;
    property SelOrder: TJvTFGlanceSelOrder read FSelOrder write FSelOrder;
    procedure InternalSelectCell(ACell: TJvTFGlanceCell); virtual;
    procedure InternalDeselectCell(ACell: TJvTFGlanceCell); virtual;

    // Drawing routines
    procedure Paint; override;
    procedure DrawTitle(ACanvas: TCanvas); virtual;
    procedure DrawCells(ACanvas: TCanvas);
    procedure DrawCell(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
    procedure DrawCellTitle(ACanvas: TCanvas; ATitleRect: TRect;
      Attr: TJvTFGlanceCellAttr; Cell: TJvTFGlanceCell);
    procedure DrawCellTitleFrame(ACanvas: TCanvas; ATitleRect: TRect;
      Attr: TJvTFGlanceCellAttr);
    procedure DrawCellFrame(ACanvas: TCanvas; ARect: TRect;
      Attr: TJvTFGlanceCellAttr; ACell: TJvTFGlanceCell);
    procedure Draw3DFrame(ACanvas: TCanvas; ARect: TRect; TLColor,
      BRColor: TColor);
    function PicsToDraw(ACell: TJvTFGlanceCell): Boolean;
    procedure GetPicsWidthHeight(ACell: TJvTFGlanceCell; PicBuffer: Integer;
      Horz: Boolean; var PicsWidth, PicsHeight: Integer);
    function ValidPicIndex(PicIndex: Integer): Boolean;

    // Drawing event dispatch methods
    procedure DoDrawTitle(ACanvas: TCanvas; ARect: TRect); virtual;
    procedure DoDrawCell(ACanvas: TCanvas; ACellRect, ATitleRect,
      ABodyRect: TRect; Attr: TJvTFGlanceCellAttr; Cell: TJvTFGlanceCell); virtual;

    procedure ConfigCells; virtual;
    procedure DoConfigCells; virtual;
    procedure SetCellDate(ACell: TJvTFGlanceCell; CellDate: TDate);
    procedure UpdateCellTitles;
    procedure UpdateCellTitleText(Cell: TJvTFGlanceCell);
    function GetCellTitleText(Cell: TJvTFGlanceCell): string; virtual;

    procedure CreateParams(var Params: TCreateParams); override;

    procedure SchedNamesChange(Sender: TObject);
    property SelAppt: TJvTFAppt read FSelAppt write SetSelAppt;
    property AllowCustomDates: Boolean read FAllowCustomDates  write FAllowCustomDates;
    // configuration properties and events
    property RowCount: Integer read FRowCount write SetRowCount default 6;
    property ColCount: Integer read FColCount write SetColCount default 7;
    property StartDate: TDate read FStartDate write SetStartDate;
    property OriginDate: TDate read FOriginDate write SetOriginDate;
    property OnConfigCells: TNotifyEvent read FOnConfigCells write FOnConfigCells;
    property StartOfWeek: TTFDayOfWeek read FStartOfWeek write SetStartOfWeek default dowSunday;
  public
    function GetTFHintClass: TJvTFHintClass; dynamic;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); override;
    procedure SafeReleaseSchedule(ASched: TJvTFSched);

    function GetDataTop: Integer; dynamic;
    function GetDataLeft: Integer; dynamic;
    function GetDataWidth: Integer; dynamic;
    function GetDataHeight: Integer; dynamic;

    procedure SplitRects(Col, Row: Integer; var ParentRect, SubRect: TRect);
    function CellRect(ACell: TJvTFGlanceCell): TRect;
    function WholeCellRect(Col, Row: Integer): TRect;
    function TitleRect: TRect;
    function CellTitleRect(ACell: TJvTFGlanceCell): TRect;
    function CellBodyRect(ACell: TJvTFGlanceCell): TRect;
    function CalcCellTitleRect(ACell: TJvTFGlanceCell; Selected, Full: Boolean): TRect;
    function CalcCellBodyRect(ACell: TJvTFGlanceCell; Selected, Full: Boolean): TRect;
    function PtToCell(X, Y: Integer): TJvTFGlanceCoord;
    property Sel: TJvTFGlanceSelList read FSel write FSel;
    function DateIsSelected(ADate: TDate): Boolean;
    function CellIsSelected(ACell: TJvTFGlanceCell): Boolean;
    procedure SelectCell(ACell: TJvTFGlanceCell; Clear: Boolean = True); virtual;
    procedure DeselectCell(ACell: TJvTFGlanceCell); virtual;
    procedure BeginSelUpdate;
    procedure EndSelUpdate;
    property UpdatingSel: Boolean read FUpdatingSel;

    function GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr; virtual;
    procedure CheckViewerApptHint(X, Y: Integer);

    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure ReconfigCells;
    procedure SplitCell(ACell: TJvTFGlanceCell);
    procedure CombineCell(ACell: TJvTFGlanceCell);
  published
    property Cells: TJvTFGlanceCells read FCells write SetCells;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property GapSize: Integer read FGapSize write FGapSize;
    property TitleAttr: TJvTFGlanceMainTitle read FTitleAttr write SetTitleAttr;
    property CellAttr: TJvTFGlanceCellAttr read FCellAttr write SetCellAttr;
    property SelCellAttr: TJvTFGlanceCellAttr read FSelCellAttr write SetTFSelCellAttr;
    property CellPics: TCustomImageList read FCellPics write SetCellPics;
    property Viewer: TJvTFGlanceViewer read FViewer write SetViewer;
    property HintProps: TJvTFHintProps read FHintProps write SetHintProps;
    property SchedNames: TStrings read GetSchedNames write SetSchedNames;
    property OnDrawTitle: TJvTFGlanceDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;
    property OnDrawCell: TJvTFGlanceDrawCellEvent read FOnDrawCell write FOnDrawCell;
    property OnSelChanged: TNotifyEvent read FOnSelChanged write FOnSelChanged;
    property OnDropAppt: TJvTFGlanceDropApptEvent read FOnDropAppt write FOnDropAppt;
    property OnUpdateCellTitleText: TJvTFUpdateCellTitleTextEvent read FOnUpdateCellTitleText
      write FOnUpdateCellTitleText;
    //inherited properties
    property DateFormat; // from TJvTFControl
    property TimeFormat; // from TJvTFControl

    property Align;
    property Color default clWindow;
    property ParentColor default False;
    property TabStop default True;
    property TabOrder;
    property Anchors;
    property Constraints;
    property DragKind;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnEndDock;
    property OnStartDock;
    property OnStartDrag;
  end;

  TJvTFGlanceViewer = class(TComponent)
  private
    FGlanceControl: TJvTFCustomGlance;
    FVisible: Boolean;
    FCell: TJvTFGlanceCell;
    FPhysicalCell: TJvTFGlanceCell;
    FRepeatGrouped: Boolean;
    function GetRepeatAppt(Index: Integer): TJvTFAppt;
    function GetSchedule(Index: Integer): TJvTFSched;
    function GetDate: TDate;
    procedure SetRepeatGrouped(Value: Boolean);
    function GetDistinctAppt(Index: Integer): TJvTFAppt;
    function GetAppt(Index: Integer): TJvTFAppt;
  protected
    procedure SetVisible(Value: Boolean); virtual; abstract;
    procedure SetGlanceControl(Value: TJvTFCustomGlance); virtual;
    procedure ParentReconfig; virtual;
    procedure EnsureCol(ACol: Integer);
    procedure EnsureRow(ARow: Integer);
    procedure MouseAccel(X, Y: Integer); virtual;
    procedure GetDistinctAppts(ApptList: TStringList);

    procedure FinishEditAppt; virtual;
    function Editing: Boolean; virtual;
    function CanEdit: Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;

    procedure SetTo(ACell: TJvTFGlanceCell); virtual;
    procedure MoveTo(ACell: TJvTFGlanceCell); virtual;
    procedure Refresh; virtual; abstract;
    procedure Realign; virtual; abstract;
    procedure PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell); virtual; abstract;

    property GlanceControl: TJvTFCustomGlance read FGlanceControl;
    property Cell: TJvTFGlanceCell read FCell;
    property PhysicalCell: TJvTFGlanceCell read FPhysicalCell;
    property Date: TDate read GetDate;
    property Visible: Boolean read FVisible write SetVisible;
    function CalcBoundsRect(ACell: TJvTFGlanceCell): TRect; virtual;

    function ApptCount: Integer;
    property Appts[Index: Integer]: TJvTFAppt read GetAppt;
    function ScheduleCount: Integer;
    property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
    function GetApptAt(X, Y: Integer): TJvTFAppt; virtual;
  published
    property RepeatGrouped: Boolean read FRepeatGrouped write SetRepeatGrouped default True;
  end;

  TJvTFGlance = class(TJvTFCustomGlance)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property RowCount;
    property ColCount;
    property OriginDate;
    property OnConfigCells;
  end;

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

implementation

{$IFDEF USEJVCL}
uses
  JvConsts, JvResources;
{$ENDIF USEJVCL}

{$IFNDEF USEJVCL}
resourcestring
  RsECellDatesCannotBeChanged = 'Cell Dates cannot be changed';
  RsECellMapHasBeenCorrupteds = 'Cell map has been corrupted %s';
  RsECellObjectNotAssigned = 'Cell object not assigned';
  RsEInvalidColIndexd = 'Invalid col index (%d)';
  RsEInvalidRowIndexd = 'Invalid row index (%d)';
  RsEApptIndexOutOfBoundsd = 'Appt index out of bounds (%d)';
  RsECellCannotBeSplit = 'Cell cannot be split';
  RsEASubcellCannotBeSplit = 'A subcell cannot be split';
  RsGlanceMainTitle = '(Title)';
{$ENDIF !USEJVCL}

//=== { TJvTFGlanceCell } ====================================================

constructor TJvTFGlanceCell.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FCellCollection := TJvTFGlanceCells(Collection);

  if Assigned(CellCollection) and not CellCollection.AllowAdd then
    CellCollection.AddError;

  FCellPics := TJvTFCellPics.Create(Self);
  FCanSelect := True;

  FSchedules := TStringList.Create;
  FSplitOrientation := soHorizontal;
end;

destructor TJvTFGlanceCell.Destroy;
var
  DisconnectList: TStringList;
  I: Integer;
  ASched: TJvTFSched;
begin
  FDestroying := True;

  //if not CellCollection.AllowDestroy and not CellCollection.FDestroying then
    //CellCollection.DestroyError;

  if not IsSubCell then
    FSplitRef.Free
  else
  if Assigned(FSplitRef) then
  begin
    FSplitRef.FSplitRef := nil;
    FSplitRef := nil;
  end;

  FCellPics.Free;

  DisconnectList := TStringList.Create;
  try
    DisconnectList.Assign(FSchedules);
    FSchedules.Clear;

    for I := 0 to DisconnectList.Count - 1 do
    begin
      ASched := TJvTFSched(DisconnectList.Objects[I]);
      CellCollection.GlanceControl.ReleaseSchedule(ASched.SchedName,
        ASched.SchedDate);
    end;
  finally
    DisconnectList.Free;
  end;
  FSchedules.Free;

  inherited Destroy;
end;

{ TODO 3 -cMisc: Complete TGlance.Assign }

procedure TJvTFGlanceCell.Assign(Source: TPersistent);
begin
  if Source is TJvTFGlanceCell then
  begin
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFGlanceCell.Change;
begin
  if Assigned(CellCollection.GlanceControl) then
    CellCollection.GlanceControl.Invalidate;
end;

procedure TJvTFGlanceCell.CheckConnections;
var
  GlanceControl: TJvTFCustomGlance;
  I: Integer;
  ASched: TJvTFSched;
  ASchedName, ASchedID: string;
begin
  GlanceControl := CellCollection.GlanceControl;

  if CellCollection.Configuring or not Assigned(GlanceControl.ScheduleManager) or
    (csLoading in GlanceControl.ComponentState) then
    Exit;

  // First, disconnect any schedules that shouldn't be connected
  I := 0;
  while I < FSchedules.Count do
  begin
    ASched := TJvTFSched(FSchedules.Objects[I]);
    if (GlanceControl.SchedNames.IndexOf(ASched.SchedName) = -1) or
      not EqualDates(ASched.SchedDate, CellDate) then
    begin
      FSchedules.Delete(I);
      GlanceControl.SafeReleaseSchedule(ASched);
    end
    else
      Inc(I);
  end;

  // Now connect any schedules that are not connected and should be
  for I := 0 to GlanceControl.SchedNames.Count - 1 do
  begin
    ASchedName := GlanceControl.SchedNames[I];
    ASchedID := TJvTFScheduleManager.GetScheduleID(ASchedName, CellDate);
    if FSchedules.IndexOf(ASchedID) = -1 then
    begin
      ASched := GlanceControl.RetrieveSchedule(ASchedName, CellDate);
      FSchedules.AddObject(ASchedID, ASched);
    end;
  end;

  if not CellCollection.FCheckingAllConnections then