{----------------------------------------------------------------------------- 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: JvTFDays.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.delphi-jedi.org Known Issues: This version of the source contains modifications which enable the use of time blocks. These modifications can be found by doing a search for "DEF Jv_TIMEBLOCKS". Previously, two versions were released; one which did NOT support timeblocks and one which did support timeblocks. (Hence the use of the compiler defines.) These two versions are in the process of being integrated. The compiler defines remain as an indicator of exactly what has been changed. All lines that are NOT compiled ($IFNDEF Jv_TIMEBLOCKS and $ELSE) remain as a reference during the transition, but have been commented out to reduce confusion. Many of these lines are marked by a "// remove" comment. The conditional defines and disabled code will be removed and this file will be cleaned up after the time block code has been fully integrated and tested. Changes to JvTFDays by deanh: ============================ These changes peform the following functions. 1) The addition of a new time entry is aborted if the user presses escape. 2) New property for FancyHeader to only show the '00' minutes. This emulates outlook's behaviour. 3) Few changes to clean up the dithering of the background. 4) Hide the blank area that sometimes appears at the bottom of the Calendar when scrolling right down to the bottom. 5) Remove the focus rectangle when ShowFocus is false (the focus rect is not shown in Outlook). -----------------------------------------------------------------------------} // $Id$ unit JvTFDays; {$mode objfpc}{$H+} {$define Jv_TIMEBLOCKS} interface uses LCLIntf, LCLType, LMessages, LCLVersion, Types, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ImgList, JvTFManager, JvTFSparseMatrix, JvTFUtils; const SizingThreshold = 5; gcUndef = -3; gcGroupHdr = -2; gcHdr = -1; DEFAULT_APPT_BAR_WIDTH = 5; DEFAULT_BLOCK_HDR_WIDTH = 50; DEFAULT_COL_HDR_HEIGHT = 28; DEFAULT_DEF_COL_WIDTH = 100; DEFAULT_GRAB_HANDLES_HEIGHT = 6; DEFAULT_GRANULARITY = 30; DEFAULT_GROUP_HDR_HEIGHT = 28; DEFAULT_MIN_COL_WIDTH = 5; DEFAULT_MIN_ROW_HEIGHT = 12; DEFAULT_PRIMETIME_COLOR = $00C4FFFF; DEFAULT_ROW_HDR_WIDTH = 60; DEFAULT_ROW_HEIGHT = 20; PIC_DIST = 2; type EJvTFDaysError = class(Exception); {$IFDEF Jv_TIMEBLOCKS} // remove TTFDayOfWeek and TTFDaysOfWeek, they are found in JvTFUtils //TTFDayOfWeek = (dowSunday, dowMonday, dowTuesday, dowWednesday, // dowThursday, dowFriday, dowSaturday); //TTFDaysOfWeek = set of TTFDayOfWeek; EJvTFBlockGranError = class(EJvTFDaysError); {$ENDIF Jv_TIMEBLOCKS} // Forward declarations TJvTFDays = class; TJvTFDaysCols = class; TJvTFDaysCol = class; TJvTFDaysPrinter = class; TJvTFDaysTemplate = class; TJvTFDaysHdrAttr = class; {$IFDEF Jv_TIMEBLOCKS} // okay to leave TJvTFDaysTimeBlocks = class; TJvTFDaysTimeBlock = class; {$ENDIF Jv_TIMEBLOCKS} TJvTFDaysCoord = record Col: Integer; Row: Integer; CellX: Integer; CellY: Integer; AbsX: Integer; AbsY: Integer; Schedule: TJvTFSched; Appt: TJvTFAppt; DragAccept: Boolean; end; TJvTFDrawPicInfo = class(TObject) public ImageList: TCustomImageList; ImageIndex: Integer; Glyph: TGraphic; PicLeft: Integer; PicTop: Integer; end; TJvTFDaysTemplates = (agtNone, agtLinear, agtComparative); TJvTFListMoveEvent = procedure(Sender: TObject; CurIndex, NewIndex: Integer) of object; TJvTFCompNamesList = class(TStringList) private FOnMove: TJvTFListMoveEvent; public procedure Move(CurIndex, NewIndex: Integer); override; property OnMove: TJvTFListMoveEvent read FOnMove write FOnMove; end; TJvTFDaysTemplate = class(TPersistent) private FActiveTemplate: TJvTFDaysTemplates; FCompDate: TDate; FCompNames: TJvTFCompNamesList; FLinearDayCount: Integer; FLinearEndDate: TDate; FLinearName: string; FLinearStartDate: TDate; FShortTitles: Boolean; FUpdatingGrid: Boolean; // Property Access Methods function GetCompNames: TStrings; procedure SetActiveTemplate(Value: TJvTFDaysTemplates); procedure SetCompDate(Value: TDate); procedure SetCompNames(Value: TStrings); procedure SetLinearDayCount(Value: Integer); procedure SetLinearEndDate(Value: TDate); procedure SetLinearName(const Value: string); procedure SetLinearStartDate(Value: TDate); procedure SetShortTitles(Value: Boolean); protected FCompNamesChanged: Boolean; FGrid: TJvTFDays; FUpdatingCompNames: Boolean; FIgnoreNav: Boolean; procedure DoDateChangedEvent; procedure DoDateChangingEvent(var NewDate: TDate); procedure CompNamesChanged(Sender: TObject); virtual; procedure CompNamesMoved(Sender: TObject; CurIndex, NewIndex: Integer); virtual; procedure LinearDaysChanged; virtual; procedure BeginGridUpdate; procedure EndGridUpdate; public constructor Create(AApptGrid: TJvTFDays); destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure BeginCompNamesUpdate; procedure EndCompNamesUpdate; procedure UpdateGrid; property UpdatingGrid: Boolean read FUpdatingGrid; property ApptGrid: TJvTFDays read FGrid; published property ActiveTemplate: TJvTFDaysTemplates read FActiveTemplate write SetActiveTemplate default agtNone; property CompDate: TDate read FCompDate write SetCompDate; property CompNames: TStrings read GetCompNames write SetCompNames; property IgnoreNav: Boolean read FIgnoreNav write FIgnoreNav default False; property LinearDayCount: Integer read FLinearDayCount write SetLinearDayCount; property LinearEndDate: TDate read FLinearEndDate write SetLinearEndDate; property LinearName: string read FLinearName write SetLinearName; property LinearStartDate: TDate read FLinearStartDate write SetLinearStartDate; property ShortTitles: Boolean read FShortTitles write SetShortTitles default True; end; TJvTFDaysPrimeTime = class(TPersistent) private FStartTime: TTime; FEndTime: TTime; FColor: TColor; procedure SetStartTime(Value: TTime); procedure SetEndTime(Value: TTime); procedure SetColor(Value: TColor); protected FApptGrid: TJvTFDays; FFillPic: TBitmap; procedure Change; procedure UpdateFillPic; public constructor Create(AApptGrid: TJvTFDays); destructor Destroy; override; procedure Assign(Source: TPersistent); override; published property StartTime: TTime read FStartTime write SetStartTime; property EndTime: TTime read FEndTime write SetEndTime; property Color: TColor read FColor write SetColor default DEFAULT_PRIMETIME_COLOR; end; TJvTFCreateQuickEntryEvent = procedure(Sender: TObject; var ApptID: string; var StartDate: TDate; var StartTime: TTime; var EndDate: TDate; var EndTime: TTime; var Confirm: Boolean) of object; TJvTFDropApptEvent = procedure(Appt: TJvTFAppt; SchedName: string; NewStartDate: TDate; NewStartTime: TTime; NewEndDate: TDate; NewEndTime: TTime; Share: Boolean; var Confirm: Boolean) of object; TJvTFDragRowColEvent = procedure(Sender: TObject; Index: Integer; var NewInfo: Integer; var Confirm: Boolean) of object; TJvTFSizeApptEvent = procedure(Sender: TObject; Appt: TJvTFAppt; var NewEndDT: TDateTime; var Confirm: Boolean) of object; TJvTFSelecTJvTFApptEvent = procedure(Sender: TObject; OldSel, NewSel: TJvTFAppt) of object; TJvTFDrawApptEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt; Selected: Boolean) of object; TJvTFDrawGrabHandleEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt; TopHandle: Boolean) of object; TJvTFDrawDataCellEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Col, Row: Integer) of object; TJvTFDaysCorner = (agcTopLeft, agcTopRight, agcBottomLeft, agcBottomRight); TJvTFDrawCornerEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Corner: TJvTFDaysCorner) of object; TJvTFDrawHdrEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Index: Integer; Selected: Boolean) of object; TJvTFDrawApptBarEvent = procedure(Sender: TObject; ACanvas: TCanvas; Appt: TJvTFAppt; Col: Integer; BarRect, TimeStampRect: TRect) of object; TJvTFFailEditorEvent = procedure(Sender: TObject; Col: Integer; Appt: TJvTFAppt; var EditorBounds: TRect; var Fail: Boolean) of object; TJvTFDateChangingEvent = procedure(Sender: TObject; var NewDate: TDate) of object; TJvTFGranChangingEvent = procedure(Sender: TObject; var NewGran: Integer) of object; TJvTFShadeCellEvent = procedure(Sender: TObject; ColIndex, RowIndex: Integer; var CellColor: TColor) of object; TJvTFBeginEditEvent = procedure(Sender: TObject; Appt: TJvTFAppt; var AllowEdit: Boolean) of object; TJvTFInPlaceApptEditor = class(TMemo) private FLinkedAppt: TJvTFAppt; FQuickCreate: Boolean; protected FCancelEdit: Boolean; procedure DoExit; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; public constructor Create(AOwner: TComponent); override; property LinkedAppt: TJvTFAppt read FLinkedAppt write FLinkedAppt; property QuickCreate: Boolean read FQuickCreate write FQuickCreate; end; TJvTFApptMap = class(TObject) private FData: TJvTFSparseMatrix; function GetLocation(Row, Col: Integer): TJvTFAppt; protected FGridCol: TJvTFDaysCol; procedure Add(Appt: TJvTFAppt); procedure ProcessMapGroup(GroupStart, GroupEnd: Integer); procedure UpdateMapGroups; public constructor Create(AGridCol: TJvTFDaysCol); virtual; destructor Destroy; override; procedure Clear; function ColCount(Row: Integer): Integer; procedure GetAppts(StartRow, EndRow: Integer; ApptList: TStringList); function LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer; property Location[Row, Col: Integer]: TJvTFAppt read GetLocation; procedure Refresh; function HasAppt(Appt: TJvTFAppt): Boolean; procedure Dump(AName: TFileName); // used for debugging only end; TJvTFDaysOption = (agoSizeCols, agoSizeRows, agoSizeColHdr, agoSizeRowHdr, agoMoveCols, agoSizeAppt, agoMoveAppt, agoSnapMove, agoSnapSize, agoEditing, agoShowPics, agoShowText, agoShowApptHints, agoShowColHdrHints, agoShowSelHint, agoEnforceMaxColWidth, agoQuickEntry, agoFormattedDesc); TJvTFDaysOptions = set of TJvTFDaysOption; TJvTFDaysState = (agsNormal, agsSizeCol, agsSizeRow, agsSizeColHdr, agsSizeRowHdr, agsMoveCol, agsSizeAppt, agsMoveAppt); {$IFDEF Jv_TIMEBLOCKS} // ok TJvTFColTitleStyle = (ctsSingleClip, ctsSingleEllipsis, ctsMultiClip, ctsMultiEllipsis, ctsHide, ctsRotated); {$ELSE} // remove //TJvTFColTitleStyle = (ctsSingleClip, ctsSingleEllipsis, ctsMultiClip, // ctsMultiEllipsis, ctsHide); {$ENDIF Jv_TIMEBLOCKS} TJvTFDaysThresholds = class(TPersistent) private FDetailHeight: Integer; FDetailWidth: Integer; FEditHeight: Integer; FEditWidth: Integer; FTextHeight: Integer; FTextWidth: Integer; FDropTextFirst: Boolean; FPicsAllOrNone: Boolean; FWholePicsOnly: Boolean; procedure SetDetailHeight(Value: Integer); procedure SetDetailWidth(Value: Integer); procedure SetEditHeight(Value: Integer); procedure SetEditWidth(Value: Integer); procedure SetTextHeight(Value: Integer); procedure SetTextWidth(Value: Integer); procedure SetDropTextFirst(Value: Boolean); procedure SetPicsAllOrNone(Value: Boolean); procedure SetWholePicsOnly(Value: Boolean); protected FApptGrid: TJvTFDays; procedure Change; dynamic; public constructor Create(AOwner: TJvTFDays); procedure Assign(Source: TPersistent); override; published property DetailHeight: Integer read FDetailHeight write SetDetailHeight default 10; property DetailWidth: Integer read FDetailWidth write SetDetailWidth default 10; property EditHeight: Integer read FEditHeight write SetEditHeight default 1; property EditWidth: Integer read FEditWidth write SetEditWidth default 10; property TextHeight: Integer read FTextHeight write SetTextHeight default 1; property TextWidth: Integer read FTextWidth write SetTextWidth default 10; property DropTextFirst: Boolean read FDropTextFirst write SetDropTextFirst default True; property PicsAllOrNone: Boolean read FPicsAllOrNone write SetPicsAllOrNone default False; property WholePicsOnly: Boolean read FWholePicsOnly write SetWholePicsOnly default True; end; TJvTFDaysScrollBar = class(TScrollBar) protected procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CreateWnd; override; function GetLargeChange: Integer; virtual; procedure SetLargeChange(Value: Integer); virtual; procedure UpdateRange; virtual; public constructor Create(AOwner: TComponent); override; published property LargeChange: Integer read GetLargeChange write SetLargeChange default 1; end; //TJvTFUpdateTitleEvent = Procedure(Sender: TObject; Col: TJvTFDaysCol; //var NewTitle: string) of object; TJvTFUpdateTitlesEvent = procedure(Sender: TObject; Col: TJvTFDaysCol; var NewGroupTitle, NewTitle: string) of object; {$IFDEF Jv_TIMEBLOCKS} // ok TJvTFDaysTimeBlock = class(TCollectionItem) private FLength: Integer; FTitle: string; FName: string; FAllowAppts: Boolean; procedure SetLength(Value: Integer); procedure SetTitle(const Value: string); procedure SetName(const Value: string); procedure SetAllowAppts(Value: Boolean); function GetGridLength: Integer; function GetBlockCollection: TJvTFDaysTimeBlocks; protected function GetDisplayName: string; override; procedure Change; public constructor Create(ACollection: TCollection); override; procedure Assign(Source: TPersistent); override; property BlockCollection: TJvTFDaysTimeBlocks read GetBlockCollection; published property AllowAppts: Boolean read FAllowAppts write SetAllowAppts default True; property GridLength: Integer read GetGridLength; property Length: Integer read FLength write SetLength default 1; property Name: string read FName write SetName; property Title: string read FTitle write SetTitle; end; // ok TJvTFDaysTimeBlocks = class(TCollection) private FDaysControl: TJvTFDays; function GetItem(Index: Integer): TJvTFDaysTimeBlock; procedure SetItem(Index: Integer; Value: TJvTFDaysTimeBlock); protected function GetOwner: TPersistent; override; public constructor Create(ADaysControl: TJvTFDays); function Add: TJvTFDaysTimeBlock; property DaysControl: TJvTFDays read FDaysControl; procedure Assign(Source: TPersistent); override; property Items[Index: Integer]: TJvTFDaysTimeBlock read GetItem write SetItem; default; function BlockByName(const BlockName: string): TJvTFDaysTimeBlock; function FindBlock(const BlockName: string): TJvTFDaysTimeBlock; end; // ok TJvTFDaysBlockProps = class(TPersistent) private FBlockGran: Integer; FDayStart: TTime; FDaysControl: TJvTFDays; FBlockHdrAttr: TJvTFDaysHdrAttr; FSelBlockHdrAttr: TJvTFDaysHdrAttr; FBlockHdrWidth: Integer; FOffTimeColor: TColor; FDataDivColor: TColor; FSnapMove: Boolean; FDrawOffTime: Boolean; function IsStoredBlockHdrWidth: Boolean; procedure SetBlockGran(Value: Integer); procedure SetDayStart(Value: TTime); procedure SetBlockHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetSelBlockHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetBlockHdrWidth(Value: Integer); procedure SetOffTimeColor(Value: TColor); procedure SetDataDivColor(Value: TColor); procedure SetDrawOffTime(Value: Boolean); public constructor Create(ADaysControl: TJvTFDays); destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, {%H-}AYProportion: Double); virtual; property DaysControl: TJvTFDays read FDaysControl; procedure Change; published property BlockGran: Integer read FBlockGran write SetBlockGran default 60; property BlockHdrAttr: TJvTFDaysHdrAttr read FBlockHdrAttr write SetBlockHdrAttr; property BlockHdrWidth: Integer read FBlockHdrWidth write SetBlockHdrWidth stored IsStoredBlockHdrWidth; property DataDivColor: TColor read FDataDivColor write SetDataDivColor default clBlack; property DayStart: TTime read FDayStart write SetDayStart; property DrawOffTime: Boolean read FDrawOffTime write SetDrawOffTime default True; property OffTimeColor: TColor read FOffTimeColor write SetOffTimeColor default clGray; property SelBlockHdrAttr: TJvTFDaysHdrAttr read FSelBlockHdrAttr write SetSelBlockHdrAttr; property SnapMove: Boolean read FSnapMove write FSnapMove default True; end; {$ENDIF Jv_TIMEBLOCKS} TJvTFDaysCol = class(TCollectionItem) private FMap: TJvTFApptMap; FNullSchedDate: Boolean; FSchedDate: TDate; FSchedName: string; FSchedule: TJvTFSched; FGroupTitle: string; FTitle: string; FWidth: Integer; function IsStoredWidth: Boolean; procedure SetSchedDate(Value: TDate); procedure SetSchedName(const Value: string); procedure SetGroupTitle(const Value: string); procedure SetTitle(const Value: string); procedure SetWidth(Value: Integer); protected FDisconnecting: Boolean; procedure CheckTemplate; function GetDisplayName: string; override; procedure SetIndex(Value: Integer); override; public constructor Create(ACollection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); virtual; function ColCollection: TJvTFDaysCols; property Schedule: TJvTFSched read FSchedule; function Connected: Boolean; procedure Connect; procedure Disconnect; procedure SetSchedule(const NewSchedName: string; NewSchedDate: TDate); function LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer; function MapColCount(Row: Integer): Integer; function MapLocation(Col, Row: Integer): TJvTFAppt; procedure RefreshMap; procedure CalcStartEndRows(Appt: TJvTFAppt; var StartRow, EndRow: Integer); //procedure UpdateTitle; procedure UpdateTitles; function GetFirstAppt: TJvTFAppt; function GetPrevAppt(RefAppt: TJvTFAppt): TJvTFAppt; function GetNextAppt(RefAppt: TJvTFAppt): TJvTFAppt; function GetLastAppt: TJvTFAppt; procedure DumpMap; function ApptInCol(Appt: TJvTFAppt): Boolean; published property SchedDate: TDate read FSchedDate write SetSchedDate; property SchedName: string read FSchedName write SetSchedName; property GroupTitle: string read FGroupTitle write SetGroupTitle; property Title: string read FTitle write SetTitle; property Width: Integer read FWidth write SetWidth; end; TJvTFDaysCols = class(TCollection) private FApptGrid: TJvTFDays; FPrinter: TJvTFDaysPrinter; FOldCount: Integer; function GetItem(Index: Integer): TJvTFDaysCol; procedure SetItem(Index: Integer; Value: TJvTFDaysCol); protected FAddingCol: Boolean; FSizingCols: Boolean; FUpdating: Boolean; procedure EnsureCol(Index: Integer); function GetOwner: TPersistent; override; procedure SizeCols; virtual; procedure Update(Item: TCollectionItem); override; public constructor Create(AApptGrid: TJvTFDays); constructor CreateForPrinter(APrinter: TJvTFDaysPrinter); property ApptGrid: TJvTFDays read FApptGrid; property Printer: TJvTFDaysPrinter read FPrinter; function Add: TJvTFDaysCol; property AddingCol: Boolean read FAddingCol; property Updating: Boolean read FUpdating; procedure EnsureMinColWidth; procedure EnsureMaxColWidth; procedure ResizeCols; property SizingCols: Boolean read FSizingCols; procedure MoveCol(SourceIndex, TargetIndex: Integer); procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); virtual; procedure Assign(Source: TPersistent); override; property Items[Index: Integer]: TJvTFDaysCol read GetItem write SetItem; default; procedure UpdateTitles; end; TJvTFRowHdrType = (rhGrid, rhFancy); TJvTFDaysFancyRowHdrAttr = class(TPersistent) private FColor: TColor; FHr2400: Boolean; FMinorFont: TFont; FMajorFont: TFont; FTickColor: TColor; FOnlyShow00Minutes: Boolean; procedure SetColor(Value: TColor); procedure SetHr2400(Value: Boolean); procedure SetMinorFont(Value: TFont); procedure SetMajorFont(Value: TFont); procedure SetTickColor(Value: TColor); procedure SetOnlyShow00Minutes(Value: Boolean); protected FGrid: TJvTFDays; procedure Change; virtual; procedure FontChange(Sender: TObject); virtual; public constructor Create(AOwner: TJvTFDays); destructor Destroy; override; procedure Assign(Source: TPersistent); override; published property Color: TColor read FColor write SetColor default clBtnFace; property Hr2400: Boolean read FHr2400 write SetHr2400; property MinorFont: TFont read FMinorFont write SetMinorFont; property MajorFont: TFont read FMajorFont write SetMajorFont; property TickColor: TColor read FTickColor write SetTickColor default clGray; property OnlyShow00Minutes: Boolean read FOnlyShow00Minutes write SetOnlyShow00Minutes default True; end; TJvTFDaysHdrAttr = class(TPersistent) private FApptGrid: TJvTFDays; FColor: TColor; FFont: TFont; FParentFont: Boolean; FFrame3D: Boolean; {$IFDEF Jv_TIMEBLOCKS} // ok FFrameColor: TColor; FTitleRotation: Integer; {$ENDIF Jv_TIMEBLOCKS} procedure SetColor(Value: TColor); procedure SetFont(Value: TFont); procedure SetParentFont(Value: Boolean); procedure SetFrame3D(Value: Boolean); {$IFDEF Jv_TIMEBLOCKS} // ok procedure SetFrameColor(Value: TColor); procedure SetTitleRotation(Value: Integer); {$ENDIF Jv_TIMEBLOCKS} protected procedure Change; procedure FontChange(Sender: TObject); public constructor Create(AOwner: TJvTFDays); destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure ParentFontChanged; published property Color: TColor read FColor write SetColor default clBtnFace; property Font: TFont read FFont write SetFont; property ParentFont: Boolean read FParentFont write SetParentFont default True; property Frame3D: Boolean read FFrame3D write SetFrame3D default True; {$IFDEF Jv_TIMEBLOCKS} // ok property FrameColor: TColor read FFrameColor write SetFrameColor nodefault; property TitleRotation: Integer read FTitleRotation write SetTitleRotation default 0; {$ENDIF Jv_TIMEBLOCKS} end; TJvTFTimeStampStyle = (tssNone, tssFullI, tssHalfI, tssBlock); TJvTFDaysApptBar = class(TPersistent) private FColor: TColor; FVisible: Boolean; FWidth: Integer; FTimeStampStyle: TJvTFTimeStampStyle; FTimeStampColor: TColor; function IsStoredWidth: Boolean; procedure SetColor(Value: TColor); procedure SetVisible(Value: Boolean); procedure SetWidth(Value: Integer); procedure SetTFTimeStampStyle(Value: TJvTFTimeStampStyle); procedure SetTimeStampColor(Value: TColor); protected FApptGrid: TJvTFDays; procedure Change; virtual; public constructor Create(AApptGrid: TJvTFDays); procedure Assign(Source: TPersistent); override; procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); virtual; published property Color: TColor read FColor write SetColor default clBlue; property Width: Integer read FWidth write SetWidth stored IsStoredWidth; property Visible: Boolean read FVisible write SetVisible default True; property TimeStampStyle: TJvTFTimeStampStyle read FTimeStampStyle write SetTFTimeStampStyle default tssBlock; property TimeStampColor: TColor read FTimeStampColor write SetTimeStampColor default clBlue; end; TJvTFDaysApptAttr = class(TPersistent) private FColor: TColor; FFont: TFont; FParentFont: Boolean; FFrameColor: TColor; FFrameWidth: Integer; procedure SetColor(Value: TColor); procedure SetFont(Value: TFont); procedure SetParentFont(Value: Boolean); procedure SetFrameColor(Value: TColor); procedure SetFrameWidth(Value: Integer); protected FApptGrid: TJvTFDays; procedure Change; virtual; procedure FontChange(Sender: TObject); virtual; public constructor Create(AApptGrid: TJvTFDays); destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure ParentFontChanged; virtual; published property Color: TColor read FColor write SetColor default clWindow; property Font: TFont read FFont write SetFont; property ParentFont: Boolean read FParentFont write SetParentFont default True; property FrameColor: TColor read FFrameColor write SetFrameColor default clBlack; property FrameWidth: Integer read FFrameWidth write SetFrameWidth default 1; end; TJvTFSelCellStyle = (scsSolid, scsFrame, scsCombo); TJvTFSelCellAttr = class(TPersistent) private FColor: TColor; FFrameWidth: Integer; FStyle: TJvTFSelCellStyle; procedure SetColor(Value: TColor); procedure SetFrameWidth(Value: Integer); procedure SetStyle(Value: TJvTFSelCellStyle); protected FApptGrid: TJvTFDays; procedure Change; virtual; public constructor Create(AApptGrid: TJvTFDays); procedure Assign(Source: TPersistent); override; published property Color: TColor read FColor write SetColor default clHighlight; property FrameWidth: Integer read FFrameWidth write SetFrameWidth default 2; property Style: TJvTFSelCellStyle read FStyle write SetStyle default scsSolid; end; TJvTFGrabStyle = (gs3D, gsFlat); TJvTFDaysGrabHandles = class(TPersistent) private FColor: TColor; FHeight: Integer; FStyle: TJvTFGrabStyle; function IsStoredHeight: Boolean; procedure SetColor(Value: TColor); procedure SetHeight(Value: Integer); procedure SetStyle(Value: TJvTFGrabStyle); protected FApptGrid: TJvTFDays; procedure Change; virtual; property Style: TJvTFGrabStyle read FStyle write SetStyle default gsFlat; public constructor Create(AApptGrid: TJvTFDays); procedure Assign(Source: TPersistent); override; procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); virtual; published property Height: Integer read FHeight write SetHeight stored IsStoredHeight; property Color: TColor read FColor write SetColor default clBlue; end; {$M+} TJvTFDaysApptDrawInfo = class(TObject) private FColor: TColor; FFrameColor: TColor; FFrameWidth: Integer; FFont: TFont; FVisible: Boolean; procedure SetColor(Value: TColor); procedure SetFrameColor(Value: TColor); procedure SetFont(Value: TFont); procedure SetFrameWidth(const Value: Integer); procedure SetVisible(Value: Boolean); public constructor Create; destructor Destroy; override; published property Color: TColor read FColor write SetColor; property FrameColor: TColor read FFrameColor write SetFrameColor; property FrameWidth: Integer read FFrameWidth write SetFrameWidth; property Font: TFont read FFont write SetFont; property Visible: Boolean read FVisible write SetVisible; end; {$M-} TJvTFGetDaysApptDrawInfoEvent = procedure(Sender: TObject; Appt: TJvTFAppt; DrawInfo: TJvTFDaysApptDrawInfo) of object; TDynPointArray = array of TPoint; TDynIntArray = array of Integer; TJvTFDaysGrouping = (grNone, grDate, grResource, grCustom); TJvTFAutoScrollDir = (asdUp, asdDown, asdLeft, asdRight, asdNowhere); TJvTFDays = class(TJvTFControl) private // internal stuff // FBorderStyle: TBorderStyle; FHitTest: TPoint; FVisibleScrollBars: TJvTFVisibleScrollBars; FDitheredBackground: Boolean; // row, col layout FGranularity: Integer; FColHdrHeight: Integer; FRowHdrWidth: Integer; FRowHeight: Integer; FMinRowHeight: Integer; FDefColWidth: Integer; FMinColWidth: Integer; FAutoSizeCols: Boolean; FColTitleStyle: TJvTFColTitleStyle; FGroupHdrHeight: Integer; FCols: TJvTFDaysCols; FTemplate: TJvTFDaysTemplate; FTopRow: Integer; FFocusedRow: Integer; FLeftCol: Integer; FFocusedCol: Integer; FGrouping: TJvTFDaysGrouping; FGridStartTime: TTime; FGridEndTime: TTime; {$IFDEF Jv_TIMEBLOCKS} // ok FTimeBlockProps: TJvTFDaysBlockProps; FTimeBlocks: TJvTFDaysTimeBlocks; {$ENDIF Jv_TIMEBLOCKS} // visual appearance attr's FHdrAttr: TJvTFDaysHdrAttr; FSelHdrAttr: TJvTFDaysHdrAttr; FApptAttr: TJvTFDaysApptAttr; FSelApptAttr: TJvTFDaysApptAttr; FFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr; FSelFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr; FRowHdrType: TJvTFRowHdrType; FSelCellAttr: TJvTFSelCellAttr; FApptBar: TJvTFDaysApptBar; FApptBuffer: Integer; FGridLineColor: TColor; FGrabHandles: TJvTFDaysGrabHandles; FThresholds: TJvTFDaysThresholds; FPrimeTime: TJvTFDaysPrimeTime; FGroupHdrAttr: TJvTFDaysHdrAttr; FSelGroupHdrAttr: TJvTFDaysHdrAttr; FOptions: TJvTFDaysOptions; FEditor: TJvTFInPlaceApptEditor; FHintProps: TJvTFHintProps; {$IFDEF Jv_TIMEBLOCKS} // ok FWeekend: TTFDaysOfWeek; FWeekendColor: TColor; {$ENDIF Jv_TIMEBLOCKS} // Row/Col Sizing/Moving Events FOnSizeCol: TJvTFDragRowColEvent; FOnSizeRow: TJvTFDragRowColEvent; FOnSizeColHdr: TJvTFDragRowColEvent; FOnSizeRowHdr: TJvTFDragRowColEvent; FOnMoveCol: TJvTFDragRowColEvent; // Appt mouse events FOnSelectingAppt: TJvTFVarApptEvent; FOnSelectAppt: TJvTFSelecTJvTFApptEvent; FOnSelectedAppt: TNotifyEvent; FOnSizeAppt: TJvTFSizeApptEvent; FOnDropAppt: TJvTFDropApptEvent; // Drawing events FOnDrawAppt: TJvTFDrawApptEvent; FOnDrawApptBar: TJvTFDrawApptBarEvent; FOnDrawCorner: TJvTFDrawCornerEvent; FOnDrawColHdr: TJvTFDrawHdrEvent; FOnDrawDataCell: TJvTFDrawDataCellEvent; FOnDrawGrabHandle: TJvTFDrawGrabHandleEvent; FOnDrawMajorRowHdr: TJvTFDrawHdrEvent; FOnDrawMinorRowHdr: TJvTFDrawHdrEvent; FOnDrawRowHdr: TJvTFDrawHdrEvent; //FOnUpdateColTitle: TJvTFUpdateTitleEvent; FOnUpdateColTitles: TJvTFUpdateTitlesEvent; FOnDrawGroupHdr: TJvTFDrawHdrEvent; FOnShadeCell: TJvTFShadeCellEvent; FOnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent; // editor events FOnFailEditor: TJvTFFailEditorEvent; FOnCreateQuickEntry: TJvTFCreateQuickEntryEvent; FOnQuickEntry: TNotifyEvent; FOnBeginEdit: TJvTFBeginEditEvent; // navigation events FOnInsertAppt: TNotifyEvent; FOnInsertSchedule: TNotifyEvent; FOnDeleteAppt: TNotifyEvent; FOnDeleteSchedule: TNotifyEvent; FOnDateChanging: TJvTFDateChangingEvent; FOnDateChanged: TNotifyEvent; FOnGranularityChanging: TJvTFGranChangingEvent; FOnGranularityChanged: TNotifyEvent; FOnFocusedRowChanged: TNotifyEvent; FOnFocusedColChanged: TNotifyEvent; FShowFocus: Boolean; // internal stuff // procedure CMCtl3DChanged(var Msg: TLMessage); message CM_CTL3DCHANGED; procedure WMGetDlgCode(var Msg: TLMGetDlgCode); message LM_GETDLGCODE; // procedure SetBorderStyle(Value: TBorderStyle); procedure SetTFVisibleScrollBars(Value: TJvTFVisibleScrollBars); procedure AlignScrollBars; function CheckSBVis: Boolean; procedure SetOnShowHint(Value: TJvTFShowHintEvent); function GetOnShowHint: TJvTFShowHintEvent; {$IFDEF Jv_TIMEBLOCKS} // ok procedure UpdateWeekendFillPic; {$ENDIF Jv_TIMEBLOCKS} // row, col layout procedure SetGranularity(Value: Integer); procedure SetColHdrHeight(Value: Integer); procedure SetRowHdrWidth(Value: Integer); procedure SetRowHeight(Value: Integer); procedure SetMinRowHeight(Value: Integer); procedure SetMinColWidth(Value: Integer); procedure SetAutoSizeCols(Value: Boolean); procedure SetTFColTitleStyle(Value: TJvTFColTitleStyle); procedure SetCols(Value: TJvTFDaysCols); procedure SetTopRow(Value: Integer); procedure SetFocusedRow(Value: Integer); function GetFocusedRow: Integer; procedure SetLeftCol(Value: Integer); procedure SetFocusedCol(Value: Integer); function GetFocusedCol: Integer; procedure SetGrouping(Value: TJvTFDaysGrouping); procedure SetGroupHdrHeight(Value: Integer); procedure SetGridStartTime(Value: TTime); procedure SetGridEndTime(Value: TTime); {$IFDEF Jv_TIMEBLOCKS} // ok procedure SetTimeBlockProps(Value: TJvTFDaysBlockProps); // ok procedure SetTimeBlocks(Value: TJvTFDaysTimeBlocks); {$ENDIF Jv_TIMEBLOCKS} // visual appearance attr's procedure SetHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetSelHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetApptAttr(Value: TJvTFDaysApptAttr); procedure SetSelApptAttr(Value: TJvTFDaysApptAttr); procedure SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr); procedure SetSelFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr); procedure SetTFRowHdrType(Value: TJvTFRowHdrType); procedure SetTFSelCellAttr(Value: TJvTFSelCellAttr); procedure SetApptBar(Value: TJvTFDaysApptBar); procedure SetApptBuffer(Value: Integer); procedure SetGridLineColor(Value: TColor); procedure SetGrabHandles(Value: TJvTFDaysGrabHandles); procedure SetGroupHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetSelGroupHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetOptions(Value: TJvTFDaysOptions); procedure SetTFHintProps(Value: TJvTFHintProps); procedure DrawDither(ACanvas: TCanvas; ARect: TRect; Color1, Color2: TColor); {$IFDEF Jv_TIMEBLOCKS} // ok procedure SetWeekend(Value: TTFDaysOfWeek); // ok procedure SetWeekendColor(Value: TColor); procedure SetDitheredBackground(const Value: Boolean); procedure SetShowFocus(const Value: Boolean); {$ENDIF Jv_TIMEBLOCKS} function IsStoredColHdrHeight: Boolean; function IsStoredDefColWidth: Boolean; function IsStoredGroupHdrHeight: Boolean; function IsStoredMinColWidth: Boolean; function IsStoredMinRowHeight: Boolean; function IsStoredRowHdrWidth: Boolean; function IsStoredRowHeight: Boolean; protected FState: TJvTFDaysState; FHint: TJvTFHint; FNeedCheckSBParams: Boolean; PaintBuffer: TBitmap; {$IFDEF Jv_TIMEBLOCKS} // ok FWeekendFillPic: TBitmap; {$ENDIF Jv_TIMEBLOCKS} FBeginDraggingCoord: TJvTFDaysCoord; FDraggingCoord: TJvTFDaysCoord; FSelAppt: TJvTFAppt; FSelStart: TPoint; FSelEnd: TPoint; FFromToSel: Boolean; FSaveFocCol: Integer; FHScrollBar: TScrollBar; FVScrolLBar: TScrollBar; { FHScrollBar: TJvTFDaysScrollBar; FVScrollBar: TJvTFDaysScrollBar; } FAutoScrollDir: TJvTFAutoScrollDir; FLiveTimer: Boolean; FMouseMovePt: TPoint; FMouseMoveState: TShiftState; procedure SetDateFormat(const Value: string); override; procedure ReqSchedNotification(Schedule: TJvTFSched); override; procedure RelSchedNotification(Schedule: TJvTFSched); override; procedure CreateParams(var Params: TCreateParams); override; function GetFocusedSchedule: TJvTFSched; procedure SetSelAppt(Value: TJvTFAppt); //procedure SetGroupTitles; dynamic; //procedure ReorderCols; // All painting routines procedure Paint; override; procedure DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer); procedure DrawEmptyColHdr(ACanvas: TCanvas); procedure DrawAppt(ACanvas: TCanvas; Col: Integer; Appt: TJvTFAppt; StartRow, EndRow: Integer); procedure DrawApptDetail(ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt; Selected: Boolean; Col, StartRow, EndRow: Integer); procedure DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer); function CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer): TRect; procedure DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect); procedure DrawPics(ACanvas: TCanvas; var ARect: TRect; Appt: TJvTFAppt); procedure CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt; DrawList: TList); procedure FilterPicDrawList(ARect: TRect; DrawList: TList; out PicsHeight, PicsWidth: Integer); procedure ClearPicDrawList(DrawList: TList); procedure DrawListPics(ACanvas: TCanvas; var ARect: TRect; DrawList: TList); procedure DrawGrabLines(ACanvas: TCanvas; LineTop, LineLeft, LineRight: Integer); procedure DrawGrabHandle(ACanvas: TCanvas; ARect: TRect; AAppt: TJvTFAppt; TopHandle: Boolean); procedure DrawCorner(ACanvas: TCanvas; Corner: TJvTFDaysCorner); procedure DrawRowHdr(ACanvas: TCanvas; Index: Integer); //procedure DrawColHdr(ACanvas: TCanvas; Index: Integer); function GetTallestColTitle(ACanvas: TCanvas): Integer; procedure GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo; AAppt: TJvTFAppt; Attr: TJvTFDaysApptAttr); {$IFDEF Jv_TIMEBLOCKS} // ok to REPLACE old DrawFrame procedure DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean; FrameColour: TColor); {$ELSE} // obsolete //procedure DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean); {$ENDIF Jv_TIMEBLOCKS} procedure DrawAppts(ACanvas: TCanvas; DrawAll: Boolean); procedure AdjustForMargins(var ARect: TRect); procedure CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect; PicsHeight: Integer; out CanDrawText, CanDrawPics: Boolean); procedure ManualFocusRect(ACanvas: TCanvas; ARect: TRect); // Fancy painting routines procedure DrawFancyRowHdrs(ACanvas: TCanvas); procedure DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer; const LabelStr: string; TickLength: Integer; Selected: Boolean); function GetMinorLabel(RowNum: Integer): string; function GetMinorTickLength: Integer; virtual; function GetMajorTickLength: Integer; virtual; procedure DrawGroupHdrs(ACanvas: TCanvas); //procedure DrawGroupHdr(ACanvas: TCanvas; ACol: Integer); procedure DrawColGroupHdr(ACanvas: TCanvas; Index: Integer; IsGroupHdr: Boolean); {$IFDEF Jv_TIMEBLOCKS} // ok procedure DrawBlockHdr(ACanvas: TCanvas; BlockIndex: Integer); // ok procedure FillBlockHdrDeadSpace(ACanvas: TCanvas); // REMOVE, replaced by CalcTextPos in JvTFUtils //procedure CalcTextPos(var ARect: TRect; aAngle: Integer; aTxt: string); // REMOVE, replaced by DrawAngleText in JvTFUtils //procedure DrawAngleText(ACanvas: TCanvas; ARect: TRect; aAngle: Integer; //aTxt: string); {$ENDIF Jv_TIMEBLOCKS} // message handlers procedure Resize; override; procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMSetCursor(var Msg: TLMSetCursor); message LM_SETCURSOR; procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST; procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CNRequestRefresh(var Msg: TCNRequestRefresh); message CN_REQUESTREFRESH; procedure WMTimer(var Msg: TLMTimer); message LM_TIMER; procedure CMFontChanged(var Msg: TLMessage); message CM_FONTCHANGED; procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE; // internal routines procedure Loaded; override; procedure RefreshControl; override; procedure UpdateDesigner; // scroll bar stuff procedure CheckSBParams; procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); property VisibleScrollBars: TJvTFVisibleScrollBars read FVisibleScrollBars write SetTFVisibleScrollBars; // 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 DoApptHint(GridCoord: TJvTFDaysCoord); procedure DoCellHint(GridCoord: TJvTFDaysCoord); // 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(ADragInfo: TJvTFDragInfo; X, Y: Integer); procedure BeginDragging(Coord: TJvTFDaysCoord; DragWhat: TJvTFDaysState; Appt: TJvTFAppt); procedure DrawDrag(Coord: TJvTFDaysCoord; AAppt: TJvTFAppt; AClear: Boolean); procedure ContinueDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt); procedure EndDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt); function CanDragWhat(Coord: TJvTFDaysCoord): TJvTFDaysState; procedure CalcSizeEndTime(Appt: TJvTFAppt; out NewEndDT: TDateTime); procedure CalcMoveStartEnd(Appt: TJvTFAppt; Coord: TJvTFDaysCoord; KeepDates, KeepTimes: Boolean; out StartDT, EndDT: TDateTime); procedure KillAutoScrollTimer; procedure EnsureCol(ACol: Integer); procedure EnsureRow(ARow: Integer); // navigation procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; procedure DoInsertSchedule; dynamic; procedure DoInsertAppt; dynamic; procedure DoDeleteAppt; dynamic; procedure DoDeleteSchedule; dynamic; // procedure DoNavigate; virtual; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; procedure DestroyApptNotification(AAppt: TJvTFAppt); override; procedure Navigate(AControl: TJvTFControl; SchedNames: TStringList; Dates: TJvTFDateList); override; procedure DoEnter; override; procedure DoExit; override; // Selection methods function GetSelStart: TPoint; function GetSelEnd: TPoint; procedure SetSelStart(Value: TPoint); procedure SetSelEnd(Value: TPoint); procedure QuickEntry(Key: Char); virtual; {$IFDEF Jv_TIMEBLOCKS} // ok procedure EnsureBlockRules(GridGran, BlockGran: Integer; DayStart: TTime); // ok function ValidateBlockRules(GridGran, BlockGran: Integer; DayStart: TTime): Boolean; {$ENDIF Jv_TIMEBLOCKS} { Lazarus } class function GetControlClassDefaultSize: TSize; override; { lcl scaling } {$IF LCL_FullVersion >= 1080000} protected procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; public procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND} const AProportion: Double); override; {$IFEND} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetTFHintClass: TJvTFHintClass; dynamic; // move grab handles function GetTopGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect; // move grab handles function GetBottomGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect; function PtInTopHandle(APoint: TPoint; Col: Integer; Appt: TJvTFAppt): Boolean; function PtInBottomHandle(APoint: TPoint; Col: Integer; Appt: TJvTFAppt): Boolean; // grid region functions function GetAdjClientRect: TRect; function GetDataAreaRect: TRect; function GetDataWidth: Integer; function GetDataHeight: Integer; function PtToCell(X, Y: Integer): TJvTFDaysCoord; function CellRect(Col, Row: Integer): TRect; function VirtualCellRect(Col, Row: Integer): TRect; function GetApptRect(Col: Integer; Appt: TJvTFAppt): TRect; function LocateDivCol(X, TotalWidth, SegCount: Integer): Integer; function CalcGroupHdrHeight: Integer; function CalcGroupColHdrsHeight: Integer; function VirtualGroupHdrRect(Col: Integer): TRect; procedure GetGroupStartEndCols(Col: Integer; var StartCol, EndCol: Integer); {$IFDEF Jv_TIMEBLOCKS} // ok function RowToTimeBlock(ARow: Integer): Integer; // ok procedure GetTimeBlockStartEnd(ATimeBlock: Integer; out BlockStart, BlockEnd: Integer); // ok function CalcBlockHdrWidth: Integer; // ok function CalcBlockRowHdrsWidth: Integer; // ok procedure GetBlockStartEndRows(Row: Integer; out StartRow, EndRow: Integer); // ok function VirtualBlockHdrRect(Row: Integer): TRect; {$ENDIF Jv_TIMEBLOCKS} // editor management routines procedure EditAppt(Col: Integer; Appt: TJvTFAppt); procedure FinishEditAppt; function Editing: Boolean; function CanEdit: Boolean; dynamic; // grid layout routines function RowsPerHour: Integer; function RowCount: Integer; function PossVisibleRows: Integer; function VisibleRows: Integer; function FullVisibleRows: Integer; function VisibleCols: Integer; function FullVisibleCols: Integer; function RowToTime(RowNum: Integer): TTime; function TimeToRow(ATime: TTime): Integer; procedure TimeToTop(ATime: TTime); function AdjustEndTime(ATime: TTime): TTime; dynamic; function RowStartsHour(RowNum: Integer): Boolean; function RowEndsHour(RowNum: Integer): Boolean; function RowEndTime(RowNum: Integer): TTime; function RowToHour(RowNum: Integer): Word; function HourStartRow(Hour: Word): Integer; function HourEndRow(Hour: Word): Integer; property State: TJvTFDaysState read FState; function BottomRow: Integer; function RightCol: Integer; property SelAppt: TJvTFAppt read FSelAppt write SetSelAppt; property FocusedSchedule: TJvTFSched read GetFocusedSchedule; procedure DragDrop(Source: TObject; X, Y: Integer); override; procedure CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate; out StartRow, EndRow: Integer); {$IFDEF Jv_TIMEBLOCKS} // ok function IsWeekend(ColIndex: Integer): Boolean; {$ENDIF Jv_TIMEBLOCKS} // date navigation methods function CurrentDate: TDate; procedure PrevDate; procedure NextDate; procedure GotoDate(aDate: TDate); procedure ScrollDays(NumDays: Integer); procedure ScrollMonths(NumMonths: Integer); procedure ScrollYears(NumYears: Integer); procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); override; procedure RowInView(ARow: Integer); procedure ColInView(ACol: Integer); // selection properties and methods property FocusedCol: Integer read GetFocusedCol write SetFocusedCol; property FocusedRow: Integer read GetFocusedRow write SetFocusedRow; property SelStart: TPoint read GetSelStart write SetSelStart; property SelEnd: TPoint read GetSelEnd write SetSelEnd; function CellIsSelected(ACell: TPoint): Boolean; function ColIsSelected(ACol: Integer): Boolean; function RowIsSelected(ARow: Integer): Boolean; procedure ClearSelection; function ValidSelection: Boolean; procedure SelFirstAppt; procedure SelPrevAppt; procedure SelNextAppt; procedure SelLastAppt; procedure SelFirstApptNextCol; procedure SelFirstApptPrevCol; procedure ApptInView(AAppt: TJvTFAppt; ACol: Integer); procedure SelApptCell(AAppt: TJvTFAppt; ACol: Integer); function GroupHdrIsSelected(ACol: Integer): Boolean; {$IFDEF Jv_TIMEBLOCKS} // ok function BlockHdrIsSelected(ARow: Integer): Boolean; {$ENDIF Jv_TIMEBLOCKS} function EnumSelCells: TDynPointArray; function EnumSelCols: TDynIntArray; function EnumSelRows: TDynIntArray; function GetApptDispColor(Appt: TJvTFAppt; Selected: Boolean): TColor; published property DitheredBackground: Boolean read FDitheredBackground write SetDitheredBackground default false; // property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; // grid layout properties property AutoSizeCols: Boolean read FAutoSizeCols write SetAutoSizeCols default True; property Granularity: Integer read FGranularity write SetGranularity default DEFAULT_GRANULARITY; property ColHdrHeight: Integer read FColHdrHeight write SetColHdrHeight stored IsStoredColHdrHeight; //default DEFAULT_COL_HDR_HEIGHT; property Cols: TJvTFDaysCols read FCols write SetCols; property DefColWidth: Integer read FDefColWidth write FDefColWidth stored IsStoredDefColWidth; //default DEFAULT_DEF_COL_WIDTH; property MinColWidth: Integer read FMinColWidth write SetMinColWidth stored IsStoredMinColWidth; //default AbsMinColWidth; property MinRowHeight: Integer read FMinRowHeight write SetMinRowHeight stored IsStoredMinRowHeight; //default DEFAULT_MIN_ROW_HEIGHT; property Options: TJvTFDaysOptions read FOptions write SetOptions default [agoSizeCols, agoSizeRows, agoSizeColHdr, agoSizeRowHdr, agoSizeAppt, agoMoveAppt, agoEditing, agoShowPics, agoShowText, agoShowApptHints, agoQuickEntry, agoShowSelHint]; property RowHdrWidth: Integer read FRowHdrWidth write SetRowHdrWidth stored IsStoredRowHdrWidth; //default DEFAULT_ROW_HDR_WIDTH; property RowHeight: Integer read FRowHeight write SetRowHeight stored IsStoredRowHeight; //default DEFAULT_ROW_HEIGHT; property ShowFocus:Boolean read FShowFocus write SetShowFocus default True; property Template: TJvTFDaysTemplate read FTemplate write FTemplate; property Grouping: TJvTFDaysGrouping read FGrouping write SetGrouping; property GroupHdrHeight: Integer read FGroupHdrHeight write SetGroupHdrHeight stored IsStoredGroupHdrHeight; //default DEFAULT_GROUP_HDR_HEIGHT; property GridStartTime: TTime read FGridStartTime write SetGridStartTime; property GridEndTime: TTime read FGridEndTime write SetGridEndTime; {$IFDEF Jv_TIMEBLOCKS} // ok property TimeBlocks: TJvTFDaysTimeBlocks read FTimeBlocks write SetTimeBlocks; property TimeBlockProps: TJvTFDaysBlockProps read FTimeBlockProps write SetTimeBlockProps; {$ENDIF Jv_TIMEBLOCKS} // visual appearance properties property ApptAttr: TJvTFDaysApptAttr read FApptAttr write SetApptAttr; property SelApptAttr: TJvTFDaysApptAttr read FSelApptAttr write SetSelApptAttr; property HdrAttr: TJvTFDaysHdrAttr read FHdrAttr write SetHdrAttr; property SelHdrAttr: TJvTFDaysHdrAttr read FSelHdrAttr write SetSelHdrAttr; property FancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr read FFancyRowHdrAttr write SetFancyRowHdrAttr; property SelFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr read FSelFancyRowHdrAttr write SetSelFancyRowHdrAttr; property SelCellAttr: TJvTFSelCellAttr read FSelCellAttr write SetTFSelCellAttr; property ApptBar: TJvTFDaysApptBar read FApptBar write SetApptBar; property ApptBuffer: Integer read FApptBuffer write SetApptBuffer default 5; property ColTitleStyle: TJvTFColTitleStyle read FColTitleStyle write SetTFColTitleStyle default ctsSingleEllipsis; property GrabHandles: TJvTFDaysGrabHandles read FGrabHandles write SetGrabHandles; property GridLineColor: TColor read FGridLineColor write SetGridLineColor default clGray; property PrimeTime: TJvTFDaysPrimeTime read FPrimeTime write FPrimeTime; property RowHdrType: TJvTFRowHdrType read FRowHdrType write SetTFRowHdrType default rhFancy; property Thresholds: TJvTFDaysThresholds read FThresholds write FThresholds; property HintProps: TJvTFHintProps read FHintProps write SetTFHintProps; property GroupHdrAttr: TJvTFDaysHdrAttr read FGroupHdrAttr write SetGroupHdrAttr; property SelGroupHdrAttr: TJvTFDaysHdrAttr read FSelGroupHdrAttr write SetSelGroupHdrAttr; {$IFDEF Jv_TIMEBLOCKS} // ok property Weekend: TTFDaysOfWeek read FWeekend write SetWeekend default [dowSunday, dowSaturday]; property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clSilver; {$ENDIF Jv_TIMEBLOCKS} // navigation/selection properties property LeftCol: Integer read FLeftCol write SetLeftCol; property TopRow: Integer read FTopRow write SetTopRow default 0; // Drag/Drop events property OnDropAppt: TJvTFDropApptEvent read FOnDropAppt write FOnDropAppt; property OnSizeAppt: TJvTFSizeApptEvent read FOnSizeAppt write FOnSizeAppt; // Grid Layout events property OnSizeCol: TJvTFDragRowColEvent read FOnSizeCol write FOnSizeCol; property OnSizeRow: TJvTFDragRowColEvent read FOnSizeRow write FOnSizeRow; property OnSizeColHdr: TJvTFDragRowColEvent read FOnSizeColHdr write FOnSizeColHdr; property OnSizeRowHdr: TJvTFDragRowColEvent read FOnSizeRowHdr write FOnSizeRowHdr; property OnMoveCol: TJvTFDragRowColEvent read FOnMoveCol write FOnMoveCol; property OnDateChanging: TJvTFDateChangingEvent read FOnDateChanging write FOnDateChanging; property OnDateChanged: TNotifyEvent read FOnDateChanged write FOnDateChanged; property OnGranularityChanging: TJvTFGranChangingEvent read FOnGranularityChanging write FOnGranularityChanging; property OnGranularityChanged: TNotifyEvent read FOnGranularityChanged write FOnGranularityChanged; // Custom draw events property OnDrawAppt: TJvTFDrawApptEvent read FOnDrawAppt write FOnDrawAppt; property OnDrawApptBar: TJvTFDrawApptBarEvent read FOnDrawApptBar write FOnDrawApptBar; property OnDrawColHdr: TJvTFDrawHdrEvent read FOnDrawColHdr write FOnDrawColHdr; property OnDrawCorner: TJvTFDrawCornerEvent read FOnDrawCorner write FOnDrawCorner; property OnDrawDataCell: TJvTFDrawDataCellEvent read FOnDrawDataCell write FOnDrawDataCell; property OnDrawGrabHandle: TJvTFDrawGrabHandleEvent read FOnDrawGrabHandle write FOnDrawGrabHandle; property OnDrawMajorRowHdr: TJvTFDrawHdrEvent read FOnDrawMajorRowHdr write FOnDrawMajorRowHdr; property OnDrawMinorRowHdr: TJvTFDrawHdrEvent read FOnDrawMinorRowHdr write FOnDrawMinorRowHdr; property OnDrawRowHdr: TJvTFDrawHdrEvent read FOnDrawRowHdr write FOnDrawRowHdr; property OnDrawGroupHdr: TJvTFDrawHdrEvent read FOnDrawGroupHdr write FOnDrawGroupHdr; property OnShadeCell: TJvTFShadeCellEvent read FOnShadeCell write FOnShadeCell; property OnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent read FOnGetApptDrawInfo write FOnGetApptDrawInfo; // Input events property OnFailEditor: TJvTFFailEditorEvent read FOnFailEditor write FOnFailEditor; property OnInsertAppt: TNotifyEvent read FOnInsertAppt write FOnInsertAppt; property OnInsertSchedule: TNotifyEvent read FOnInsertSchedule write FOnInsertSchedule; property OnDeleteAppt: TNotifyEvent read FOnDeleteAppt write FOnDeleteAppt; property OnDeleteSchedule: TNotifyEvent read FOnDeleteSchedule write FOnDeleteSchedule; property OnCreateQuickEntry: TJvTFCreateQuickEntryEvent read FOnCreateQuickEntry write FOnCreateQuickEntry; property OnQuickEntry: TNotifyEvent read FOnQuickEntry write FOnQuickEntry; property OnBeginEdit: TJvTFBeginEditEvent read FOnBeginEdit write FOnBeginEdit; // Help and Hint events property OnShowHint: TJvTFShowHintEvent read GetOnShowHint write SetOnShowHint; // Misc events property OnSelectingAppt: TJvTFVarApptEvent read FOnSelectingAppt write FOnSelectingAppt; property OnSelectAppt: TJvTFSelecTJvTFApptEvent read FOnSelectAppt write FOnSelectAppt; property OnSelectedAppt: TNotifyEvent read FOnSelectedAppt write FOnSelectedAppt; //property OnUpdateColTitle: TJvTFUpdateTitleEvent read FOnUpdateColTitle //write FOnUpdateColTitle; property OnUpdateColTitles: TJvTFUpdateTitlesEvent read FOnUpdateColTitles write FOnUpdateColTitles; property OnFocusedRowChanged: TNotifyEvent read FOnFocusedRowChanged write FOnFocusedRowChanged; property OnFocusedColChanged: TNotifyEvent read FOnFocusedColChanged write FOnFocusedColChanged; //Inherited properties property DateFormat; // from TJvTFControl property TimeFormat; // from TJvTFControl // property Navigator; // from TJvTFControl // property OnNavigate; // from TJvTFControl property Align; property BorderSpacing; property BorderStyle; property Color default clSilver; property ParentColor default False; property Font; property ParentFont; property TabStop; 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; TJvTFDaysPrinterPageLayout = class(TJvTFPrinterPageLayout) private FColsPerPage: Integer; FRowsPerPage: Integer; FAlwaysShowColHdr: Boolean; FAlwaysShowRowHdr: Boolean; procedure SetColsPerPage(Value: Integer); procedure SetRowsPerPage(Value: Integer); procedure SetAlwaysShowColHdr(Value: Boolean); procedure SetAlwaysShowRowHdr(Value: Boolean); public procedure Assign(Source: TPersistent); override; published property ColsPerPage: Integer read FColsPerPage write SetColsPerPage; property RowsPerPage: Integer read FRowsPerPage write SetRowsPerPage; property AlwaysShowColHdr: Boolean read FAlwaysShowColHdr write SetAlwaysShowColHdr; property AlwaysShowRowHdr: Boolean read FAlwaysShowRowHdr write SetAlwaysShowRowHdr; end; TJvTFDaysPageInfo = class(TObject) private FPageNum: Integer; FStartRow: Integer; FEndRow: Integer; FStartCol: Integer; FEndCol: Integer; FRowHeight: Integer; FColWidth: Integer; FShowRowHdr: Boolean; FShowColHdr: Boolean; public property PageNum: Integer read FPageNum write FPageNum; property StartRow: Integer read FStartRow write FStartRow; property EndRow: Integer read FEndRow write FEndRow; property StartCol: Integer read FStartCol write FStartCol; property EndCol: Integer read FEndCol write FEndCol; property RowHeight: Integer read FRowHeight write FRowHeight; property ColWidth: Integer read FColWidth write FColWidth; property ShowRowHdr: Boolean read FShowRowHdr write FShowRowHdr; property ShowColHdr: Boolean read FShowColHdr write FShowColHdr; end; TJvTFDaysPrinter = class(TJvTFPrinter) private FApptCount: Integer; FApptAttr: TJvTFDaysApptAttr; FApptBar: TJvTFDaysApptBar; FApptBuffer: Integer; FColHdrHeight: Integer; FColor: TColor; FCols: TJvTFDaysCols; FColTitleStyle: TJvTFColTitleStyle; FFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr; FGranularity: Integer; FGridLineColor: TColor; FGroupHdrAttr: TJvTFDaysHdrAttr; FGroupHdrHeight: Integer; FGrouping: TJvTFDaysGrouping; FHdrAttr: TJvTFDaysHdrAttr; FMinColWidth: Integer; FMinRowHeight: Integer; FPrimeTime: TJvTFDaysPrimeTime; FRowHdrType: TJvTFRowHdrType; FRowHdrWidth: Integer; FRowHeight: Integer; FShowPics: Boolean; FShowText: Boolean; FFormattedDesc: Boolean; FThresholds: TJvTFDaysThresholds; FOnDrawCorner: TJvTFDrawCornerEvent; //FOnUpdateColTitle: TJvTFUpdateTitleEvent; FOnUpdateColTitles: TJvTFUpdateTitlesEvent; FOnDrawColHdr: TJvTFDrawHdrEvent; FOnDrawGroupHdr: TJvTFDrawHdrEvent; FOnDrawRowHdr: TJvTFDrawHdrEvent; FOnDrawMinorRowHdr: TJvTFDrawHdrEvent; FOnDrawMajorRowHdr: TJvTFDrawHdrEvent; FOnDrawDataCell: TJvTFDrawDataCellEvent; FOnDrawAppt: TJvTFDrawApptEvent; FOnDrawApptBar: TJvTFDrawApptBarEvent; FOnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent; FOnShadeCell: TJvTFShadeCellEvent; FOnApptProgress: TJvTFProgressEvent; FGridStartTime: TTime; FGridEndTime: TTime; procedure SetApptAttr(Value: TJvTFDaysApptAttr); procedure SetApptBar(Value: TJvTFDaysApptBar); procedure SetApptBuffer(Value: Integer); procedure SetColHdrHeight(Value: Integer); procedure SetColor(Value: TColor); procedure SetCols(Value: TJvTFDaysCols); procedure SetTFColTitleStyle(Value: TJvTFColTitleStyle); procedure SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr); procedure SetGranularity(Value: Integer); procedure SetGridLineColor(Value: TColor); procedure SetGroupHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetGroupHdrHeight(Value: Integer); procedure SetGrouping(Value: TJvTFDaysGrouping); procedure SetHdrAttr(Value: TJvTFDaysHdrAttr); procedure SetMinColWidth(Value: Integer); procedure SetMinRowHeight(Value: Integer); procedure SetPrimeTime(Value: TJvTFDaysPrimeTime); procedure SetTFRowHdrType(Value: TJvTFRowHdrType); procedure SetRowHdrWidth(Value: Integer); procedure SetRowHeight(Value: Integer); procedure SetShowPics(Value: Boolean); procedure SetShowText(Value: Boolean); procedure SetThresholds(Value: TJvTFDaysThresholds); procedure SetFormattedDesc(Value: Boolean); function GetApptCount: Integer; procedure SetGridStartTime(Value: TTime); procedure SetGridEndTime(Value: TTime); protected FPageInfoList: TStringList; FApptsDrawn: Integer; FValidPageInfo: Boolean; procedure SetMeasure(Value: TJvTFPrinterMeasure); override; procedure DrawBody(ACanvas: TCanvas; ARect: TRect; PageNum: Integer); override; procedure Loaded; override; // Drawing routines procedure DrawCorner(ACanvas: TCanvas); procedure DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean); procedure DrawEmptyColHdr(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo); //procedure DrawColHdr(ACanvas: TCanvas; Index: Integer; //PageInfo: TJvTFDaysPageInfo); procedure DrawColGroupHdr(ACanvas: TCanvas; Index: Integer; PageInfo: TJvTFDaysPageInfo; IsGroupHdr: Boolean); procedure DrawRowHdr(ACanvas: TCanvas; Index: Integer; PageInfo: TJvTFDaysPageInfo); procedure DrawGroupHdrs(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo); procedure DrawFancyRowHdrs(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo); procedure DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer; const LabelStr: string; TickLength: Integer); function GetMinorLabel(RowNum: Integer; PageInfo: TJvTFDaysPageInfo): string; function GetMinorTickLength(ACanvas: TCanvas): Integer; virtual; function GetMajorTickLength: Integer; virtual; procedure DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer; PageInfo: TJvTFDaysPageInfo); procedure DrawAppts(ACanvas: TCanvas; DrawAll: Boolean; PageInfo: TJvTFDaysPageInfo); procedure PrintBitmap(ACanvas: TCanvas; SourceRect, DestRect: TRect; aBitmap: TBitmap); procedure DrawAppt(ACanvas: TCanvas; Col: Integer; Appt: TJvTFAppt; StartRow, EndRow: Integer; PageInfo: TJvTFDaysPageInfo); procedure DrawApptDetail(ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt; Col, StartRow, EndRow: Integer); procedure DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer); function CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer): TRect; procedure DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect); procedure GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo; Appt: TJvTFAppt); procedure CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt; DrawList: TList); procedure FilterPicDrawList(ARect: TRect; DrawList: TList; out PicsHeight, PicsWidth: Integer); procedure CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect; PicsHeight, PicsWidth: Integer; out CanDrawText, CanDrawPics: Boolean); procedure DrawListPics(ACanvas: TCanvas; var ARect: TRect; DrawList: TList); procedure ClearPicDrawList(DrawList: TList); function GetDataWidth(ShowRowHdr: Boolean): Integer; function GetDataHeight(ShowColHdr: Boolean): Integer; procedure EnsureRow(RowNum: Integer); procedure CreateLayout; override; procedure ClearPageInfo; procedure CalcPageInfo; dynamic; procedure CalcPageRowInfo(ShowColHdrs: Boolean; out CalcRowsPerPage, CalcRowHeight: Integer); procedure CalcPageColInfo(ShowRowHdrs: Boolean; out CalcColsPerPage, CalcColWidth: Integer); function GetPageLayout: TJvTFDaysPrinterPageLayout; procedure SetPageLayout(Value: TJvTFDaysPrinterPageLayout); procedure CreateDoc; override; function GetPageInfo(PageNum: Integer): TJvTFDaysPageInfo; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetProperties(aJvTFDays: TJvTFDays); dynamic; function RowCount: Integer; function TimeToRow(ATime: TTime): Integer; function RowToTime(RowNum: Integer): TTime; function RowToHour(RowNum: Integer): Word; function RowStartsHour(RowNum: Integer): Boolean; function RowEndsHour(RowNum: Integer): Boolean; function HourStartRow(Hour: Word): Integer; function HourEndRow(Hour: Word): Integer; function RowEndTime(RowNum: Integer): TTime; function AdjustEndTime(ATime: TTime): TTime; function DaysPageLayout: TJvTFDaysPrinterPageLayout; function CellRect(Col, Row: Integer; PageInfo: TJvTFDaysPageInfo): TRect; function GetApptRect(Col: Integer; Appt: TJvTFAppt; PageInfo: TJvTFDaysPageInfo): TRect; function GetApptDispColor(Appt: TJvTFAppt): TColor; procedure CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate; out StartRow, EndRow: Integer); procedure Prepare; dynamic; property ApptCount: Integer read GetApptCount; property PageInfo[PageNum: Integer]: TJvTFDaysPageInfo read GetPageInfo; procedure FreeDoc; override; procedure PrintDirect; virtual; function CalcGroupHdrHeight: Integer; function CalcGroupColHdrsHeight: Integer; function VirtualGroupHdrRect(Col: Integer; APageInfo: TJvTFDaysPageInfo): TRect; procedure GetGroupStartEndCols(Col: Integer; var StartCol, EndCol: Integer); published property PageLayout: TJvTFDaysPrinterPageLayout read GetPageLayout write SetPageLayout; property ApptAttr: TJvTFDaysApptAttr read FApptAttr write SetApptAttr; property ApptBar: TJvTFDaysApptBar read FApptBar write SetApptBar; property ApptBuffer: Integer read FApptBuffer write SetApptBuffer; property ColHdrHeight: Integer read FColHdrHeight write SetColHdrHeight; property Color: TColor read FColor write SetColor; property Cols: TJvTFDaysCols read FCols write SetCols; property ColTitleStyle: TJvTFColTitleStyle read FColTitleStyle write SetTFColTitleStyle; property DateFormat; // inherited property FancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr read FFancyRowHdrAttr write SetFancyRowHdrAttr; property FormattedDesc: Boolean read FFormattedDesc write SetFormattedDesc; property Granularity: Integer read FGranularity write SetGranularity; property GridLineColor: TColor read FGridLineColor write SetGridLineColor; property GroupHdrAttr: TJvTFDaysHdrAttr read FGroupHdrAttr write SetGroupHdrAttr; property GroupHdrHeight: Integer read FGroupHdrHeight write SetGroupHdrHeight default 25; property Grouping: TJvTFDaysGrouping read FGrouping write SetGrouping; property HdrAttr: TJvTFDaysHdrAttr read FHdrAttr write SetHdrAttr; property MinColWidth: Integer read FMinColWidth write SetMinColWidth; property MinRowHeight: Integer read FMinRowHeight write SetMinRowHeight; property PrimeTime: TJvTFDaysPrimeTime read FPrimeTime write SetPrimeTime; property RowHdrType: TJvTFRowHdrType read FRowHdrType write SetTFRowHdrType; property RowHdrWidth: Integer read FRowHdrWidth write SetRowHdrWidth default 0; property RowHeight: Integer read FRowHeight write SetRowHeight default 0; property ShowPics: Boolean read FShowPics write SetShowPics; property ShowText: Boolean read FShowText write SetShowText; property Thresholds: TJvTFDaysThresholds read FThresholds write SetThresholds; property TimeFormat; // inherited; property OnDrawCorner: TJvTFDrawCornerEvent read FOnDrawCorner write FOnDrawCorner; property OnDrawGroupHdr: TJvTFDrawHdrEvent read FOnDrawGroupHdr write FOnDrawGroupHdr; property OnDrawMinorRowHdr: TJvTFDrawHdrEvent read FOnDrawMinorRowHdr write FOnDrawMinorRowHdr; property OnDrawMajorRowHdr: TJvTFDrawHdrEvent read FOnDrawMajorRowHdr write FOnDrawMajorRowHdr; //property OnUpdateColTitle: TJvTFUpdateTitleEvent read FOnUpdateColTitle //write FOnUpdateColTitle; property OnUpdateColTitles: TJvTFUpdateTitlesEvent read FOnUpdateColTitles write FOnUpdateColTitles; property OnDrawColHdr: TJvTFDrawHdrEvent read FOnDrawColHdr write FOnDrawColHdr; property OnDrawRowHdr: TJvTFDrawHdrEvent read FOnDrawRowHdr write FOnDrawRowHdr; property OnDrawDataCell: TJvTFDrawDataCellEvent read FOnDrawDataCell write FOnDrawDataCell; property OnDrawAppt: TJvTFDrawApptEvent read FOnDrawAppt write FOnDrawAppt; property OnDrawApptBar: TJvTFDrawApptBarEvent read FOnDrawApptBar write FOnDrawApptBar; property OnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent read FOnGetApptDrawInfo write FOnGetApptDrawInfo; property OnShadeCell: TJvTFShadeCellEvent read FOnShadeCell write FOnShadeCell; property OnApptProgress: TJvTFProgressEvent read FOnApptProgress write FOnApptProgress; property GridStartTime: TTime read FGridStartTime write SetGridStartTime; property GridEndTime: TTime read FGridEndTime write SetGridEndTime; end; implementation uses FPCanvas, JvResources; //Type // DEF TIMEBLOCK (not conditionally compiled, just marked for reference) // removed as part of TimeBlock integration //TVertAlignment = (vaTop, vaCenter, vaBottom); // Utility routines // Most, if not all, of these will be moved out of this unit and into // a utilities unit. function StripCRLF(const S: string): string; var I: Integer; begin Result := ''; for I := 1 to Length(S) do if (S[I] <> #13) and (S[I] <> #10) then Result := Result + S[I]; end; function EmptyRect: TRect; begin Result := Classes.Rect(0, 0, 0, 0); end; function RectWidth(ARect: TRect): Integer; begin Result := ARect.Right - ARect.Left; end; function RectHeight(ARect: TRect): Integer; begin Result := ARect.Bottom - ARect.Top; end; // DEF TIMEBLOCK (not conditionally compiled, just marked for reference) // the type of VAlign was orginally TVertAlignment procedure DrawTxt(ACanvas: TCanvas; ARect: TRect; const Txt: string; HAlign: TAlignment; VAlign: TJvTFVAlignment); var TxtWidth, TxtHeight, TxtLeft, TxtTop: Integer; begin TxtLeft := 0; TxtTop := 0; TxtWidth := ACanvas.TextWidth(Txt); TxtHeight := ACanvas.TextHeight('Wq'); case HAlign of taLeftJustify: TxtLeft := ARect.Left; taCenter: TxtLeft := ARect.Left + RectWidth(ARect) div 2 - TxtWidth div 2; taRightJustify: TxtLeft := ARect.Right - TxtWidth; end; case VAlign of vaTop: TxtTop := ARect.Top; vaCenter: TxtTop := ARect.Top + RectHeight(ARect) div 2 - TxtHeight div 2; vaBottom: TxtTop := ARect.Bottom - TxtHeight; end; ACanvas.TextRect(ARect, TxtLeft, TxtTop, Txt); end; function Greater(I1, I2: Integer): Integer; begin if I1 > I2 then Result := I1 else Result := I2; end; function Lesser(I1, I2: Integer): Integer; begin if I1 < I2 then Result := I1 else Result := I2; end; //=== { TJvTFDaysTemplate } ================================================== constructor TJvTFDaysTemplate.Create(AApptGrid: TJvTFDays); begin inherited Create; FGrid := AApptGrid; FCompNames := TJvTFCompNamesList.Create; FCompNames.OnChange := @CompNamesChanged; FCompNames.OnMove := @CompNamesMoved; FLinearStartDate := Date; FLinearEndDate := Date; FLinearDayCount := 1; FCompDate := Date; FActiveTemplate := agtNone; FShortTitles := True; end; destructor TJvTFDaysTemplate.Destroy; begin FCompNames.OnChange := nil; FCompNames.OnMove := nil; FCompNames.Free; inherited Destroy; end; procedure TJvTFDaysTemplate.SetActiveTemplate(Value: TJvTFDaysTemplates); begin if Value <> FActiveTemplate then begin FActiveTemplate := Value; UpdateGrid; end; end; procedure TJvTFDaysTemplate.SetCompDate(Value: TDate); var I: Integer; begin if Trunc(Value) <> Trunc(FCompDate) then begin DoDateChangingEvent(Value); FCompDate := Value; if (ActiveTemplate = agtComparative) and Assigned(FGrid) then try BeginGridUpdate; for I := 0 to FGrid.Cols.Count - 1 do FGrid.Cols[I].SchedDate := CompDate; finally EndGridUpdate; end; DoDateChangedEvent; end; end; function TJvTFDaysTemplate.GetCompNames: TStrings; begin Result := FCompNames; end; procedure TJvTFDaysTemplate.SetCompNames(Value: TStrings); begin FCompNames.Assign(Value); CompNamesChanged(Self); end; procedure TJvTFDaysTemplate.SetLinearDayCount(Value: Integer); begin if Value < 1 then Value := 1; if (Value <> FLinearDayCount) then begin FLinearDayCount := Value; if not (csLoading in FGrid.ComponentState) then begin FLinearEndDate := FLinearStartDate + Value - 1; LinearDaysChanged; end; end; end; procedure TJvTFDaysTemplate.SetLinearEndDate(Value: TDate); begin if Trunc(Value) < Trunc(FLinearStartDate) then Value := FLinearStartDate; if (Trunc(Value) <> Trunc(FLinearEndDate)) then begin FLinearEndDate := Value; if not (csLoading in FGrid.ComponentState) then begin FLinearDayCount := Trunc(FLinearEndDate - FLinearStartDate + 1); LinearDaysChanged; end; end; end; procedure TJvTFDaysTemplate.SetLinearName(const Value: string); var I: Integer; begin if Value <> FLinearName then begin FLinearName := Value; if (ActiveTemplate = agtLinear) and Assigned(FGrid) then begin try BeginGridUpdate; for I := 0 to FGrid.Cols.Count - 1 do FGrid.Cols[I].SchedName := Value; finally EndGridUpdate; end; end; end; end; procedure TJvTFDaysTemplate.SetLinearStartDate(Value: TDate); var I: Integer; begin if Trunc(Value) <> Trunc(FLinearStartDate) then begin DoDateChangingEvent(Value); FLinearStartDate := Value; FLinearEndDate := Value + FLinearDayCount - 1; if (ActiveTemplate = agtLinear) and Assigned(FGrid) then begin BeginGridUpdate; try for I := 0 to FGrid.Cols.Count - 1 do FGrid.Cols[I].SchedDate := Value + I; finally EndGridUpdate; end; end; DoDateChangedEvent; end; end; procedure TJvTFDaysTemplate.SetShortTitles(Value: Boolean); begin if Value <> FShortTitles then begin FShortTitles := Value; if Assigned(FGrid) and (ActiveTemplate <> agtNone) then FGrid.Cols.UpdateTitles; end; end; procedure TJvTFDaysTemplate.DoDateChangedEvent; begin if Assigned(FGrid) and Assigned(FGrid.FOnDateChanged) then FGrid.FOnDateChanged(FGrid); end; procedure TJvTFDaysTemplate.DoDateChangingEvent(var NewDate: TDate); begin if Assigned(FGrid) and Assigned(FGrid.FOnDateChanging) then FGrid.FOnDateChanging(FGrid, NewDate); end; procedure TJvTFDaysTemplate.CompNamesChanged(Sender: TObject); var TempNames: TStringList; I: Integer; Col: TJvTFDaysCol; begin if FUpdatingCompNames then begin FCompNamesChanged := True; Exit; end; FCompNamesChanged := False; if (ActiveTemplate = agtComparative) and Assigned(FGrid) then begin TempNames := TStringList.Create; try BeginGridUpdate; // remove any unneeded cols I := 0; while I < FGrid.Cols.Count do if CompNames.IndexOf(FGrid.Cols[I].SchedName) = -1 then FGrid.Cols[I].Free else begin TempNames.Add(FGrid.Cols[I].SchedName); Inc(I); end; // add all new cols for I := 0 to CompNames.Count - 1 do if TempNames.IndexOf(CompNames[I]) = -1 then begin Col := FGrid.Cols.Add; Col.SchedName := CompNames[I]; Col.SchedDate := CompDate; end; finally TempNames.Free; EndGridUpdate; end; end; end; procedure TJvTFDaysTemplate.LinearDaysChanged; var I, DeltaDays: Integer; Col: TJvTFDaysCol; begin if (ActiveTemplate = agtLinear) and Assigned(FGrid) then begin try BeginGridUpdate; DeltaDays := LinearDayCount - FGrid.Cols.Count; // ONLY ONE OF THE FOLLOWING LOOPS WILL BE EXECUTED !! // Add some days for I := 1 to DeltaDays do begin Col := FGrid.Cols.Add; Col.SchedName := LinearName; Col.SchedDate := LinearStartDate + FGrid.Cols.Count - 1; end; // Remove some days for I := -1 downto DeltaDays do if FGrid.Cols.Count > 0 then FGrid.Cols[FGrid.Cols.Count - 1].Free; finally EndGridUpdate; end; end; end; procedure TJvTFDaysTemplate.Assign(Source: TPersistent); begin if Source is TJvTFDaysTemplate then begin FLinearName := TJvTFDaysTemplate(Source).LinearName; FLinearStartDate := TJvTFDaysTemplate(Source).LinearStartDate; FLinearEndDate := TJvTFDaysTemplate(Source).LinearEndDate; FLinearDayCount := TJvTFDaysTemplate(Source).LinearDayCount; FCompNames.OnChange := nil; FCompNames.Assign(TJvTFDaysTemplate(Source).CompNames); FCompNames.OnChange := @CompNamesChanged; FCompDate := TJvTFDaysTemplate(Source).CompDate; FActiveTemplate := TJvTFDaysTemplate(Source).ActiveTemplate; FShortTitles := TJvTFDaysTemplate(Source).ShortTitles; FIgnoreNav := TJvTFDaysTemplate(Source).IgnoreNav; UpdateGrid; end else inherited Assign(Source); end; procedure TJvTFDaysTemplate.BeginCompNamesUpdate; begin FUpdatingCompNames := True; end; procedure TJvTFDaysTemplate.EndCompNamesUpdate; begin FUpdatingCompNames := False; if FCompNamesChanged then CompNamesChanged(Self); end; procedure TJvTFDaysTemplate.UpdateGrid; var I: Integer; Col: TJvTFDaysCol; begin if not Assigned(FGrid) then Exit; if ActiveTemplate = agtLinear then begin try BeginGridUpdate; FGrid.Cols.Clear; for I := 0 to LinearDayCount - 1 do begin Col := FGrid.Cols.Add; Col.SchedName := LinearName; Col.SchedDate := LinearStartDate + I; end; finally EndGridUpdate; end end else if ActiveTemplate = agtComparative then begin try BeginGridUpdate; FGrid.Cols.Clear; for I := 0 to CompNames.Count - 1 do begin Col := FGrid.Cols.Add; Col.SchedName := CompNames[I]; Col.SchedDate := CompDate; end; finally EndGridUpdate; end; end; FGrid.Cols.UpdateTitles; end; procedure TJvTFDaysTemplate.CompNamesMoved(Sender: TObject; CurIndex, NewIndex: Integer); begin if Assigned(ApptGrid) and (ActiveTemplate = agtComparative) and not ApptGrid.Cols.Updating then ApptGrid.Cols.MoveCol(CurIndex, NewIndex); end; procedure TJvTFDaysTemplate.BeginGridUpdate; begin FUpdatingGrid := True; end; procedure TJvTFDaysTemplate.EndGridUpdate; begin FUpdatingGrid := False; ApptGrid.ProcessBatches; end; //=== { TJvTFDaysPrimeTime } ================================================= constructor TJvTFDaysPrimeTime.Create(AApptGrid: TJvTFDays); begin inherited Create; FApptGrid := AApptGrid; FStartTime := EncodeTime(8, 0, 0, 0); FEndTime := EncodeTime(17, 0, 0, 0); FColor := DEFAULT_PRIMETIME_COLOR; FFillPic := TBitmap.Create; FFillPic.Width := 16; FFillPic.Height := 16; UpdateFillPic; end; destructor TJvTFDaysPrimeTime.Destroy; begin FFillPic.Free; inherited Destroy; end; procedure TJvTFDaysPrimeTime.SetStartTime(Value: TTime); begin if Assigned(FApptGrid) and not (csLoading in FApptGrid.ComponentState) and (Value >= EndTime) then raise EJvTFDaysError.CreateRes(@RsEInvalidPrimeTimeStartTime); FStartTime := Value; Change; end; procedure TJvTFDaysPrimeTime.SetEndTime(Value: TTime); begin if Assigned(FApptGrid) and (Value <= StartTime) and not (csLoading in FApptGrid.ComponentState) then raise EJvTFDaysError.CreateRes(@RsEInvalidPrimeTimeEndTime); FEndTime := Value; Change; end; procedure TJvTFDaysPrimeTime.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; UpdateFillPic; Change; end; end; procedure TJvTFDaysPrimeTime.Change; begin if Assigned(FApptGrid) and not (csLoading in FApptGrid.ComponentState) then FApptGrid.Invalidate; end; procedure TJvTFDaysPrimeTime.UpdateFillPic; begin with FFillPic.Canvas do begin Brush.Color := FColor; FillRect(Classes.Rect(0, 0, FFillPic.Width, FFillPic.Height)); end; end; procedure TJvTFDaysPrimeTime.Assign(Source: TPersistent); begin if Source is TJvTFDaysPrimeTime then begin FStartTime := TJvTFDaysPrimeTime(Source).StartTime; FEndTime := TJvTFDaysPrimeTime(Source).EndTime; FColor := TJvTFDaysPrimeTime(Source).Color; UpdateFillPic; Change; end else inherited Assign(Source); end; //=== { TJvTFInPlaceApptEditor } ============================================= constructor TJvTFInPlaceApptEditor.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csNoDesignVisible]; BorderStyle := bsNone; FQuickCreate := False; //ParentCtl3D := False; //Ctl3D := False; end; procedure TJvTFInPlaceApptEditor.DoExit; begin inherited DoExit; try if not FCancelEdit then TJvTFDays(Parent).FinishEditAppt else if FQuickCreate then // Free the appointment FLinkedAppt.Free; finally FCancelEdit := False; Parent.SetFocus; end; end; procedure TJvTFInPlaceApptEditor.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if Key = VK_ESCAPE then begin FCancelEdit := True; Key := 0; Visible := False; end; end; //=== { TJvTFApptMap } ======================================================= constructor TJvTFApptMap.Create(AGridCol: TJvTFDaysCol); begin inherited Create; FGridCol := AGridCol; FData := TJvTFSparseMatrix.Create; end; destructor TJvTFApptMap.Destroy; begin FData.Free; inherited Destroy; end; function TJvTFApptMap.GetLocation(Row, Col: Integer): TJvTFAppt; begin Result := nil; if (Row >= 0) and (Col > 0) then Result := TJvTFAppt(FData[Row, Col]); end; procedure TJvTFApptMap.Add(Appt: TJvTFAppt); var StartRow: Integer = -1; // to silence the compiler EndRow: Integer = -1; // dto. MapRow, MapCol: Integer; Empty: Boolean; ApptGrid: TJvTFDays; begin // We need to find the left-most col that does not have any appts already // scheduled in any of the rows needed by the new appt. (In other words, // we need a contiguous set cols for the new appt.) FGridCol.CalcStartEndRows(Appt, StartRow, EndRow); StartRow := Greater(StartRow, 0); ApptGrid := FGridCol.ColCollection.ApptGrid; if Assigned(ApptGrid) then EndRow := Lesser(EndRow, ApptGrid.RowCount - 1) else EndRow := Lesser(EndRow, FGridCol.ColCollection.Printer.RowCount - 1); MapRow := StartRow; MapCol := 1; repeat Empty := FData[MapRow, MapCol] = 0; if Empty then Inc(MapRow) else begin Inc(MapCol); MapRow := StartRow; end; until (MapRow > EndRow) and Empty; // Now write the new appt to the map in all rows hit by appt, using the // col found above. for MapRow := StartRow to EndRow do begin FData[MapRow, MapCol] := NativeInt(Appt); FData[MapRow, -1] := FData[MapRow, -1] + 1; end; end; procedure TJvTFApptMap.ProcessMapGroup(GroupStart, GroupEnd: Integer); var MapRow, Examined, ApptCount, MaxCol, MapCol: Integer; begin // Find the highest used column in group MaxCol := 0; for MapRow := GroupStart to GroupEnd do begin Examined := 0; ApptCount := FData[MapRow, -1]; // ApptCount > 0 check added by Mike 1/14/01 if ApptCount > 0 then begin MapCol := 1; repeat if FData[MapRow, MapCol] <> 0 then Inc(Examined); Inc(MapCol); until Examined = ApptCount; Dec(MapCol); MaxCol := Greater(MaxCol, MapCol); end; end; // Now write MaxCol in col 0 for each row in the groups for MapRow := GroupStart to GroupEnd do FData[MapRow, 0] := MaxCol; end; procedure TJvTFApptMap.UpdateMapGroups; var GridRowCount: Integer; begin if Assigned(FGridCol.ColCollection.ApptGrid) then GridRowCount := FGridCol.ColCollection.ApptGrid.RowCount else if Assigned(FGridCol.ColCollection.Printer) then GridRowCount := FGridCol.ColCollection.Printer.RowCount else GridRowCount := 0; // we could try to find a smaller group, by looking for the first and last // row where there is at least one appt, but CPU wise, it's actually simpler // to let the ProcessMapGroup function deal with it. ProcessMapGroup(0, GridRowCount); end; procedure TJvTFApptMap.Clear; begin FData.Clear; end; function TJvTFApptMap.ColCount(Row: Integer): Integer; begin Result := FData[Row, 0]; end; procedure TJvTFApptMap.GetAppts(StartRow, EndRow: Integer; ApptList: TStringList); var Row, Col, Existing, Found, MapCols: Integer; Appt: TJvTFAppt; begin ApptList.Clear; for Row := StartRow to EndRow do begin Existing := FData[Row, -1]; MapCols := FData[Row, 0]; Found := 0; Col := 1; while (Found < Existing) and (Col <= MapCols) do begin if FData[Row, Col] <> 0 then begin Inc(Found); Appt := TJvTFAppt(FData[Row, Col]); if ApptList.IndexOf(Appt.ID) = -1 then ApptList.AddObject(Appt.ID, Appt); end; Inc(Col); end; end; end; function TJvTFApptMap.LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer; var Col, MapCols, ApptVal: Integer; begin MapCols := FData[MapSearchRow, 0]; Col := 1; ApptVal := PtrInt(Appt); while (Col <= MapCols) and (FData[MapSearchRow, Col] <> ApptVal) do Inc(Col); if FData[MapSearchRow, Col] = ApptVal then Result := Col else Result := -2; end; procedure TJvTFApptMap.Refresh; var Sched: TJvTFSched; I: Integer; begin Clear; Sched := FGridCol.Schedule; if Assigned(Sched) then begin for I := 0 to Sched.ApptCount - 1 do Add(Sched.Appts[I]); UpdateMapGroups; end; end; procedure TJvTFApptMap.Dump(AName: TFileName); var DumpData: TStringList; begin // used for debugging only DumpData := TStringList.Create; try FData.Dump(DumpData); DumpData.SaveToFile(AName); finally DumpData.Free; end; end; function TJvTFApptMap.HasAppt(Appt: TJvTFAppt): Boolean; var StartRow: Integer = -1; // to silence the compiler EndRow: Integer = -1; // dto. MapRow, MapCol, ApptsExamined: Integer; Test: NativeInt; ApptGrid: TJvTFDays; begin FGridCol.CalcStartEndRows(Appt, StartRow, EndRow); StartRow := Greater(StartRow, 0); ApptGrid := FGridCol.ColCollection.ApptGrid; if Assigned(ApptGrid) then EndRow := Lesser(EndRow, ApptGrid.RowCount - 1) else EndRow := Lesser(EndRow, FGridCol.ColCollection.Printer.RowCount - 1); MapRow := 0; Result := False; while (MapRow <= EndRow) and not Result do begin MapCol := 1; ApptsExamined := 0; while (ApptsExamined < FData[MapRow, -1]) and not Result do begin Test := FData[MapRow, MapCol]; if Test <> 0 then begin Inc(ApptsExamined); if Test = NativeInt(Appt) then Result := True; end; Inc(MapCol); end; Inc(MapRow); end; end; //=== { TJvTFDaysThresholds } ================================================ constructor TJvTFDaysThresholds.Create(AOwner: TJvTFDays); begin inherited Create; FApptGrid := AOwner; FTextHeight := 1; FTextWidth := 10; FEditHeight := 1; FEditWidth := 10; FDetailWidth := 10; FDetailHeight := 10; FDropTextFirst := True; FPicsAllOrNone := False; FWholePicsOnly := True; end; procedure TJvTFDaysThresholds.SetDetailHeight(Value: Integer); begin if Value < 1 then Value := 1; if Value <> FDetailHeight then begin FDetailHeight := Value; Change; end; end; procedure TJvTFDaysThresholds.SetDetailWidth(Value: Integer); begin if Value < 1 then Value := 1; if Value <> FDetailWidth then begin FDetailWidth := Value; Change; end; end; procedure TJvTFDaysThresholds.SetEditHeight(Value: Integer); begin if Value < 0 then Value := 0; if Value <> FEditHeight then FEditHeight := Value; end; procedure TJvTFDaysThresholds.SetEditWidth(Value: Integer); begin if Value < 0 then Value := 0; if Value <> FEditWidth then FEditWidth := Value; end; procedure TJvTFDaysThresholds.SetTextHeight(Value: Integer); begin if Value < 0 then Value := 0; if Value <> FTextHeight then begin FTextHeight := Value; Change; end; end; procedure TJvTFDaysThresholds.SetTextWidth(Value: Integer); begin if Value < 0 then Value := 0; if Value <> FTextWidth then begin FTextWidth := Value; Change; end; end; procedure TJvTFDaysThresholds.SetDropTextFirst(Value: Boolean); begin if Value <> FDropTextFirst then begin FDropTextFirst := Value; Change; end; end; procedure TJvTFDaysThresholds.SetPicsAllOrNone(Value: Boolean); begin if Value <> FPicsAllOrNone then begin FPicsAllOrNone := Value; Change; end; end; procedure TJvTFDaysThresholds.SetWholePicsOnly(Value: Boolean); begin if Value <> FWholePicsOnly then begin FWholePicsOnly := Value; Change; end; end; procedure TJvTFDaysThresholds.Change; begin if Assigned(FApptGrid) then FApptGrid.Invalidate; end; procedure TJvTFDaysThresholds.Assign(Source: TPersistent); begin if Source is TJvTFDaysThresholds then begin FTextWidth := TJvTFDaysThresholds(Source).TextWidth; FTextHeight := TJvTFDaysThresholds(Source).TextHeight; FEditHeight := TJvTFDaysThresholds(Source).EditHeight; FEditWidth := TJvTFDaysThresholds(Source).EditWidth; FDropTextFirst := TJvTFDaysThresholds(Source).DropTextFirst; FPicsAllOrNone := TJvTFDaysThresholds(Source).PicsAllOrNone; FWholePicsOnly := TJvTFDaysThresholds(Source).WholePicsOnly; Change; end else inherited Assign(Source); end; //=== { TJvTFDaysScrollBar } ================================================= constructor TJvTFDaysScrollBar.Create(AOwner: TComponent); begin inherited Create(AOwner); // if we set the csNoDesignVisible flag then visibility at design time // is controled by the Visible property, which is exactly what we want. ControlStyle := ControlStyle + [csNoDesignVisible]; //ParentCtl3D := False; //Ctl3D := False; end; procedure TJvTFDaysScrollBar.CMDesignHitTest(var Msg: TCMDesignHitTest); begin Msg.Result := 1; end; procedure TJvTFDaysScrollBar.CreateWnd; begin inherited CreateWnd; UpdateRange; end; function TJvTFDaysScrollBar.GetLargeChange: Integer; begin Result := inherited LargeChange; end; procedure TJvTFDaysScrollBar.SetLargeChange(Value: Integer); begin inherited LargeChange := Value; UpdateRange; end; procedure TJvTFDaysScrollBar.UpdateRange; var Info: TScrollInfo; begin if not HandleAllocated then exit; FillChar(Info{%H-}, SizeOf(Info), 0); with Info do begin cbsize := SizeOf(Info); fmask := SIF_PAGE; nPage := LargeChange; end; SetScrollInfo(Handle, SB_CTL, Info, True); end; //=== { TJvTFDaysCol } ======================================================= constructor TJvTFDaysCol.Create(ACollection: TCollection); begin inherited Create(ACollection); FNullSchedDate := True; FMap := TJvTFApptMap.Create(Self); end; destructor TJvTFDaysCol.Destroy; begin Disconnect; FMap.Free; inherited Destroy; end; procedure TJvTFDaysCol.SetSchedDate(Value: TDate); begin if Value <> FSchedDate then begin Disconnect; FSchedDate := Value; FNullSchedDate := False; Connect; //UpdateTitle; UpdateTitles; CheckTemplate; end; end; procedure TJvTFDaysCol.SetSchedName(const Value: string); begin if Value <> FSchedName then begin Disconnect; FSchedName := Value; Connect; //UpdateTitle; UpdateTitles; CheckTemplate; end; end; procedure TJvTFDaysCol.SetTitle(const Value: string); begin if FTitle <> Value then begin FTitle := Value; if Assigned(ColCollection.ApptGrid) then ColCollection.ApptGrid.Invalidate; end; end; function TJvTFDaysCol.IsStoredWidth: Boolean; begin if Assigned(TJvTFDaysCols(Collection).ApptGrid) then Result := FWidth <> TJvTFDaysCols(Collection).ApptGrid.Scale96ToFont(FWidth) else Result := true; end; procedure TJvTFDaysCol.SetWidth(Value: Integer); var ApptGrid: TJvTFDays; absMinColWidth: Integer; begin if Assigned(ColCollection.ApptGrid) then absMinColWidth := ColCollection.ApptGrid.Scale96ToFont(DEFAULT_MIN_COL_WIDTH) else absMinColWidth := DEFAULT_MIN_COL_WIDTH; if Value < absMinColWidth then Value := absMinColWidth; if Assigned(ColCollection.ApptGrid) then if Value > ColCollection.ApptGrid.GetDataWidth then Value := ColCollection.ApptGrid.GetDataWidth; if Value < 1 then Value := 1; // For the printer, just set the private member then EXIT if Assigned(ColCollection.Printer) then begin FWidth := Value; Exit; end; if Value <> FWidth then begin FWidth := Value; ApptGrid := ColCollection.ApptGrid; if not (csLoading in ApptGrid.ComponentState) then begin if ApptGrid.AutoSizeCols then begin if not ColCollection.AddingCol and not (vsbHorz in ApptGrid.VisibleScrollBars) then ColCollection.ResizeCols; end else ApptGrid.CheckSBVis; ApptGrid.CheckSBParams; ApptGrid.Invalidate; end; end; end; function TJvTFDaysCol.GetDisplayName: string; begin Result := SchedName + ' ['; if not FNullSchedDate then Result := Result + FormatDateTime('ddddd', SchedDate); Result := Result + ']'; { if Title <> '' then Result := Title else Result := Inherited GetDisplayName; } end; procedure TJvTFDaysCol.CheckTemplate; begin if Assigned(ColCollection.ApptGrid) then with ColCollection.ApptGrid.Template do if not UpdatingGrid then ActiveTemplate := agtNone; end; procedure TJvTFDaysCol.SetIndex(Value: Integer); begin if not Assigned(ColCollection.ApptGrid) or (ColCollection.ApptGrid.Template.ActiveTemplate <> agtLinear) then inherited SetIndex(Value); end; procedure TJvTFDaysCol.Assign(Source: TPersistent); begin if Source is TJvTFDaysCol then begin Title := TJvTFDaysCol(Source).Title; Width := TJvTFDaysCol(Source).Width; SchedName := TJvTFDaysCol(Source).SchedName; SchedDate := TJvTFDaysCol(Source).SchedDate; end else inherited Assign(Source); end; procedure TJvTFDaysCol.AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin if IsStoredWidth then FWidth := round(FWidth * AXProportion); end; end; function TJvTFDaysCol.ColCollection: TJvTFDaysCols; begin Result := TJvTFDaysCols(Collection); end; function TJvTFDaysCol.Connected: Boolean; begin Result := Assigned(FSchedule); end; procedure TJvTFDaysCol.Connect; var ApptGrid: TJvTFDays; FPrinter: TJvTFDaysPrinter; begin ApptGrid := ColCollection.ApptGrid; FPrinter := ColCollection.Printer; if Assigned(ApptGrid) then begin if not Connected and not (csDesigning in ApptGrid.ComponentState) and not FNullSchedDate and (SchedName <> '') and Assigned(ApptGrid.ScheduleManager) and not (csLoading in ApptGrid.ComponentState) then begin FSchedule := ApptGrid.RetrieveSchedule(SchedName, SchedDate); FMap.Refresh; ApptGrid.Invalidate; //UpdateTitle; UpdateTitles; end; end else if Assigned(FPrinter) then begin if not Connected and not (csDesigning in FPrinter.ComponentState) and not FNullSchedDate and (SchedName <> '') and Assigned(FPrinter.ScheduleManager) and not (csLoading in FPrinter.ComponentState) then begin FSchedule := FPrinter.RetrieveSchedule(SchedName, SchedDate); FMap.Refresh; //UpdateTitle; UpdateTitles; end; end; end; procedure TJvTFDaysCol.Disconnect; var ApptGrid: TJvTFDays; FPrinter: TJvTFDaysPrinter; lSchedName: string; lSchedDate: TDate; begin if not FDisconnecting then try FDisconnecting := True; ApptGrid := ColCollection.ApptGrid; FPrinter := ColCollection.Printer; if Assigned(ApptGrid) then begin if Connected and Assigned(ApptGrid.ScheduleManager) then begin lSchedName := Schedule.SchedName; lSchedDate := Schedule.SchedDate; FSchedule := nil; FMap.Clear; ApptGrid.ReleaseSchedule(lSchedName, lSchedDate); ApptGrid.Invalidate; end; end else if Assigned(FPrinter) then begin if Connected and Assigned(FPrinter.ScheduleManager) then begin lSchedName := Schedule.SchedName; lSchedDate := Schedule.SchedDate; FSchedule := nil; FMap.Clear; FPrinter.ReleaseSchedule(lSchedName, lSchedDate); end; end; finally FDisconnecting := False; end; end; procedure TJvTFDaysCol.SetSchedule(const NewSchedName: string; NewSchedDate: TDate); begin Disconnect; FSchedName := SchedName; FSchedDate := SchedDate; FNullSchedDate := False; Connect; //UpdateTitle; UpdateTitles; CheckTemplate; end; procedure TJvTFDaysCol.RefreshMap; begin FMap.Refresh; end; procedure TJvTFDaysCol.CalcStartEndRows(Appt: TJvTFAppt; var StartRow, EndRow: Integer); var ApptGrid: TJvTFDays; FPrinter: TJvTFDaysPrinter; begin ApptGrid := ColCollection.ApptGrid; FPrinter := ColCollection.Printer; if Assigned(ApptGrid) then begin if Trunc(Appt.StartDate) = Trunc(SchedDate) then StartRow := ApptGrid.TimeToRow(Appt.StartTime) else StartRow := 0; if Trunc(Appt.EndDate) = Trunc(SchedDate) then EndRow := ApptGrid.TimeToRow(ApptGrid.AdjustEndTime(Appt.EndTime)) else EndRow := ApptGrid.RowCount - 1; end else if Assigned(FPrinter) then begin if Trunc(Appt.StartDate) = Trunc(SchedDate) then StartRow := FPrinter.TimeToRow(Appt.StartTime) else StartRow := 0; if Trunc(Appt.EndDate) = Trunc(SchedDate) then EndRow := FPrinter.TimeToRow(FPrinter.AdjustEndTime(Appt.EndTime)) else EndRow := FPrinter.RowCount - 1; end; end; { procedure TJvTFDaysCol.UpdateTitle; Var NewTitle: string; ApptGrid: TJvTFDays; FPrinter: TJvTFDaysPrinter; begin ApptGrid := ColCollection.ApptGrid; FPrinter := ColCollection.Printer; if Assigned(ApptGrid) then begin if (ApptGrid.Template.ActiveTemplate = agtLinear) and (ApptGrid.Template.ShortTitles) then NewTitle := FormatDateTime(ApptGrid.DateFormat, SchedDate) else if (ApptGrid.Template.ActiveTemplate = agtComparative) and (ApptGrid.Template.ShortTitles) then NewTitle := SchedName else NewTitle := SchedName + ' - ' + FormatDateTime(ApptGrid.DateFormat, SchedDate); if Assigned(ApptGrid.OnUpdateColTitle) then ApptGrid.OnUpdateColTitle(ApptGrid, Self, NewTitle); Title := NewTitle; end else if Assigned(FPrinter) then begin NewTitle := SchedName + ' - ' + FormatDateTime(FPrinter.DateFormat, SchedDate); if Assigned(FPrinter.OnUpdateColTitle) then FPrinter.OnUpdateColTitle(FPrinter, Self, NewTitle); Title := NewTitle; end; end; } function TJvTFDaysCol.GetFirstAppt: TJvTFAppt; var ApptList: TStringList; begin Result := nil; ApptList := TStringList.Create; try FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList); if ApptList.Count > 0 then Result := TJvTFAppt(ApptList.Objects[0]); finally ApptList.Free; end; end; function TJvTFDaysCol.GetLastAppt: TJvTFAppt; var ApptList: TStringList; begin Result := nil; ApptList := TStringList.Create; try FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList); if ApptList.Count > 0 then Result := TJvTFAppt(ApptList.Objects[ApptList.Count - 1]); finally ApptList.Free; end; end; function TJvTFDaysCol.GetNextAppt(RefAppt: TJvTFAppt): TJvTFAppt; var ApptList: TStringList; NextIndex: Integer; begin if not Assigned(RefAppt) then begin Result := GetFirstAppt; Exit; end; Result := nil; ApptList := TStringList.Create; try FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList); if ApptList.Count > 0 then begin NextIndex := ApptList.IndexOfObject(RefAppt) + 1; // if NextIndex = 0 then RefAppt is in a different column, // so return the first appt. if (NextIndex >= 0) and (NextIndex < ApptList.Count) then Result := TJvTFAppt(ApptList.Objects[NextIndex]); end; finally ApptList.Free; end; end; function TJvTFDaysCol.GetPrevAppt(RefAppt: TJvTFAppt): TJvTFAppt; var ApptList: TStringList; PrevIndex: Integer; begin if RefAppt = nil then begin Result := GetLastAppt; Exit; end; Result := nil; ApptList := TStringList.Create; try FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList); if ApptList.Count > 0 then begin PrevIndex := ApptList.IndexOfObject(RefAppt) - 1; if PrevIndex > -1 then Result := TJvTFAppt(ApptList.Objects[PrevIndex]) else if PrevIndex = -2 then // RefAppt is in a different column so return last appt Result := GetLastAppt; end; finally ApptList.Free; end; end; procedure TJvTFDaysCol.SetGroupTitle(const Value: string); begin if Value <> FGroupTitle then begin FGroupTitle := Value; if Assigned(ColCollection.ApptGrid) then ColCollection.ApptGrid.Invalidate; end; end; procedure TJvTFDaysCol.UpdateTitles; var NewTitle, NewGroupTitle, NameStr, DateStr: string; ApptGrid: TJvTFDays; FPrinter: TJvTFDaysPrinter; FromGrid: Boolean; Grouping: TJvTFDaysGrouping; begin ApptGrid := ColCollection.ApptGrid; FPrinter := ColCollection.Printer; if not Assigned(ApptGrid) and not Assigned(FPrinter) then Exit; FromGrid := Assigned(ApptGrid); if FromGrid then Grouping := ApptGrid.Grouping else Grouping := FPrinter.Grouping; if FNullSchedDate then DateStr := '' else if FromGrid then DateStr := FormatDateTime(ApptGrid.DateFormat, SchedDate) else DateStr := FormatDateTime(FPrinter.DateFormat, SchedDate); if Assigned(Schedule) and (Schedule.SchedDisplayName <> '') then NameStr := Schedule.SchedDisplayName else NameStr := SchedName; case Grouping of grNone: begin NewGroupTitle := ''; NewTitle := NameStr + ' - ' + DateStr; end; grDate: begin NewGroupTitle := DateStr; NewTitle := NameStr; end; grResource: begin NewGroupTitle := NameStr; NewTitle := DateStr; end; grCustom: begin NewGroupTitle := GroupTitle; NewTitle := NameStr + ' - ' + DateStr; end; end; if FromGrid then begin if Assigned(ApptGrid.OnUpdateColTitles) then ApptGrid.OnUpdateColTitles(ApptGrid, Self, NewGroupTitle, NewTitle) end else if Assigned(FPrinter.OnUpdateColTitles) then FPrinter.OnUpdateColTitles(FPrinter, Self, NewGroupTitle, NewTitle); GroupTitle := NewGroupTitle; Title := NewTitle; end; procedure TJvTFDaysCol.DumpMap; begin FMap.Dump('Map Dump (' + IntToStr(Index) + ').txt'); end; function TJvTFDaysCol.ApptInCol(Appt: TJvTFAppt): Boolean; begin Result := FMap.HasAppt(Appt); end; function TJvTFDaysCol.LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer; begin Result := FMap.LocateMapCol(Appt, MapSearchRow); end; function TJvTFDaysCol.MapColCount(Row: Integer): Integer; begin Result := FMap.ColCount(Row); end; function TJvTFDaysCol.MapLocation(Col, Row: Integer): TJvTFAppt; begin Result := FMap.Location[Row, Col]; end; //=== { TJvTFDaysCols } ====================================================== constructor TJvTFDaysCols.Create(AApptGrid: TJvTFDays); begin inherited Create(TJvTFDaysCol); FApptGrid := AApptGrid; FOldCount := 0; end; constructor TJvTFDaysCols.CreateForPrinter(APrinter: TJvTFDaysPrinter); begin inherited Create(TJvTFDaysCol); FPrinter := APrinter; end; function TJvTFDaysCols.GetItem(Index: Integer): TJvTFDaysCol; begin Result := TJvTFDaysCol(inherited GetItem(Index)); end; procedure TJvTFDaysCols.SetItem(Index: Integer; Value: TJvTFDaysCol); begin inherited SetItem(Index, Value); end; procedure TJvTFDaysCols.EnsureCol(Index: Integer); begin if (Index < 0) or (Index > Count - 1) then raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds); end; function TJvTFDaysCols.GetOwner: TPersistent; begin if Assigned(FApptGrid) then Result := FApptGrid else if Assigned(FPrinter) then Result := FPrinter else Result := nil; end; procedure TJvTFDaysCols.SizeCols; var DataWidth, Base, MakeUp, I: Integer; begin // DO NOT RUN IF WE'RE ALREADY IN THE SIZING PROCESS!! if SizingCols or (Count <= 0) then Exit; if Assigned(FApptGrid) then try FSizingCols := True; DataWidth := ApptGrid.GetDataWidth; Base := DataWidth div Count; if Base >= ApptGrid.MinColWidth then begin MakeUp := DataWidth - (Base * Count); for I := 0 to MakeUp - 1 do Items[I].Width := Base + 1; for I := MakeUp to Count - 1 do Items[I].Width := Base; end finally FSizingCols := False; end else begin // sizing for printer end; end; procedure TJvTFDaysCols.Update(Item: TCollectionItem); begin {*******************************************************************} {** DO NOT PUT ANY CALLS TO SHOWMESSAGE IN THIS ROUTINE!!!! *******} {** IT WILL BLOW UP WHEN REMOVING COLS AT DESIGN TIME!!!! *******} {*******************************************************************} // Exit if owner is printer if not Assigned(ApptGrid) or (csLoading in ApptGrid.ComponentState) then Exit; try FUpdating := True; ApptGrid.ClearSelection; if Count > FOldCount then // we're adding a col try FAddingCol := True; // if we're adding the first col then set left col to 0. if FOldCount = 0 then ApptGrid.LeftCol := 0; if ApptGrid.AutoSizeCols then begin // default col width to grid's min col width Items[Count - 1].Width := ApptGrid.MinColWidth; if not (vsbHorz in ApptGrid.VisibleScrollBars) then // run the CheckSBVis routine if not ApptGrid.CheckSBVis then // if CheckSBVis didn't resize the cols then recheck // the visibility of the horz scroll bar. if still not // visible, then size the cols. if not (vsbHorz in ApptGrid.VisibleScrollBars) then SizeCols; end else Items[Count - 1].Width := ApptGrid.DefColWidth; finally FAddingCol := False; end else if Count < FOldCount then // we're removing a col begin if ApptGrid.FocusedCol >= Count then ApptGrid.FocusedCol := Count - 1; if ApptGrid.SelStart.X >= Count then ApptGrid.SelStart := Point(Count - 1, ApptGrid.SelStart.Y); if ApptGrid.LeftCol >= Count then ApptGrid.LeftCol := Count - 1; if ApptGrid.AutoSizeCols then begin if vsbHorz in ApptGrid.VisibleScrollBars then begin // run the CheckSBVis routine if not ApptGrid.CheckSBVis then // if CheckSBVis didn't resize the cols then recheck // the visibility of the horz scroll bar. if still not // visible, then size the cols. if not (vsbHorz in ApptGrid.VisibleScrollBars) then SizeCols; end else SizeCols; end else ApptGrid.CheckSBVis; end; finally FUpdating := False; FOldCount := Count; FApptGrid.Invalidate; end; end; function TJvTFDaysCols.Add: TJvTFDaysCol; begin Result := TJvTFDaysCol(inherited Add); end; procedure TJvTFDaysCols.AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); var i: Integer; begin for i := 0 to Count-1 do Items[i].AutoAdjustLayout(AMode, AXProportion, AYProportion); end; procedure TJvTFDaysCols.EnsureMinColWidth; var I, MCW: Integer; begin if Assigned(ApptGrid) then MCW := ApptGrid.MinColWidth else if Assigned(FPrinter) then MCW := FPrinter.MinColWidth else Exit; for I := 0 to Count - 1 do if Items[I].Width < MCW then Items[I].Width := MCW; end; procedure TJvTFDaysCols.EnsureMaxColWidth; var I: Integer; DataW: Integer; begin if not Assigned(ApptGrid) or not (agoEnforceMaxColWidth in ApptGrid.Options) then Exit; DataW := ApptGrid.GetDataWidth; for I := 0 to Count - 1 do if Items[I].Width > DataW then Items[I].Width := DataW; end; procedure TJvTFDaysCols.ResizeCols; begin SizeCols; end; procedure TJvTFDaysCols.MoveCol(SourceIndex, TargetIndex: Integer); var SelID: Integer; begin if SourceIndex <> TargetIndex then begin SelID := -1; EnsureCol(SourceIndex); EnsureCol(TargetIndex); if Assigned(ApptGrid) and (ApptGrid.FocusedCol > -1) then SelID := Items[ApptGrid.FocusedCol].ID; Items[SourceIndex].Index := TargetIndex; if Assigned(ApptGrid) and (ApptGrid.FocusedCol > -1) then ApptGrid.FocusedCol := FindItemID(SelID).Index; // sychronize the CompName list if Assigned(ApptGrid) and (ApptGrid.Template.ActiveTemplate = agtComparative) then begin FUpdating := True; try ApptGrid.Template.CompNames.Move(SourceIndex, TargetIndex); finally FUpdating := False; end; end; end; end; procedure TJvTFDaysCols.Assign(Source: TPersistent); var I: Integer; begin if Source is TJvTFDaysCols then begin BeginUpdate; try Clear; for I := 0 to TJvTFDaysCols(Source).Count - 1 do Add.Assign(TJvTFDaysCols(Source).Items[I]); finally EndUpdate; end; end else inherited Assign(Source); end; procedure TJvTFDaysCols.UpdateTitles; var I: Integer; begin for I := 0 to Count - 1 do Items[I].UpdateTitles; end; //=== { TJvTFDaysFancyRowHdrAttr } =========================================== constructor TJvTFDaysFancyRowHdrAttr.Create(AOwner: TJvTFDays); var h: Integer; begin inherited Create; FGrid := AOwner; FTickColor := clGray; FColor := clBtnFace; FMinorFont := TFont.Create; if Assigned(FGrid) then FMinorFont.Assign(FGrid.Font); FMinorFont.PixelsPerInch := 96; FMajorFont := TFont.Create; if Assigned(FGrid) then FMajorFont.Assign(FGrid.Font); if FMajorFont.Height = 0 then begin h := MulDiv(GetFontData(FMajorFont.Reference.Handle).Height, FMajorFont.PixelsPerInch, Screen.PixelsPerInch); FMajorFont.Height := h*3 div 2; end; FMajorFont.PixelsPerInch := 96; FMinorFont.OnChange := @FontChange; FMajorFont.OnChange := @FontChange; FOnlyShow00Minutes := True; end; destructor TJvTFDaysFancyRowHdrAttr.Destroy; begin FMinorFont.OnChange := nil; FMajorFont.OnChange := nil; FMinorFont.Free; FMajorFont.Free; inherited Destroy; end; procedure TJvTFDaysFancyRowHdrAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; Change; end; end; procedure TJvTFDaysFancyRowHdrAttr.SetHr2400(Value: Boolean); begin if Value <> FHr2400 then begin FHr2400 := Value; Change; end; end; procedure TJvTFDaysFancyRowHdrAttr.SetMinorFont(Value: TFont); begin FMinorFont.Assign(Value); end; procedure TJvTFDaysFancyRowHdrAttr.SetMajorFont(Value: TFont); begin FMajorFont.Assign(Value); end; procedure TJvTFDaysFancyRowHdrAttr.SetTickColor(Value: TColor); begin if Value <> FTickColor then begin FTickColor := Value; Change; end; end; procedure TJvTFDaysFancyRowHdrAttr.SetOnlyShow00Minutes(Value: Boolean); begin if Value <> FOnlyShow00Minutes then begin FOnlyShow00Minutes := Value; Change; end; end; procedure TJvTFDaysFancyRowHdrAttr.Change; begin if Assigned(FGrid) then FGrid.Invalidate; end; procedure TJvTFDaysFancyRowHdrAttr.FontChange(Sender: TObject); begin Change; end; procedure TJvTFDaysFancyRowHdrAttr.Assign(Source: TPersistent); begin if Source is TJvTFDaysFancyRowHdrAttr then begin FTickColor := TJvTFDaysFancyRowHdrAttr(Source).TickColor; FMinorFont.OnChange := nil; FMajorFont.OnChange := nil; FMinorFont.Assign(TJvTFDaysFancyRowHdrAttr(Source).MinorFont); FMajorFont.Assign(TJvTFDaysFancyRowHdrAttr(Source).MajorFont); FMinorFont.OnChange := @FontChange; FMajorFont.OnChange := @FontChange; FHr2400 := TJvTFDaysFancyRowHdrAttr(Source).Hr2400; FColor := TJvTFDaysFancyRowHdrAttr(Source).Color; Change; end else inherited Assign(Source); end; //=== { TJvTFDaysHdrAttr } =================================================== constructor TJvTFDaysHdrAttr.Create(AOwner: TJvTFDays); begin inherited Create; FApptGrid := AOwner; FFont := TFont.Create; if Assigned(FApptGrid) then begin FFont.Assign(FApptGrid.Font); FParentFont := True; end else FParentFont := False; FFont.PixelsPerInch := 96; FFont.OnChange := @FontChange; FColor := clBtnFace; FFrame3D := True; {$IFDEF Jv_TIMEBLOCKS} // ok FFrameColor := clBlack; {$ENDIF Jv_TIMEBLOCKS} end; destructor TJvTFDaysHdrAttr.Destroy; begin FFont.Free; inherited Destroy; end; procedure TJvTFDaysHdrAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; Change; end; end; procedure TJvTFDaysHdrAttr.SetFont(Value: TFont); begin if Value <> FFont then begin FFont.Assign(Value); FFont.OnChange := @FontChange; if Assigned(FApptGrid) then ParentFont := Value = FApptGrid.Font; Change; end; end; procedure TJvTFDaysHdrAttr.SetParentFont(Value: Boolean); begin if Value and Assigned(FApptGrid) then Font.Assign(FApptGrid.Font); FParentFont := Value; end; procedure TJvTFDaysHdrAttr.SetFrame3D(Value: Boolean); begin if Value <> FFrame3D then begin FFrame3D := Value; Change; end; end; {$IFDEF Jv_TIMEBLOCKS} // ok procedure TJvTFDaysHdrAttr.SetFrameColor(Value: TColor); begin if Value <> FFrameColor then begin FFrameColor := Value; Change; end; end; // ok procedure TJvTFDaysHdrAttr.SetTitleRotation(Value: Integer); begin if Value <> FTitleRotation then begin FTitleRotation := Value; Change; end; end; {$ENDIF Jv_TIMEBLOCKS} procedure TJvTFDaysHdrAttr.Change; begin if Assigned(FApptGrid) then FApptGrid.Invalidate; end; procedure TJvTFDaysHdrAttr.FontChange(Sender: TObject); begin ParentFont := False; Change; end; procedure TJvTFDaysHdrAttr.Assign(Source: TPersistent); begin if Source is TJvTFDaysHdrAttr then try FParentFont := False; Frame3D := TJvTFDaysHdrAttr(Source).Frame3D; FColor := TJvTFDaysHdrAttr(Source).Color; Font.Assign(TJvTFDaysHdrAttr(Source).Font); Font.OnChange := @FontChange; ParentFont := TJvTFDaysHdrAttr(Source).ParentFont; {$IFDEF Jv_TIMEBLOCKS} // ok FFrameColor := TJvTFDaysHdrAttr(Source).FrameColor; // ok FTitleRotation := TJvTFDaysHdrAttr(Source).TitleRotation; {$ENDIF Jv_TIMEBLOCKS} finally Change; end else inherited Assign(Source); end; procedure TJvTFDaysHdrAttr.ParentFontChanged; begin if ParentFont and Assigned(FApptGrid) then begin // Disconnect Font.OnChange FFont.OnChange := nil; // Assign the parent font to FFont FFont.Assign(FApptGrid.Font); // Reconnect Font.OnChange FFont.OnChange := @FontChange; end; end; //=== { TJvTFDaysApptBar } =================================================== constructor TJvTFDaysApptBar.Create(AApptGrid: TJvTFDays); begin inherited Create; FApptGrid := AApptGrid; FColor := clBlue; FWidth := DEFAULT_APPT_BAR_WIDTH; // will be scaled by ApptGrid FVisible := True; FTimeStampStyle := tssBlock; FTimeStampColor := clBlue; end; procedure TJvTFDaysApptBar.AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin if IsStoredWidth then FWidth := round(FWidth * AXProportion); end; end; procedure TJvTFDaysApptBar.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Change; end; end; procedure TJvTFDaysApptBar.SetVisible(Value: Boolean); begin if FVisible <> Value then begin FVisible := Value; Change; end; end; procedure TJvTFDaysApptBar.SetWidth(Value: Integer); begin if Value < 0 then Value := 0; if FWidth <> Value then begin FWidth := Value; Change; end; end; procedure TJvTFDaysApptBar.Change; begin if Assigned(FApptGrid) then FApptGrid.Invalidate; end; procedure TJvTFDaysApptBar.Assign(Source: TPersistent); begin if Source is TJvTFDaysApptBar then begin FColor := TJvTFDaysApptBar(Source).Color; FVisible := TJvTFDaysApptBar(Source).Visible; FWidth := TJvTFDaysApptBar(Source).Width; FTimeStampStyle := TJvTFDaysApptBar(Source).TimeStampStyle; FTimeStampColor := TJvTFDaysApptBar(Source).TimeStampColor; Change; end else inherited Assign(Source); end; function TJvTFDaysApptBar.IsStoredWidth: Boolean; begin if Assigned(FApptGrid) then Result := FWidth <> FApptGrid.Scale96ToFont(DEFAULT_APPT_BAR_WIDTH) else Result := true; end; procedure TJvTFDaysApptBar.SetTimeStampColor(Value: TColor); begin if FTimeStampColor <> Value then begin FTimeStampColor := Value; Change; end; end; procedure TJvTFDaysApptBar.SetTFTimeStampStyle(Value: TJvTFTimeStampStyle); begin if FTimeStampStyle <> Value then begin FTimeStampStyle := Value; Change; end; end; //=== { TJvTFDaysApptAttr } ================================================== constructor TJvTFDaysApptAttr.Create(AApptGrid: TJvTFDays); begin inherited Create; FApptGrid := AApptGrid; FFont := TFont.Create; if Assigned(FApptGrid) then begin FFont.Assign(FApptGrid.Font); FParentFont := True; end else FParentFont := False; FFont.PixelsPerInch := 96; FFont.OnChange := @FontChange; FFrameWidth := 1; FFrameColor := clBlack; FColor := clWindow; end; destructor TJvTFDaysApptAttr.Destroy; begin FFont.OnChange := nil; FFont.Free; inherited Destroy; end; procedure TJvTFDaysApptAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; Change; end; end; procedure TJvTFDaysApptAttr.SetFont(Value: TFont); begin if Value <> FFont then begin FFont.Assign(Value); FFont.OnChange := @FontChange; if Assigned(FApptGrid) then ParentFont := Value = FApptGrid.Font; Change; end; end; procedure TJvTFDaysApptAttr.SetParentFont(Value: Boolean); begin if Assigned(FApptGrid) and Value then Font.Assign(FApptGrid.Font); FParentFont := Value; end; procedure TJvTFDaysApptAttr.SetFrameColor(Value: TColor); begin if Value <> FFrameColor then begin FFrameColor := Value; Change; end; end; procedure TJvTFDaysApptAttr.SetFrameWidth(Value: Integer); begin if Value <> FFrameWidth then begin FFrameWidth := Value; Change; end; end; procedure TJvTFDaysApptAttr.Change; begin if Assigned(FApptGrid) then FApptGrid.Invalidate; end; procedure TJvTFDaysApptAttr.FontChange(Sender: TObject); begin ParentFont := False; Change; end; procedure TJvTFDaysApptAttr.Assign(Source: TPersistent); begin if Source is TJvTFDaysApptAttr then try FParentFont := False; FFrameWidth := TJvTFDaysApptAttr(Source).FrameWidth; FFrameColor := TJvTFDaysApptAttr(Source).FrameColor; FColor := TJvTFDaysApptAttr(Source).Color; Font.Assign(TJvTFDaysApptAttr(Source).Font); ParentFont := TJvTFDaysApptAttr(Source).ParentFont; finally Change; end else inherited Assign(Source); end; procedure TJvTFDaysApptAttr.ParentFontChanged; begin if ParentFont and Assigned(FApptGrid) then begin FFont.OnChange := nil; FFont.Assign(FApptGrid.Font); FFont.OnChange := @FontChange; end; end; //=== { TJvTFSelCellAttr } =================================================== constructor TJvTFSelCellAttr.Create(AApptGrid: TJvTFDays); begin inherited Create; FApptGrid := AApptGrid; FColor := clHighlight; FStyle := scsSolid; FFrameWidth := 2; end; procedure TJvTFSelCellAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; Change; end; end; procedure TJvTFSelCellAttr.SetFrameWidth(Value: Integer); begin if Value <> FFrameWidth then begin FFrameWidth := Value; Change; end; end; procedure TJvTFSelCellAttr.SetStyle(Value: TJvTFSelCellStyle); begin if Value <> FStyle then begin FStyle := Value; Change; end; end; procedure TJvTFSelCellAttr.Change; begin if Assigned(FApptGrid) then FApptGrid.Invalidate; end; procedure TJvTFSelCellAttr.Assign(Source: TPersistent); begin if Source is TJvTFSelCellAttr then begin FColor := TJvTFSelCellAttr(Source).Color; FStyle := TJvTFSelCellAttr(Source).Style; FFrameWidth := TJvTFSelCellAttr(Source).FrameWidth; Change; end else inherited Assign(Source); end; //=== { TJvTFDaysGrabHandles } =============================================== constructor TJvTFDaysGrabHandles.Create(AApptGrid: TJvTFDays); begin inherited Create; FApptGrid := AApptGrid; FStyle := gsFlat; FColor := clBlue; FHeight := DEFAULT_GRAB_HANDLES_HEIGHT; // will be scaled by ApptGrid end; procedure TJvTFDaysGrabHandles.AutoAdjustLayout( const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin if IsStoredHeight then FHeight := round(FHeight * AYProportion); end; end; function TJvTFDaysGrabHandles.IsStoredHeight: Boolean; begin if Assigned(FApptGrid) then Result := FHeight <> FApptGrid.Scale96ToFont(DEFAULT_GRAB_HANDLES_HEIGHT) else Result := true; end; procedure TJvTFDaysGrabHandles.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; Change; end; end; procedure TJvTFDaysGrabHandles.SetHeight(Value: Integer); begin if Value < 1 then Value := 1; if Value <> FHeight then begin FHeight := Value; Change; end; end; procedure TJvTFDaysGrabHandles.SetStyle(Value: TJvTFGrabStyle); begin if Value <> FStyle then begin FStyle := Value; if Style = gs3D then FHeight := 6; Change; end; end; procedure TJvTFDaysGrabHandles.Change; begin if Assigned(FApptGrid) then FApptGrid.Invalidate; end; procedure TJvTFDaysGrabHandles.Assign(Source: TPersistent); begin if Source is TJvTFDaysGrabHandles then begin FHeight := TJvTFDaysGrabHandles(Source).Height; FColor := TJvTFDaysGrabHandles(Source).Color; FStyle := TJvTFDaysGrabHandles(Source).Style; Change; end else inherited Assign(Source); end; //=== { TJvTFDays } ========================================================== constructor TJvTFDays.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents, csDoubleClicks]; FSaveFocCol := -1; //set property defaults // FBorderStyle := bsSingle; FColHdrHeight := Scale96ToFont(DEFAULT_COL_HDR_HEIGHT); FGroupHdrHeight := Scale96ToFont(DEFAULT_GROUP_HDR_HEIGHT); FDefColWidth := Scale96ToFont(DEFAULT_DEF_COL_WIDTH); FMinColWidth := Scale96ToFont(DEFAULT_MIN_COL_WIDTH); FMinRowHeight := Scale96ToFont(DEFAULT_MIN_ROW_HEIGHT); FRowHdrWidth := Scale96ToFont(DEFAULT_ROW_HDR_WIDTH); FRowHeight := Scale96ToFont(DEFAULT_ROW_HEIGHT); FGranularity := DEFAULT_GRANULARITY; FTopRow := 0; FFocusedRow := -1; FLeftCol := -1; FFocusedCol := -1; FVisibleScrollBars := []; FAutoSizeCols := True; ParentColor := False; Color := clSilver; FOptions := [agoSizeCols, agoSizeRows, agoSizeColHdr, agoSizeRowHdr, agoSizeAppt, agoMoveAppt, agoEditing, agoShowPics, agoShowText, agoShowApptHints, agoQuickEntry, agoShowSelHint]; FColTitleStyle := ctsSingleEllipsis; FRowHdrType := rhFancy; FSelStart := Point(-1, -1); FSelEnd := FSelStart; FApptBuffer := 5; FFocusedCol := -1; FFocusedRow := -1; FGridLineColor := clGray; FDitheredBackground := false; {$IFDEF Jv_TIMEBLOCKS} // all ok FWeekend := [dowSunday, dowSaturday]; FWeekendColor := clSilver; FWeekendFillPic := TBitmap.Create; FWeekendFillPic.Height := 16; FWeekendFillPic.Width := 16; UpdateWeekendFillPic; {$ENDIF Jv_TIMEBLOCKS} // Create internal objects FVScrollBar := TScrollBar.Create(Self); //TJvTFDaysScrollBar.Create(Self); with FVScrollBar do begin Kind := sbVertical; TabStop := False; Anchors := []; Parent := Self; Visible := False; OnScroll := @ScrollBarScroll; end; FHScrollBar := TScrollBar.Create(Self); //TJvTFDaysScrollBar.Create(Self); with FHScrollBar do begin Kind := sbHorizontal; TabStop := False; Anchors := []; Parent := Self; Visible := False; OnScroll := @ScrollBarScroll; end; FHdrAttr := TJvTFDaysHdrAttr.Create(Self); FHdrAttr.Color := clBtnFace; FSelHdrAttr := TJvTFDaysHdrAttr.Create(Self); with FSelHdrAttr do begin Color := clBtnFace; Font.Color := clWindowText; end; FGroupHdrAttr := TJvTFDaysHdrAttr.Create(Self); FGroupHdrAttr.Color := clBtnFace; FSelGroupHdrAttr := TJvTFDaysHdrAttr.Create(Self); with FSelGroupHdrAttr do begin Color := clBtnFace; Font.Color := clWindowText; end; FFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self); FSelFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self); with FSelFancyRowHdrAttr do begin TickColor := clWindowText; MinorFont.Color := clWindowText; MajorFont.Color := clWindowText; end; FSelCellAttr := TJvTFSelCellAttr.Create(Self); FApptBar := TJvTFDaysApptBar.Create(Self); FApptBar.Width := Scale96ToFont(DEFAULT_APPT_BAR_WIDTH); FCols := TJvTFDaysCols.Create(Self); {$IFDEF Jv_TIMEBLOCKS} // ok FTimeBlocks := TJvTFDaysTimeBlocks.Create(Self); FTimeBlockProps := TJvTFDaysBlockProps.Create(Self); FTimeBlockProps.FBlockHdrWidth := Scale96ToFont(DEFAULT_BLOCK_HDR_WIDTH); {$ENDIF Jv_TIMEBLOCKS} FEditor := TJvTFInPlaceApptEditor.Create(Self); with FEditor do begin Visible := False; Parent := Self; end; FThresholds := TJvTFDaysThresholds.Create(Self); FPrimeTime := TJvTFDaysPrimeTime.Create(Self); FApptAttr := TJvTFDaysApptAttr.Create(Self); FSelApptAttr := TJvTFDaysApptAttr.Create(Self); FTemplate := TJvTFDaysTemplate.Create(Self); FGrabHandles := TJvTFDaysGrabHandles.Create(Self); FGrabHandles.Height := Scale96ToFont(DEFAULT_GRAB_HANDLES_HEIGHT); FHintProps := TJvTFHintProps.Create(Self); //FHint := TJvTFHint.Create(Self); FHint := GetTFHintClass.Create(Self); FHint.RefProps := FHintProps; PaintBuffer := TBitmap.Create; FShowFocus := True; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); end; destructor TJvTFDays.Destroy; begin FVScrollBar.Free; FHScrollBar.Free; FHdrAttr.Free; FSelHdrAttr.Free; FGroupHdrAttr.Free; FSelGroupHdrAttr.Free; FFancyRowHdrAttr.Free; FSelFancyRowHdrAttr.Free; FSelCellAttr.Free; FApptBar.Free; FPrimeTime.Free; {$IFDEF Jv_TIMEBLOCKS} // all ok FTimeBlocks.Free; FTimeBlockProps.Free; FWeekendFillPic.Free; {$ENDIF Jv_TIMEBLOCKS} FEditor.Free; FThresholds.Free; FApptAttr.Free; FSelApptAttr.Free; FHint.Free; FHintProps.Free; FTemplate.Free; FGrabHandles.Free; PaintBuffer.Free; inherited Destroy; // This MUST be done after the inherited Destroy as it will set the Manager // property to nil, thus triggering RelSchedNotification if ScheduleCount // is still not 0. And in that very method, there is a test on Cols.Count. // Hence, if FCols was to be freed before inherited, RelSchedNotification // would try to access a freed object, leading to potential AVs. FCols.Free; end; { procedure TJvTFDays.CMCtl3DChanged(var Msg: TLMessage); begin if FBorderStyle = bsSingle then RecreateWnd; inherited; end; } {$IF LCL_FullVersion >= 1080000} procedure TJvTFDays.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin inherited; if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin if IsStoredColHdrHeight then FColHdrHeight := round(FColHdrHeight * AYProportion); if IsStoredDefColWidth then FDefColWidth := round(FDefColWidth * AXProportion); if IsStoredGroupHdrHeight then FGroupHdrHeight := round(FGroupHdrHeight * AYProportion); if IsStoredMinColWidth then FMinColWidth := round(FMinColWidth * AXProportion); if IsStoredMinRowHeight then FMinRowHeight := round(FMinRowHeight * AYProportion); if IsStoredRowHdrWidth then FRowHdrWidth := round(FRowHdrWidth * AXProportion); if IsStoredRowHeight then FRowHeight := round(FRowHeight * AYProportion); FApptBar.AutoAdjustLayout(AMode, AXProportion, AYProportion); FCols.AutoAdjustLayout(AMode, AXProportion, AYProportion); FGrabHandles.AutoAdjustLayout(AMode, AXProportion, AYProportion); end; end; {$IFEND} {$IF LCL_FullVersion >= 1080100} procedure TJvTFDays.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); begin inherited; DoScaleFontPPI(ApptAttr.Font, AToPPI, AProportion); DoScaleFontPPI(FancyRowHdrAttr.MajorFont, AToPPI, AProportion); DoScaleFontPPI(FancyRowHdrAttr.MinorFont, AToPPI, AProportion); DoScaleFontPPI(GroupHdrAttr.Font, AToPPI, AProportion); DoScaleFontPPI(HdrAttr.Font, AToPPI, AProportion); DoScaleFontPPI(SelApptAttr.Font, AToPPI, AProportion); DoScaleFontPPI(SelFancyRowHdrAttr.MajorFont, AToPPI, AProportion); DoScaleFontPPI(SelFancyRowHdrAttr.MinorFont, AToPPI, AProportion); DoScaleFontPPI(SelGroupHdrAttr.Font, AToPPI, AProportion); DoScaleFontPPI(SelHdrAttr.Font, AToPPI, AProportion); DoScaleFontPPI(TimeBlockProps.BlockHdrAttr.Font, AToPPI, AProportion); DoScaleFontPPI(TimeBlockProps.SelBlockHdrAttr.Font, AToPPI, AProportion); end; {$ELSEIF LCL_FullVersion >= 1080000} procedure TJvTFDays.ScaleFontsPPI(const AProportion: Double); begin inherited; DoScaleFontPPI(ApptAttr.Font, AProportion); DoScaleFontPPI(FancyRowHdrAttr.MajorFont, AProportion); DoScaleFontPPI(FancyRowHdrAttr.MinorFont, AProportion); DoScaleFontPPI(GroupHdrAttr.Font, AProportion); DoScaleFontPPI(HdrAttr.Font, AProportion); DoScaleFontPPI(SelApptAttr.Font, AProportion); DoScaleFontPPI(SelFancyRowHdrAttr.MajorFont, AProportion); DoScaleFontPPI(SelFancyRowHdrAttr.MinorFont, AProportion); DoScaleFontPPI(SelGroupHdrAttr.Font, AProportion); DoScaleFontPPI(SelHdrAttr.Font, AProportion); DoScaleFontPPI(TimeBlockProps.BlockHdrAttr.Font, AProportion); DoScaleFontPPI(TimeBlockProps.SelBlockHdrAttr.Font, AProportion); end; {$IFEND} procedure TJvTFDays.WMGetDlgCode(var Msg: TLMGetDlgCode); begin Msg.Result := DLGC_WANTALLKEYS or DLGC_WANTARROWS; end; { procedure TJvTFDays.SetBorderStyle(Value: TBorderStyle); begin if FBorderStyle <> Value then begin FBorderStyle := Value; RecreateWnd; end; end; } procedure TJvTFDays.SetTFVisibleScrollBars(Value: TJvTFVisibleScrollBars); begin if Value <> FVisibleScrollBars then begin FVisibleScrollBars := Value; AlignScrollBars; FVScrollBar.Visible := vsbVert in FVisibleScrollBars; FHScrollBar.Visible := vsbHorz in FVisibleScrollBars; end; end; procedure TJvTFDays.AlignScrollBars; begin // DO NOT INVALIDATE GRID IN THIS METHOD if (FVScrollBar = nil) or (FHScrollbar = nil) then exit; FVScrollBar.Left := ClientWidth - FVScrollBar.Width; FHScrollBar.Top := ClientHeight - FHScrollBar.Height; with FVScrollBar do begin //group Top := ColHdrHeight; Top := CalcGroupColHdrsHeight; if vsbHorz in VisibleScrollBars then Height := FHScrollBar.Top - Top else Height := Self.ClientHeight - Top; end; with FHScrollBar do begin {$IFDEF Jv_TIMEBLOCKS} // ok Left := CalcBlockRowHdrsWidth; {$ELSE} // remove //Left := RowHdrWidth; {$ENDIF Jv_TIMEBLOCKS} if vsbVert in VisibleScrollBars then Width := FVScrollBar.Left - Left else Width := Self.ClientWidth - Left; end; end; function TJvTFDays.CheckSBVis: Boolean; var NewSBVis: TJvTFVisibleScrollBars; I, TempWidth, NewDataHeight, NewDataWidth: Integer; DoColResize: Boolean; function CalcDataRect(ForScrollBars: TJvTFVisibleScrollBars): TRect; begin Result := GetClientRect; {$IFDEF Jv_TIMEBLOCKS} // ok Inc(Result.Left, CalcBlockRowHdrsWidth); {$ELSE} // remove //Inc(Result.Left, RowHdrWidth); {$ENDIF Jv_TIMEBLOCKS} //group Inc(Result.Top, ColHdrHeight); Inc(Result.Top, CalcGroupColHdrsHeight); if vsbHorz in ForScrollBars then Dec(Result.Bottom, FHScrollBar.Height); if vsbVert in ForScrollBars then Dec(Result.Right, FVScrollBar.Width); end; function CalcDataWidth(ForScrollBars: TJvTFVisibleScrollBars): Integer; begin Result := RectWidth(CalcDataRect(ForScrollBars)); end; function CalcDataHeight(ForScrollBars: TJvTFVisibleScrollBars): Integer; begin Result := RectHeight(CalcDataRect(ForScrollBars)); end; begin NewSBVis := []; // First check vert scroll bar, assuming horz is not needed NewDataHeight := CalcDataHeight(NewSBVis); if (RowCount * RowHeight > NewDataHeight) or (TopRow > 0) then Include(NewSBVis, vsbVert); if Cols.Count > 0 then begin // Now check the horz scroll under the new conditions NewDataWidth := CalcDataWidth(NewSBVis); if AutoSizeCols then begin if (Cols.Count * MinColWidth > NewDataWidth) or (LeftCol > 0) then Include(NewSBVis, vsbHorz); end else begin TempWidth := 0; I := 0; while (TempWidth <= NewDataWidth) and (I < Cols.Count) do begin Inc(TempWidth, Cols[I].Width); Inc(I); end; if (TempWidth > NewDataWidth) or (LeftCol > 0) then Include(NewSBVis, vsbHorz); end; end; // if the horz scrollbar should show, we must recheck the vert scrollbar, // since the vert scrollbar was initially checked with the assumption // that the horz scrollbar was not needed. if vsbHorz in NewSBVis then begin NewDataHeight := CalcDataHeight(NewSBVis); if (RowCount * RowHeight > NewDataHeight) or (TopRow > 0) then Include(NewSBVis, vsbVert); end; // if we're autosizing the cols and the vert scrollbar has been // toggled and the horz scroll isn't visible then we need to resize // the cols. We can't call Cols.Resize until VisibleScrollBars has // been updated so just set a flag here. DoColResize := AutoSizeCols and not (vsbHorz in NewSBVis) and ((vsbVert in NewSBVis) xor (vsbVert in VisibleScrollBars)); // At this point NewSBVis will correctly reflect which scrollbars need to // visible on the control. VisibleScrollBars := NewSBVis; // In order to optimize the resizing of cols when AutoSizeCols is on, this // function needs a return value specifying whether or not the cols have // been resized from within this routine. if we're not autosizing cols // it'll return false, but the result is meaningless. Result := DoColResize; // Finally, resize the cols if necessary if DoColResize then Cols.ResizeCols; CheckSBParams; end; procedure TJvTFDays.SetOnShowHint(Value: TJvTFShowHintEvent); begin FHint.OnShowHint := Value; end; function TJvTFDays.GetOnShowHint: TJvTFShowHintEvent; begin Result := FHint.OnShowHint; end; procedure TJvTFDays.SetGranularity(Value: Integer); var ATime: TTime; MaxRowHeight, I: Integer; begin if Assigned(FOnGranularityChanging) then FOnGranularityChanging(Self, Value); // Enforce minimum granularity of 1 min and max of 60 mins if Value < 1 then Value := 1 else if Value > 60 then Value := 60; // Ensure that granularity is evenly divisable by an hour while 60 mod Value <> 0 do Dec(Value); // Sum of row heights cannot exceed 32767 MaxRowHeight := 32767 div (60 div Value * 24); if RowHeight > MaxRowHeight then RowHeight := MaxRowHeight; if Value <> FGranularity then begin {$IFDEF Jv_TIMEBLOCKS} // ok EnsureBlockRules(Value, TimeBlockProps.BlockGran, TimeBlockProps.DayStart); {$ENDIF Jv_TIMEBLOCKS} ATime := RowToTime(TopRow); FGranularity := Value; ClearSelection; if not (csLoading in ComponentState) then begin for I := 0 to Cols.Count - 1 do Cols[I].RefreshMap; TopRow := TimeToRow(ATime); CheckSBVis; CheckSBParams; Invalidate; if Assigned(FOnGranularityChanged) then FOnGranularityChanged(Self); end; end; end; procedure TJvTFDays.SetColHdrHeight(Value: Integer); begin if Value > RectHeight(GetAdjClientRect) then Value := RectHeight(GetAdjClientRect); if Value < 1 then Value := 1; if Value <> ColHdrHeight then begin FColHdrHeight := Value; AlignScrollBars; if not (csLoading in ComponentState) then begin CheckSBVis; CheckSBParams; Invalidate; end; end; end; function TJvTFDays.IsStoredColHdrHeight: Boolean; begin Result := FColHdrHeight <> Scale96ToFont(DEFAULT_COL_HDR_HEIGHT); end; procedure TJvTFDays.SetRowHdrWidth(Value: Integer); begin if Value > RectWidth(GetAdjClientRect) then Value := RectWidth(GetAdjClientRect); if Value < 1 then Value := 1; if Value <> FRowHdrWidth then begin FRowHdrWidth := Value; AlignScrollBars; if AutoSizeCols then begin if not CheckSBVis then if not (vsbHorz in VisibleScrollBars) then Cols.ResizeCols; end else CheckSBVis; CheckSBParams; Invalidate; end; end; function TJvTFDays.IsStoredRowHdrWidth: Boolean; begin Result := FRowHdrWidth <> Scale96ToFont(DEFAULT_ROW_HDR_WIDTH); end; procedure TJvTFDays.SetRowHeight(Value: Integer); var MaxRowHeight: Integer; begin if Value > GetDataHeight then Value := GetDataHeight; if Value < MinRowHeight then Value := MinRowHeight; if Value < 1 then Value := 1; // Sum of row heights cannot exceed 32767. MaxRowHeight := 32767 div (60 div Granularity * 24); if Value > MaxRowHeight then Value := MaxRowHeight; if Value <> FRowHeight then begin FRowHeight := Value; if not (csLoading in ComponentState) then begin CheckSBVis; CheckSBParams; Invalidate; end; end; end; function TJvTFDays.IsStoredRowHeight: Boolean; begin Result := FRowHeight <> Scale96ToFont(DEFAULT_ROW_HEIGHT); end; procedure TJvTFDays.SetMinRowHeight(Value: Integer); var absMinColWidth: Integer; begin absMinColWidth := Scale96ToFont(DEFAULT_MIN_COL_WIDTH); if Value < absMinColWidth then Value := absMinColWidth; if Value <> FMinRowHeight then begin FMinRowHeight := Value; if Value > RowHeight then RowHeight := Value; end; end; function TJvTFDays.IsStoredMinRowHeight: Boolean; begin Result := FMinRowHeight <> Scale96ToFont(DEFAULT_MIN_ROW_HEIGHT); end; procedure TJvTFDays.SetMinColWidth(Value: Integer); var absMinColWidth: Integer; begin absMinColWidth := Scale96ToFont(DEFAULT_MIN_COL_WIDTH); if Value < absMinColWidth then Value := absMinColWidth; if Value <> FMinColWidth then begin FMinColWidth := Value; if not (csLoading in ComponentState) then Cols.EnsureMinColWidth; end; end; function TJvTFDays.IsStoredMinColWidth: Boolean; begin Result := FMinColWidth <> Scale96ToFont(DEFAULT_MIN_COL_WIDTH); end; function TJvTFDays.IsStoredDefColWidth: Boolean; begin Result := FDefColWidth <> Scale96ToFont(DEFAULT_DEF_COL_WIDTH); end; procedure TJvTFDays.SetAutoSizeCols(Value: Boolean); begin if Value <> FAutoSizeCols then begin FAutoSizeCols := Value; if FAutoSizeCols then if not CheckSBVis then Cols.ResizeCols; end; end; procedure TJvTFDays.SetTFColTitleStyle(Value: TJvTFColTitleStyle); begin if Value <> FColTitleStyle then begin FColTitleStyle := Value; Invalidate; end; end; procedure TJvTFDays.SetCols(Value: TJvTFDaysCols); begin FCols.Assign(Value); end; procedure TJvTFDays.SetTopRow(Value: Integer); var MaxTopRow: Integer; begin MaxTopRow := RowCount - 1; if MaxTopRow < 0 then MaxTopRow := 0; if Value > MaxTopRow then Value := MaxTopRow; if Value <> FTopRow then if (Value > -1) and (Value < RowCount) then begin if Editing then FinishEditAppt; FTopRow := Value; FVScrollBar.Position := Value; CheckSBVis; Invalidate; end else raise EJvTFDaysError.CreateRes(@RsERowIndexOutOfBounds); end; procedure TJvTFDays.SetFocusedRow(Value: Integer); begin // ALLOW -1 TO INDICATE NO SELECTED ROW {$IFDEF Jv_TIMEBLOCKS} // ok if (Value <> -1) and (RowToTimeBlock(Value) = -1) and (TimeBlocks.Count > 0) then Exit; {$ENDIF Jv_TIMEBLOCKS} if Value <> FFocusedRow then if (Value >= -1) and (Value < RowCount) then begin FFocusedRow := Value; if not (csDesigning in ComponentState) then SetFocus; if not Assigned(SelAppt) and (Value > -1) then RowInView(Value); if Assigned(FOnFocusedRowChanged) then FOnFocusedRowChanged(Self); Invalidate; end else raise EJvTFDaysError.CreateRes(@RsERowIndexOutOfBounds); end; function TJvTFDays.GetFocusedRow: Integer; begin if Focused then Result := FFocusedRow else Result := -1; end; procedure TJvTFDays.SetLeftCol(Value: Integer); begin // LeftCol will be -1 when no cols are present. // After the first col is added, LeftCol is set to 0, which is done in // TJvTFDaysCols.Update. Likewise, when all cols are removed, LeftCol // must be set to -1. This is also done in TJvTFDaysCols.Update. if Value <> FLeftCol then if Cols.Count > 0 then if (Value > -1) and (Value < Cols.Count) then begin FLeftCol := Value; FHScrollBar.Position := Value; if not Cols.Updating then begin CheckSBVis; CheckSBParams; Invalidate; end; end else raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds) else if Value = -1 then begin FLeftCol := -1; Invalidate; end else raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds); end; procedure TJvTFDays.SetFocusedCol(Value: Integer); begin // ALLOW -1 TO INDICATE NO SELECTED COL if Value <> FFocusedCol then if (Value >= -1) and (Value < Cols.Count) then begin FFocusedCol := Value; if not (csDesigning in ComponentState) then SetFocus; if not Cols.Updating then begin if Value > -1 then ColInView(Value); if Assigned(FOnFocusedColChanged) then FOnFocusedColChanged(Self); Invalidate; end; end else raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds); end; function TJvTFDays.GetFocusedCol: Integer; begin if Focused then Result := FFocusedCol else Result := -1; end; procedure TJvTFDays.SetHdrAttr(Value: TJvTFDaysHdrAttr); begin FHdrAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetSelHdrAttr(Value: TJvTFDaysHdrAttr); begin FSelHdrAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetApptAttr(Value: TJvTFDaysApptAttr); begin FApptAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetSelApptAttr(Value: TJvTFDaysApptAttr); begin FSelApptAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr); begin FFancyRowHdrAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetSelFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr); begin FSelFancyRowHdrAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetTFRowHdrType(Value: TJvTFRowHdrType); begin if Value <> FRowHdrType then begin FRowHdrType := Value; Invalidate; end; end; procedure TJvTFDays.SetTFSelCellAttr(Value: TJvTFSelCellAttr); begin FSelCellAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetApptBar(Value: TJvTFDaysApptBar); begin FApptBar.Assign(Value); Invalidate; end; procedure TJvTFDays.SetApptBuffer(Value: Integer); begin if Value < 0 then Value := 0; if Value <> FApptBuffer then begin FApptBuffer := Value; Invalidate; end; end; procedure TJvTFDays.SetGridLineColor(Value: TColor); begin if Value <> FGridLineColor then begin FGridLineColor := Value; Invalidate; end; end; procedure TJvTFDays.SetGrabHandles(Value: TJvTFDaysGrabHandles); begin FGrabHandles.Assign(Value); Invalidate; end; procedure TJvTFDays.SetOptions(Value: TJvTFDaysOptions); begin FOptions := Value; Invalidate; end; procedure TJvTFDays.SetDateFormat(const Value: string); begin if Value <> FDateFormat then begin FDateFormat := Value; Cols.UpdateTitles; Invalidate; end; end; procedure TJvTFDays.RelSchedNotification(Schedule: TJvTFSched); var I: Integer; begin for I := 0 to Cols.Count - 1 do if Cols[I].Schedule = Schedule then Cols[I].Disconnect; inherited RelSchedNotification(Schedule); end; procedure TJvTFDays.CreateParams(var Params: TCreateParams); { const BorderStyles: array [TBorderStyle] of DWORD = (0, WS_BORDER); } begin inherited CreateParams(Params); { with Params do begin Style := Style or BorderStyles[FBorderStyle] or WS_CLIPCHILDREN; if Ctl3D and (FBorderStyle = bsSingle) then begin Style := Style and not WS_BORDER; ExStyle := ExStyle or WS_EX_CLIENTEDGE; end; end; } end; function TJvTFDays.GetFocusedSchedule: TJvTFSched; begin Result := nil; if FocusedCol > gcHdr then Result := Cols[FocusedCol].Schedule; end; procedure TJvTFDays.SetSelAppt(Value: TJvTFAppt); begin // need event here with var Appt param - allows handler to set Appt // to nil. if Assigned(FOnSelectingAppt) then FOnSelectingAppt(Self, Value); if Value <> FSelAppt then begin if Editing then FinishEditAppt; if Assigned(FOnSelectAppt) then FOnSelectAppt(Self, FSelAppt, Value); FSelAppt := Value; if Assigned(FOnSelectedAppt) then FOnSelectedAppt(Self); Invalidate; end; end; procedure TJvTFDays.Paint; var I, J, lRightCol, lBottomRow: Integer; w, h: Integer; begin { optimization incorrectly kicks in if control is only partially visible on the screen if not PaintBuffer.Empty and ((Canvas.ClipRect.Left <> ClientRect.Left) or (Canvas.ClipRect.Top <> ClientRect.Top) or (Canvas.ClipRect.Right <> ClientRect.Right) or (Canvas.ClipRect.Bottom <> ClientRect.Bottom)) then begin With Canvas do Windows.BitBlt(Canvas.Handle, ClipRect.Left, ClipRect.Top, RectWidth(ClipRect), RectHeight(ClipRect), PaintBuffer.Canvas.Handle, ClipRect.Left, ClipRect.Top, SRCCOPY); Exit; end; } w := ClientWidth; h := ClientHeight; with PaintBuffer do begin SetSize(w, h); with Canvas do begin Pixels[0, 0] := clWhite; // Workaround for Lazarus to avoid black background if FDitheredBackground then // added by TIM, 10/27/2001 10:36:03 PM: DrawDither(Canvas, Classes.Rect(0, 0, w, h), Self.Color, clGray) else begin Brush.Color := Self.Color; FillRect(Classes.Rect(0, 0, Width, Height)); end; end; DrawCorner(Canvas, agcTopLeft); if Cols.Count = 0 then DrawEmptyColHdr(Canvas); DrawGroupHdrs(Canvas); lRightCol := LeftCol + VisibleCols - 1; for I := LeftCol to lRightCol do //DrawColHdr(Canvas, I); DrawColGroupHdr(Canvas, I, False); if vsbVert in VisibleScrollBars then DrawCorner(Canvas, agcTopRight); {$IFDEF Jv_TIMEBLOCKS} // all ok FillBlockHdrDeadSpace(Canvas); for I := 0 to TimeBlocks.Count - 1 do DrawBlockHdr(Canvas, I); {$ENDIF Jv_TIMEBLOCKS} lBottomRow := TopRow + VisibleRows - 1; if RowHdrType = rhFancy then DrawFancyRowHdrs(Canvas) else for I := TopRow to lBottomRow do DrawRowHdr(Canvas, I); for I := TopRow to lBottomRow do for J := LeftCol to lRightCol do DrawDataCell(Canvas, J, I); if not (csDesigning in ComponentState) then DrawAppts(Canvas, False); if vsbHorz in VisibleScrollBars then begin DrawCorner(Canvas, agcBottomLeft); if vsbVert in VisibleScrollBars then DrawCorner(Canvas, agcBottomRight); end; end; if Enabled then BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, PaintBuffer.Canvas.Handle, 0, 0, SRCCOPY) else BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, PaintBuffer.Canvas.Handle, 0, 0, SRCCOPY) { wp --- to do: Above line is a work-around because LCL does not support DrawState Windows.DrawState(Canvas.Handle, 0, nil, PaintBuffer.Handle, 0, 0, 0, 0, 0, DST_BITMAP or DSS_UNION or DSS_DISABLED); } end; {$IFNDEF Jv_TIMEBLOCKS} // OBSOLETE { procedure TJvTFDays.DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer); Var SelFrameRect, FocusRect, ARect: TRect; I, PrimeStartRow, PrimeEndRow, FrameOffset: Integer; CellColor: TColor; IsPrimeTimeCell: Boolean; begin // Calc the cell rect ARect.Left := RowHdrWidth; For I := LeftCol to ColIndex - 1 do Inc(ARect.Left, Cols[I].Width); ARect.Right := ARect.Left + Cols[ColIndex].Width; //group Top := ColHdrHeight + (RowIndex - TopRow) * RowHeight; ARect.Top := CalcGroupColHdrsHeight + (RowIndex - TopRow) * RowHeight; ARect.Bottom := ARect.Top + RowHeight; PrimeStartRow := TimeToRow(PrimeTime.StartTime); PrimeEndRow := TimeToRow(AdjustEndTime(PrimeTime.EndTime)); IsPrimeTimeCell := (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow); if IsPrimeTimeCell then CellColor := PrimeTime.Color else CellColor := Color; if Assigned(FOnShadeCell) then FOnShadeCell(Self, ColIndex, RowIndex, CellColor); if IsPrimeTimeCell and (CellColor = PrimeTime.Color) then Windows.StretchBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect), RectHeight(ARect), PrimeTime.FFillPic.Canvas.Handle, 0, 0, PrimeTime.FFillPic.Width, PrimeTime.FFillPic.Height, SRCCOPY) else if CellColor <> Color then begin ACanvas.Brush.Color := CellColor; ACanvas.FillRect(ARect); end; if CellIsSelected(Point(ColIndex, RowIndex)) then if SelCellAttr.Style = scsFrame then begin SelFrameRect := ARect; FrameOffset := -(SelCellAttr.FrameWidth div 2); Windows.InflateRect(SelFrameRect, FrameOffset, FrameOffset); if SelCellAttr.FrameWidth mod 2 <> 0 then begin Dec(SelFrameRect.Right); Dec(SelFrameRect.Bottom); end; With ACanvas do begin Pen.Color := SelCellAttr.Color; Pen.Width := SelCellAttr.FrameWidth; if FFromToSel then begin // Draw Left border MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); // Draw Top border only if this cell is the same as SelStart cell if (ColIndex = SelStart.X) and (RowIndex = SelStart.Y) then begin MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Top); end; // Draw Right border MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); // Draw bottom border only in this cell is the same as SelEnd cell if (ColIndex = SelEnd.X) and (RowIndex = SelEnd.Y) then begin MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); end; end else begin // Draw Left border only if col is left-most in selection if ColIndex = SelStart.X then begin MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); end; // Draw Top border only if row is top-most in selection if RowIndex = SelStart.Y then begin MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Top); end; // Draw Right border only if col is right-most in selection if ColIndex = SelEnd.X then begin MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); end; // Draw Bottom border only if row is bottom-most in selection if RowIndex = SelEnd.Y then begin MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); end; end; end; end // Refer to the private FSel* fields because we want anchor else if (SelCellAttr.Style = scsCombo) and (FSelStart.X = ColIndex) and (FSelStart.Y = RowIndex) then begin SelFrameRect := ARect; FrameOffset := -(SelCellAttr.FrameWidth div 2); Windows.InflateRect(SelFrameRect, FrameOffset, FrameOffset); if SelCellAttr.FrameWidth mod 2 <> 0 then begin Dec(SelFrameRect.Right); Dec(SelFrameRect.Bottom); end; With ACanvas do begin Pen.Color := SelCellAttr.Color; Pen.Width := SelCellAttr.FrameWidth; MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Left, SelFrameRect.Top); end; end else begin ACanvas.Brush.Color := SelCellAttr.Color; ACanvas.FillRect(ARect); end; if (ColIndex = FocusedCol) and (RowIndex = FocusedRow) and Focused then begin FocusRect := ARect; Windows.InflateRect(FocusRect, -1, -1); Dec(FocusRect.Bottom); Dec(FocusRect.Right); ManualFocusRect(ACanvas, FocusRect); end; // Draw a line across the bottom and down the right side With ACanvas do begin Pen.Color := GridLineColor; Pen.Width := 1; MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom); end; if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, ACanvas, ARect, ColIndex, RowIndex); end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok procedure TJvTFDays.DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer); var BlockStart: Integer = -1; // to silence the compiler BlockEnd: Integer = -1; // dto. SelFrameRect, FocusRect, Rect: TRect; I, PrimeStartRow, PrimeEndRow: Integer; FrameOffset, TimeBlockIndex: Integer; IsPrimeTimeCell: Boolean; CellColor: TColor; // col buffer start BufferRect: TRect; // col buffer end begin // Calc the cell rect //block Left := RowHdrWidth; Rect.Left := CalcBlockRowHdrsWidth; for I := LeftCol to ColIndex - 1 do Inc(Rect.Left, Cols[I].Width); Rect.Right := Rect.Left + Cols[ColIndex].Width; //group Top := ColHdrHeight + (RowIndex - TopRow) * RowHeight; Rect.Top := CalcGroupColHdrsHeight + (RowIndex - TopRow) * RowHeight; Rect.Bottom := Rect.Top + RowHeight; PrimeStartRow := TimeToRow(PrimeTime.StartTime); PrimeEndRow := TimeToRow(AdjustEndTime(PrimeTime.EndTime)); IsPrimeTimeCell := (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow); if IsWeekend(ColIndex) then CellColor := WeekendColor else if IsPrimeTimeCell then CellColor := PrimeTime.Color else CellColor := Color; if Assigned(FOnShadeCell) then FOnShadeCell(Self, ColIndex, RowIndex, CellColor); if IsWeekend(ColIndex) and (CellColor = WeekendColor) then begin if FDitheredBackground then DrawDither(ACanvas, Rect, CellColor, clWhite) else StretchBlt(ACanvas.Handle, Rect.Left, Rect.Top, RectWidth(Rect), RectHeight(Rect), FWeekendFillPic.Canvas.Handle, 0, 0, FWeekendFillPic.Width, FWeekendFillPic.Height, SRCCOPY); end else if IsPrimeTimeCell and (CellColor = PrimeTime.Color) then begin if FDitheredBackground then DrawDither(ACanvas, Rect, CellColor, clWhite) else StretchBlt(ACanvas.Handle, Rect.Left, Rect.Top, RectWidth(Rect), RectHeight(Rect), PrimeTime.FFillPic.Canvas.Handle, 0, 0, PrimeTime.FFillPic.Width, PrimeTime.FFillPic.Height, SRCCOPY); end else if CellColor <> Color then begin ACanvas.Brush.Color := CellColor; ACanvas.FillRect(Rect); end else begin if FDitheredBackground then DrawDither(ACanvas, Rect, CellColor, clWhite); end; { if IsWeekend(ColIndex) then Windows.StretchBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect), RectHeight(ARect), FWeekendFillPic.Canvas.Handle, 0, 0, FWeekendFillPic.Width, FWeekendFillPic.Height, SRCCOPY) else if (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow) then Windows.StretchBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect), RectHeight(ARect), PrimeTime.FFillPic.Canvas.Handle, 0, 0, PrimeTime.FFillPic.Width, PrimeTime.FFillPic.Height, SRCCOPY); } if CellIsSelected(Point(ColIndex, RowIndex)) then if SelCellAttr.Style = scsFrame then begin SelFrameRect := Rect; FrameOffset := -(SelCellAttr.FrameWidth div 2); InflateRect(SelFrameRect, FrameOffset, FrameOffset); if SelCellAttr.FrameWidth mod 2 <> 0 then begin Dec(SelFrameRect.Right); Dec(SelFrameRect.Bottom); end; with ACanvas do begin Pen.Color := SelCellAttr.Color; Pen.Width := SelCellAttr.FrameWidth; if FFromToSel then begin // Draw Left border MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); // Draw Top border only if this cell is the same as SelStart cell if (ColIndex = SelStart.X) and (RowIndex = SelStart.Y) then begin MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Top); end; // Draw Right border MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); // Draw bottom border only in this cell is the same as SelEnd cell if (ColIndex = SelEnd.X) and (RowIndex = SelEnd.Y) then begin MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); end; end else begin // Draw Left border only if col is left-most in selection if ColIndex = SelStart.X then begin MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); end; // Draw Top border only if row is top-most in selection if RowIndex = SelStart.Y then begin MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Top); end; // Draw Right border only if col is right-most in selection if ColIndex = SelEnd.X then begin MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); end; // Draw Bottom border only if row is bottom-most in selection if RowIndex = SelEnd.Y then begin MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); end; end; end; end // Refer to the private FSel* fields because we want anchor else if (SelCellAttr.Style = scsCombo) and (FSelStart.X = ColIndex) and (FSelStart.Y = RowIndex) then begin SelFrameRect := Rect; FrameOffset := -(SelCellAttr.FrameWidth div 2); InflateRect(SelFrameRect, FrameOffset, FrameOffset); if SelCellAttr.FrameWidth mod 2 <> 0 then begin Dec(SelFrameRect.Right); Dec(SelFrameRect.Bottom); end; with ACanvas do begin Pen.Color := SelCellAttr.Color; Pen.Width := SelCellAttr.FrameWidth; MoveTo(SelFrameRect.Left, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Top); LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1); LineTo(SelFrameRect.Left, SelFrameRect.Top); end; end else begin ACanvas.Brush.Color := SelCellAttr.Color; ACanvas.FillRect(Rect); end; if (ColIndex = FocusedCol) and (RowIndex = FocusedRow) and Focused and ShowFocus then begin FocusRect := Rect; InflateRect(FocusRect, -1, -1); Dec(FocusRect.Bottom); Dec(FocusRect.Right); ManualFocusRect(ACanvas, FocusRect); end; // Draw a line across the bottom and down the right side with ACanvas do begin Pen.Color := GridLineColor; Pen.Width := 1; MoveTo(Rect.Left, Rect.Bottom - 1); LineTo(Rect.Right, Rect.Bottom - 1); MoveTo(Rect.Right - 1, Rect.Top); LineTo(Rect.Right - 1, Rect.Bottom); if TimeBlocks.Count > 0 then begin GetTimeBlockStartEnd(0, BlockStart, BlockEnd); if RowIndex = BlockStart - 1 then begin Pen.Color := TimeBlockProps.DataDivColor; MoveTo(Rect.Left, Rect.Bottom - 1); LineTo(Rect.Right, Rect.Bottom - 1); end; TimeBlockIndex := RowToTimeBlock(RowIndex); if TimeBlockIndex > -1 then begin GetTimeBlockStartEnd(TimeBlockIndex, BlockStart, BlockEnd); if BlockEnd = RowIndex then begin Pen.Color := TimeBlockProps.DataDivColor; MoveTo(Rect.Left, Rect.Bottom - 1); LineTo(Rect.Right, Rect.Bottom - 1); end; end; end; end; // Col Buffer start // Draw the column buffer with ACanvas do begin BufferRect := Rect; BufferRect.Right := BufferRect.Left + ApptBar.Width; // + 10 to simulate buffer Brush.Color := clWhite; FillRect(BufferRect); Pen.Color := clBlack; Pen.Width := 1; MoveTo(BufferRect.Right, BufferRect.Top); LineTo(BufferRect.Right, BufferRect.Bottom); end; // Col buffer end if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, ACanvas, Rect, ColIndex, RowIndex); end; {$ENDIF Jv_TIMEBLOCKS} procedure TJvTFDays.DrawEmptyColHdr(ACanvas: TCanvas); var Rect: TRect; begin {$IFDEF Jv_TIMEBLOCKS} // ok Rect.Left := CalcBlockRowHdrsWidth; {$ELSE} // remove //Left := RowHdrWidth; {$ENDIF Jv_TIMEBLOCKS} Rect.Top := 0; Rect.Right := Rect.Left + GetDataWidth; //group Bottom := ColHdrHeight; Rect.Bottom := CalcGroupColHdrsHeight; ACanvas.Brush.Color := HdrAttr.Color; ACanvas.FillRect(Rect); ACanvas.Pen.Color := clGray; ACanvas.MoveTo(Rect.Left, Rect.Bottom - 1); ACanvas.LineTo(Rect.Right, Rect.Bottom - 1); end; procedure TJvTFDays.DrawAppt(ACanvas: TCanvas; Col: Integer; Appt: TJvTFAppt; StartRow, EndRow: Integer); var ApptRect: TRect; ClipRgn: HRgn; begin ApptRect := GetApptRect(Col, Appt); if IsRectEmpty(ApptRect) then Exit; // Printer bug, fixed ClipRgn := CreateRectRgn(RowHdrWidth, CalcGroupColHdrsHeight, ClientWidth, ClientHeight); SelectClipRgn(ACanvas.Handle, ClipRgn); DrawApptDetail(ACanvas, ApptRect, Appt, Appt = SelAppt, Col, StartRow, EndRow); SelectClipRgn(ACanvas.Handle, 0); DeleteObject(ClipRgn); end; function TJvTFDays.CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer): TRect; var Offset, ApptLength: TTime; ColDate: TDate; StartPercent, EndPercent: Double; begin Result := BarRect; if StartRow < 0 then StartRow := 0; if EndRow > RowCount - 1 then EndRow := RowCount - 1; Offset := RowToTime(StartRow); ApptLength := RowEndTime(EndRow) - Offset; ColDate := Cols[Col].SchedDate; if Trunc(ColDate) <> Trunc(Appt.StartDate) then StartPercent := 0 else StartPercent := (Appt.StartTime - Offset) / ApptLength; if Trunc(ColDate) <> Trunc(Appt.EndDate) then EndPercent := 1.0 else EndPercent := (Appt.EndTime - Offset) / ApptLength; Result.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) + BarRect.Top; Result.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) + BarRect.Top; end; procedure TJvTFDays.DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect); var OldColor: TColor; StampLeft: Integer; begin with ACanvas do case ApptBar.TimeStampStyle of tssFullI: begin OldColor := Pen.Color; Pen.Color := ApptBar.TimeStampColor; MoveTo(TimeStampRect.Left + 1, TimeStampRect.Top); LineTo(TimeStampRect.Right - 1, TimeStampRect.Top); MoveTo(TimeStampRect.Left + 1, TimeStampRect.Bottom - 1); LineTo(TimeStampRect.Right - 1, TimeStampRect.Bottom - 1); if ApptBar.Width > 5 then Pen.Width := 2 else Pen.Width := 1; // Printer bug, fixed StampLeft := TimeStampRect.Left + RectWidth(TimeStampRect) div 2; MoveTo(StampLeft, TimeStampRect.Top + 1); LineTo(StampLeft, TimeStampRect.Bottom - 1); Pen.Width := 1; Pen.Color := OldColor; end; tssHalfI: begin // we only want the left half of the time stamp rect TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2; OldColor := Pen.Color; Pen.Color := ApptBar.TimeStampColor; MoveTo(TimeStampRect.Left, TimeStampRect.Top); LineTo(TimeStampRect.Right - 0, TimeStampRect.Top); MoveTo(TimeStampRect.Left, TimeStampRect.Bottom - 0); LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom - 0); if ApptBar.Width > 5 then Pen.Width := 2 else Pen.Width := 1; MoveTo(TimeStampRect.Right - 0, TimeStampRect.Top + 1); LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom); Pen.Color := OldColor; Pen.Width := 1; end; tssBlock: begin // we only want the left half of the time stamp rect TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2; OldColor := Brush.Color; Brush.Color := ApptBar.TimeStampColor; FillRect(TimeStampRect); Brush.Color := OldColor; end; end; end; procedure TJvTFDays.DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer); var OldColor: TColor; TimeStampRect: TRect; Attr: TJvTFDaysApptAttr; begin with ACanvas do begin if Appt <> SelAppt then Attr := ApptAttr else Attr := SelApptAttr; // Fill Bar Color OldColor := Brush.Color; if Appt.BarColor = clDefault then Brush.Color := ApptBar.Color else Brush.Color := Appt.BarColor; FillRect(BarRect); // Draw Bar Border Pen.Width := 1; Pen.Color := Attr.FrameColor; MoveTo(BarRect.Right - 1, BarRect.Top); LineTo(BarRect.Right - 1, BarRect.Bottom); // Rectangle(BarRect); Brush.Color := OldColor; // Draw Time Stamp TimeStampRect := CalcTimeStampRect(Appt, BarRect, Col, StartRow, EndRow); if ApptBar.TimeStampStyle <> tssNone then DrawTimeStamp(ACanvas, TimeStampRect); if Assigned(FOnDrawApptBar) then FOnDrawApptBar(Self, ACanvas, Appt, Col, BarRect, TimeStampRect); end; end; procedure TJvTFDays.DrawApptDetail(ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt; Selected: Boolean; Col, StartRow, EndRow: Integer); var TheFrameRect, TxtRect, DetailRect, BarRect, HandleRect: TRect; Txt: string; Flags: UINT; CanDrawText, CanDrawPics, CanDrawAppt: Boolean; PicsHeight, PicsWidth: Integer; DrawList: TList; Attr: TJvTFDaysApptAttr; DrawInfo: TJvTFDaysApptDrawInfo; begin with ACanvas do begin if Appt <> SelAppt then Attr := ApptAttr else Attr := SelApptAttr; DrawInfo := TJvTFDaysApptDrawInfo.Create; try GetApptDrawInfo(DrawInfo, Appt, Attr); Font.Assign(DrawInfo.Font); Brush.Color := DrawInfo.Color; Pen.Color := DrawInfo.FrameColor; Pen.Width := DrawInfo.FrameWidth; CanDrawAppt := DrawInfo.Visible; finally DrawInfo.Free; end; // !!!!!!!!!!!!!!!!!!!!!!!!!! // EXIT IF NOTHING TO DRAW !! // !!!!!!!!!!!!!!!!!!!!!!!!!! if not CanDrawAppt then Exit; FillRect(ARect); TheFrameRect := ARect; InflateRect(TheFrameRect, -(Attr.FrameWidth div 2), -(Attr.FrameWidth div 2)); // Need to fine tune the frame rect if Attr.FrameWidth mod 2 = 0 then begin Inc(TheFrameRect.Right); Inc(TheFrameRect.Bottom); end; MoveTo(TheFrameRect.Left, TheFrameRect.Top); LineTo(TheFrameRect.Right - 1, TheFrameRect.Top); LineTo(TheFrameRect.Right - 1, TheFrameRect.Bottom - 1); LineTo(TheFrameRect.Left, TheFrameRect.Bottom - 1); LineTo(TheFrameRect.Left, TheFrameRect.Top); // Only go through the following work if all details must be drawn // if (RectHeight(ARect) > Thresholds.DetailHeight) and // (RectWidth(ARect) > Thresholds.DetailWidth) then begin InflateRect(TheFrameRect, -(Attr.FrameWidth div 2), -(Attr.FrameWidth div 2)); DetailRect := TheFrameRect; if ApptBar.Visible then begin Inc(DetailRect.Left, ApptBar.Width); SubtractRect(BarRect, TheFrameRect, DetailRect); Dec(BarRect.Bottom); DrawApptBar(ACanvas, Appt, BarRect, Col, StartRow, EndRow); end; TxtRect := DetailRect; AdjustForMargins(TxtRect); DrawList := TList.Create; try CreatePicDrawList(TxtRect, Appt, DrawList); FilterPicDrawList(TxtRect, DrawList, PicsHeight, PicsWidth); // Calc'ing text height and width in CanDrawWhat CanDrawWhat(ACanvas, TxtRect, PicsHeight, CanDrawText, CanDrawPics); if CanDrawPics then begin DrawListPics(ACanvas, TxtRect, DrawList); Inc(TxtRect.Left, PicsWidth); // Tim end; finally ClearPicDrawList(DrawList); DrawList.Free; end; if CanDrawText then begin Flags := DT_WORDBREAK or DT_NOPREFIX or DT_EDITCONTROL; Txt := ScheduleManager.GetApptDisplayText(Self, Appt); if not (agoFormattedDesc in Options) then begin Txt := StripCRLF(Txt); Flags := Flags or DT_END_ELLIPSIS; end; //PTxt := StrNew(PChar(Txt)); DrawText(ACanvas.Handle, PChar(Txt), -1, TxtRect, Flags); end; end; if Assigned(FOnDrawAppt) then FOnDrawAppt(Self, ACanvas, ARect, Appt, Selected); if Selected then begin { OLD 3D HANDLES CODE if agoMoveAppt in Options then DrawGrabLines(ACanvas, ARect.Top + 0, ARect.Left + 2, ARect.Right - 3); if agoSizeAppt in Options then DrawGrabLines(ACanvas, ARect.Bottom - GrabHandles.Height, ARect.Left + 2, ARect.Right - 3); } // move grab handles if agoMoveAppt in Options then begin // HandleRect := Classes.Rect(ARect.Left + 2, ARect.Top, ARect.Right - 3, // ARect.Top + GrabHandles.Height); // DrawGrabHandle(ACanvas, HandleRect, Appt, True); HandleRect := GetTopGrabHandleRect(Col, Appt); DrawGrabHandle(ACanvas, HandleRect, Appt, True); end; if agoSizeAppt in Options then begin // HandleRect := Classes.Rect(ARect.Left + 2, // ARect.Bottom - GrabHandles.Height, // ARect.Right - 3, ARect.Bottom); // DrawGrabHandle(ACanvas, HandleRect, Appt, False); HandleRect := GetBottomGrabHandleRect(Col, Appt); DrawGrabHandle(ACanvas, HandleRect, Appt, False); end; end; end; end; procedure TJvTFDays.DrawPics(ACanvas: TCanvas; var ARect: TRect; Appt: TJvTFAppt); var I, PicAdjust, NextPicLeft, CustomPicLeft, ImageIndex: Integer; ImageList: TCustomImageList; ImageMap: TJvTFStateImageMap; CustomImageMap: TJvTFCustomImageMap; w, h, d: Integer; {$IF LCL_FullVersion >= 2000000} PPI: Integer; f: Double; {$ENDIF} begin PicAdjust := 0; NextPicLeft := ARect.Left; {$IF LCL_FullVersion >= 1080000} d := Scale96ToForm(PIC_DIST); {$ELSE} d := ScaleX(PIC_DIST, Screen.PixelsPerInch); {$ENDIF} if (agoShowPics in Options) and Assigned(ScheduleManager.CustomImages) then begin ImageList := ScheduleManager.CustomImages; CustomImageMap := Appt.ImageMap; {$IF LCL_FullVersion >= 2000000} PPI := Font.PixelsPerInch; f := GetCanvasScaleFactor; w := Imagelist.WidthForPPI[ImageList.Width, PPI]; h := round(ImageList.Height/ImageList.Width * w); {$ELSE} w := ImageList.Width; h := ImageList.Height; {$IFEND} for I := 0 to CustomImageMap.Count - 1 do begin ImageIndex := CustomImageMap[I]; {$IF LCL_FullVersion >= 2000000} ImageList.DrawForPPI(ACanvas, NextPicLeft, ARect.Top, ImageIndex, 0, PPI, f); {$ELSE} ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex); {$IFEND} Inc(NextPicLeft, w + d); end; if CustomImageMap.Count > 0 then PicAdjust := h + d; end; CustomPicLeft := NextPicLeft; if (agoShowPics in Options) and Assigned(ScheduleManager.StateImages) then begin ImageList := ScheduleManager.StateImages; ImageMap := ScheduleManager.StateImageMap; {$IF LCL_FullVersion >= 2000000} PPI := Font.PixelsPerInch; f := GetCanvasScaleFactor; w := Imagelist.WidthForPPI[ImageList.Width, PPI]; h := round(ImageList.Height/ImageList.Width * w); {$ELSE} w := ImageList.Width; h := ImageList.Height; {$IFEND} if Appt.AlarmEnabled then ImageIndex := ImageMap.AlarmEnabled else ImageIndex := ImageMap.AlarmDisabled; if ImageIndex > -1 then begin {$IF LCL_FullVersion >= 2000000} ImageList.DrawForPPI(ACanvas, NextPicLeft, ARect.Top, ImageIndex, 0, PPI, f); {$ELSE} ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex); {$IFEND} Inc(NextPicLeft, w + d); end; ImageIndex := ImageMap.Shared; if Appt.Shared and (ImageIndex > -1) then begin {$IF LCL_FullVersion >= 2000000} ImageList.DrawForPPI(ACanvas, NextPicLeft, ARect.Top, ImageIndex, 0, PPI, f); {$ELSE} ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex); {$IFEND} Inc(NextPicLeft, w + d); end; if Appt.Modified and (ImageMap.Modified > -1) then begin {$IF LCL_FullVersion >= 2000000} ImageList.DrawForPPI(ACanvas, NextPicLeft, ARect.Top, ImageMap.Modified, 0, PPI, f); {$ELSE} ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageMap.Modified); {$IFEND} Inc(NextPicLeft, w + d); end; if (NextPicLeft <> CustomPicLeft) and (h + d > PicAdjust) then PicAdjust := h + d; end; Inc(ARect.Top, PicAdjust); end; procedure TJvTFDays.CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt; DrawList: TList); var I, NextPicLeft, ImageIndex: Integer; ImageList: TCustomImageList; ImageMap: TJvTFStateImageMap; CustomImageMap: TJvTFCustomImageMap; //h, w, d: Integer; {$IF LCL_FullVersion >= 2000000} PPI: integer; //f: Double; {$IFEND} procedure AddToList(AImageList: TCustomImageList; AImageIndex: Integer; AGlyph: TGraphic; APicLeft, APicTop: Integer); var DrawInfo: TJvTFDrawPicInfo; begin DrawInfo := TJvTFDrawPicInfo.Create; DrawInfo.ImageList := AImageList; DrawInfo.ImageIndex := AImageIndex; DrawInfo.Glyph := AGlyph; DrawInfo.PicLeft := APicLeft; DrawInfo.PicTop := APicTop; DrawList.Add(DrawInfo); end; begin {$IF LCL_FullVersion >= 1080000} d := Scale96ToForm(PIC_DIST); {$ELSE} d := ScaleX(PIC_DIST, Screen.PixelsPerInch); {$ENDIF} NextPicLeft := ARect.Left; if (agoShowPics in Options) and Assigned(Appt.Glyph.Graphic) and not Appt.Glyph.Graphic.Empty then begin AddToList(nil, -1, Appt.Glyph.Graphic, NextPicLeft, ARect.Top); Inc(NextPicLeft, Appt.Glyph.Graphic.Width + d); end; if (agoShowPics in Options) and Assigned(ScheduleManager.CustomImages) then begin ImageList := ScheduleManager.CustomImages; CustomImageMap := Appt.ImageMap; {$IF LCL_FullVersion >= 2000000} PPI := Font.PixelsPerInch; w := Imagelist.WidthForPPI[ImageList.Width, PPI]; //h := round(ImageList.Height/ImageList.Width * w); //f := GetCanvasScaleFactor; {$ELSE} w := ImageList.Width; //h := ImageList.Height; {$IFEND} for I := 0 to CustomImageMap.Count - 1 do begin ImageIndex := CustomImageMap[I]; AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top); Inc(NextPicLeft, w + d); end; end; if (agoShowPics in Options) and Assigned(ScheduleManager.StateImages) then begin ImageList := ScheduleManager.StateImages; ImageMap := ScheduleManager.StateImageMap; if Appt.AlarmEnabled then begin ImageIndex := ImageMap.AlarmEnabled; if ImageIndex > -1 then begin AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top); Inc(NextPicLeft, w + d); end end else begin ImageIndex := ImageMap.AlarmDisabled; if ImageIndex > -1 then begin AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top); Inc(NextPicLeft, w + d); end; end; ImageIndex := ImageMap.Shared; if Appt.Shared and (ImageIndex > -1) then begin AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top); Inc(NextPicLeft, w + 2); end; if Appt.Modified and (ImageMap.Modified > -1) then begin AddToList(ImageList, ImageMap.Modified, nil, NextPicLeft, ARect.Top); // The following line generates a compiler hint so comment out, // but leave here as reminder in case method is expanded. //Inc(NextPicLeft, ImageList.Width + 2); end; end; end; procedure TJvTFDays.FilterPicDrawList(ARect: TRect; DrawList: TList; out PicsHeight, PicsWidth: Integer); var I, NextPicLeft: Integer; DrawIt: Boolean; DrawInfo: TJvTFDrawPicInfo; d: Integer; w, h: Integer; {$IF LCL_FullVersion >=2000000} PPI: Integer; //f: Double; {$IFEND} begin PicsHeight := 0; PicsWidth := 0; if DrawList.Count = 0 then Exit; {$IF LCL_FullVersion >= 2000000} PPI := Font.PixelsPerInch; //f := GetCanvasScaleFactor; {$IFEND} {$IF LCL_FullVersion >= 1080000} d := Scale96ToForm(PIC_DIST); {$ELSE} d := ScaleX(PIC_DIST, Screen.PixelsPerInch); {$ENDIF} if Thresholds.PicsAllOrNone then begin DrawInfo := TJvTFDrawPicInfo(DrawList[DrawList.Count - 1]); if Assigned(DrawInfo.ImageList) then begin {$IF LCL_FullVersion >= 2000000} w := DrawInfo.Imagelist.WidthForPPI[DrawInfo.ImageList.Width, PPI]; h := round(DrawInfo.ImageList.Height/DrawInfo.ImageList.Width * w); {$ELSE} w := DrawInfo.ImageList.Width; h := DrawInfo.ImageList.Height; {$IFEND} end; if DrawInfo.PicLeft + w >= ARect.Right then begin while DrawList.Count > 0 do begin TJvTFDrawPicInfo(DrawList[0]).Free; DrawList.Delete(0); end; end; end; NextPicLeft := ARect.Left; I := 0; while I < DrawList.Count do begin DrawInfo := TJvTFDrawPicInfo(DrawList[I]); with DrawInfo do begin DrawIt := True; // if Thresholds.WholePicsOnly and // ((PicLeft + ImageList.Width >= ARect.Right) or // (PicTop + ImageList.Height >= ARect.Bottom)) then // DrawIt := False; if DrawIt then begin if Assigned(ImageList) then begin {$IF LCL_FullVersion >= 2000000} w := Imagelist.WidthForPPI[ImageList.Width, PPI]; h := round(ImageList.Height/ImageList.Width * w); {$ELSE} w := ImageList.Width; h := ImageList.Height; {$IFEND} PicsHeight := Greater(PicsHeight, h + d); end else PicsHeight := Greater(PicsHeight, Glyph.Height + d); PicLeft := NextPicLeft; if Assigned(ImageList) then Inc(NextPicLeft, w + d) else Inc(NextPicLeft, Glyph.Width + d); // Increment I to move onto next pic in list Inc(I); end else // Remove pic from list begin // Remove pic from list DrawInfo.Free; DrawList.Delete(I); // DO NOT increment I - Since pic was removed from list // I will now point to next pic end; end; end; PicsWidth := NextPicLeft - ARect.Left; end; procedure TJvTFDays.ClearPicDrawList(DrawList: TList); begin while DrawList.Count > 0 do begin TJvTFDrawPicInfo(DrawList[0]).Free; DrawList.Delete(0); end; end; procedure TJvTFDays.DrawListPics(ACanvas: TCanvas; var ARect: TRect; DrawList: TList); var I: Integer; DrawInfo: TJvTFDrawPicInfo; {$IF LCL_FullVersion >= 2000000} f: Double; PPI: Integer; {$IFEND} begin {$IF LCL_FullVersion >= 2000000} PPI := Font.PixelsPerInch; f := GetCanvasScaleFactor; {$IFEND} for I := 0 to DrawList.Count - 1 do begin DrawInfo := TJvTFDrawPicInfo(DrawList[I]); with DrawInfo do begin if Assigned(ImageList) then {$IF LCL_FullVersion >= 2000000} ImageList.DrawForPPI(ACanvas, PicLeft, PicTop, ImageIndex, 0, PPI, f) {$ELSE} ImageList.Draw(ACanvas, PicLeft, PicTop, ImageIndex) {$IFEND} else ACanvas.Draw(PicLeft, PicTop, Glyph); end; end; end; procedure TJvTFDays.DrawGrabLines(ACanvas: TCanvas; LineTop, LineLeft, LineRight: Integer); begin // This draws the 3D grab handles, which have been replaced by flat style // handles. This remains as reference for possible future comeback as option. with ACanvas do begin Pen.Width := 1; Pen.Color := clWhite; MoveTo(LineLeft, LineTop); LineTo(LineRight, LineTop); MoveTo(LineLeft, LineTop + 1); LineTo(LineLeft + 1, LineTop + 1); Pen.Color := clSilver; LineTo(LineRight - 1, LineTop + 1); Pen.Color := clGray; LineTo(LineRight, LineTop + 1); MoveTo(LineLeft, LineTop + 2); LineTo(LineRight, LineTop + 2); Pen.Color := clWhite; MoveTo(LineLeft, LineTop + 3); LineTo(LineRight, LineTop + 3); MoveTo(LineLeft, LineTop + 4); LineTo(LineLeft + 1, LineTop + 4); Pen.Color := clSilver; LineTo(LineRight - 1, LineTop + 4); Pen.Color := clGray; LineTo(LineRight, LineTop + 4); MoveTo(LineLeft, LineTop + 5); LineTo(LineRight, LineTop + 5); end end; procedure TJvTFDays.DrawGrabHandle(ACanvas: TCanvas; ARect: TRect; AAppt: TJvTFAppt; TopHandle: Boolean); begin with ACanvas do begin Pen.Color := clBlack; Pen.Width := 1; Brush.Color := GrabHandles.Color; Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); end; if Assigned(FOnDrawGrabHandle) then FOnDrawGrabHandle(Self, ACanvas, ARect, AAppt, TopHandle); end; procedure TJvTFDays.DrawCorner(ACanvas: TCanvas; Corner: TJvTFDaysCorner); var ARect: TRect; CornerLeft: Integer; begin case Corner of //group agcTopLeft : ARect := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight); agcTopLeft: {$IFDEF Jv_TIMEBLOCKS} // ok ARect := Classes.Rect(0, 0, CalcBlockRowHdrsWidth, CalcGroupColHdrsHeight); {$ELSE} // remove // ARect := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight); {$ENDIF Jv_TIMEBLOCKS} agcTopRight: begin CornerLeft := Lesser(CellRect(RightCol, -1).Right, ClientWidth - FVScrollBar.Width); //group ARect := Classes.Rect(CornerLeft, 0, ClientWidth, ColHdrHeight); ARect := Classes.Rect(CornerLeft, 0, ClientWidth, CalcGroupColHdrsHeight); end; agcBottomLeft: {$IFDEF Jv_TIMEBLOCKS} // ok ARect := Classes.Rect(0, ClientHeight - FHScrollBar.Height, CalcBlockRowHdrsWidth, ClientHeight); {$ELSE} // remove // ARect := Classes.Rect(0, ClientHeight - FHScrollBar.Height, // RowHdrWidth, ClientHeight); {$ENDIF Jv_TIMEBLOCKS} agcBottomRight: ARect := Classes.Rect(ClientWidth - FVScrollBar.Width - 1, ClientHeight - FHScrollBar.Height - 1, ClientWidth, ClientHeight); end; with ACanvas do begin Brush.Color := HdrAttr.Color; FillRect(ARect); if HdrAttr.Frame3D then {$IFDEF Jv_TIMEBLOCKS} // ok DrawFrame(ACanvas, ARect, not ((Corner = agcTopLeft) and not HdrAttr.Frame3D), GridLineColor) {$ELSE} // remove //DrawFrame(ACanvas, ARect, // not ((Corner = agcTopLeft) and not HdrAttr.Frame3D)) {$ENDIF Jv_TIMEBLOCKS} else begin case Corner of agcTopLeft: if RowHdrType = rhFancy then begin Pen.Color := FancyRowHdrAttr.TickColor; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom - 1); MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); end else {$IFDEF Jv_TIMEBLOCKS} // ok DrawFrame(ACanvas, ARect, False, GridLineColor); {$ELSE} // remove //DrawFrame(ACanvas, ARect, False); {$ENDIF Jv_TIMEBLOCKS} agcTopRight: begin Pen.Color := clGray; MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); if VirtualCellRect(RightCol, -1).Right > ClientWidth - FVScrollBar.Width then begin MoveTo(ClientWidth - FVScrollBar.Width, ARect.Top); LineTo(ClientWidth - FVScrollBar.Width, ARect.Bottom - 1); end; end; agcBottomLeft: begin Pen.Color := clGray; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom); MoveTo(ARect.Left, ARect.Top); LineTo(ARect.Right - 1, ARect.Top); end; end; end; if Assigned(FOnDrawCorner) then FOnDrawCorner(Self, ACanvas, ARect, Corner); end; end; procedure TJvTFDays.DrawRowHdr(ACanvas: TCanvas; Index: Integer); var Rect: TRect; UseAttr: TJvTFDaysHdrAttr; Txt: string; begin {$IFDEF Jv_TIMEBLOCKS} // ok Rect.Left := CalcBlockHdrWidth; {$ELSE} // remove //Rect.Left := 0; {$ENDIF Jv_TIMEBLOCKS} //group Rect.Top := ColHdrHeight + (Index - TopRow) * RowHeight; Rect.Top := CalcGroupColHdrsHeight + (Index - TopRow) * RowHeight; {$IFDEF Jv_TIMEBLOCKS} // ok Rect.Right := Rect.Left + RowHdrWidth; {$ELSE} // remove //Rect.Right := RowHdrWidth; {$ENDIF Jv_TIMEBLOCKS} Rect.Bottom := Rect.Top + RowHeight; Txt := FormatDateTime(TimeFormat, RowToTime(Index)); if RowIsSelected(Index) then UseAttr := SelHdrAttr else UseAttr := HdrAttr; ACanvas.Brush.Color := UseAttr.Color; ACanvas.Font.Assign(UseAttr.Font); DrawTxt(ACanvas, Rect, Txt, taCenter, vaCenter); if (Index = FocusedRow) and Focused and ShowFocus then begin InflateRect(Rect, -2, -2); ManualFocusRect(ACanvas, Rect); InflateRect(Rect, 2, 2); end; {$IFDEF Jv_TIMEBLOCKS} // ok DrawFrame(ACanvas, Rect, UseAttr.Frame3D, UseAttr.FrameColor); {$ELSE} // remove //DrawFrame(ACanvas, ARect, UseAttr.Frame3D); {$ENDIF Jv_TIMEBLOCKS} if Assigned(FOnDrawRowHdr) then FOnDrawRowHdr(Self, ACanvas, Rect, Index, RowIsSelected(Index)); end; (* procedure TJvTFDays.DrawColHdr(ACanvas: TCanvas; Index: Integer); var ARect, TxtRect, CalcRect: TRect; Txt: string; PTxt: PChar; UseAttr: TJvTFDaysHdrAttr; Flags: UINT; TxtHt, TxtRectHt: Integer; begin ARect := CellRect(Index, -1); //Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title)); Txt := Cols[Index].Title; if ColIsSelected(Index) then UseAttr := SelHdrAttr else UseAttr := HdrAttr; ACanvas.Brush.Color := UseAttr.Color; ACanvas.Font.Assign(UseAttr.Font); Flags := DT_NOPREFIX or DT_CENTER; Case ColTitleStyle of ctsSingleClip : Flags := Flags or DT_SINGLELINE or DT_VCENTER; ctsSingleEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER; ctsMultiClip : Flags := Flags or DT_WORDBREAK; ctsMultiEllipsis : Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or DT_EDITCONTROL; ctsHide : Flags := Flags or DT_SINGLELINE or DT_VCENTER; end; ACanvas.FillRect(ARect); TxtRect := ARect; Windows.InflateRect(TxtRect, -2, -2); CalcRect := TxtRect; PTxt := StrNew(PChar(Txt)); if (ColTitleStyle = ctsMultiClip) or (ColTitleStyle = ctsMultiEllipsis) then begin TxtHt := Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT); if TxtHt < RectHeight(TxtRect) then begin // we need to vertically center the text TxtRectHt := RectHeight(TxtRect); TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2; TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom); end; end else if ColTitleStyle = ctsHide then begin Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT); if RectWidth(CalcRect) > RectWidth(TxtRect) then PTxt := ''; end; Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags); if (Index = FocusedCol) and Focused then begin CalcRect := ARect; Windows.InflateRect(CalcRect, -2, -2); ManualFocusRect(ACanvas, CalcRect); { if Windows.IsRectEmpty(TxtRect) then Windows.InflateRect(TxtRect, 5, 5); ManualFocusRect(ACanvas, TxtRect); } { end; DrawFrame(ACanvas, ARect, UseAttr.Frame3D); if Assigned(FOnDrawColHdr) then FOnDrawColHdr(Self, ACanvas, ARect, Index, ColIsSelected(Index)); end; *) // returns height in pixels of tallest col title // assumes word wrap and bounds all of title function TJvTFDays.GetTallestColTitle(ACanvas: TCanvas): Integer; var I, Tallest, ColLeft, TxtHt: Integer; LRect: TRect; TheCol: TJvTFDaysCol; Txt: string; Flags: UINT; begin {$IFDEF Jv_TIMEBLOCKS} // ok ColLeft := CalcBlockRowHdrsWidth; {$ELSE} // remove //ColLeft := RowHdrWidth; {$ENDIF Jv_TIMEBLOCKS} Tallest := 0; for I := 0 to Cols.Count - 1 do begin TheCol := Cols[I]; // (rom) silly assignments // Just set top (0), left, and bottom (ColHdrHeight) for now. //group ARect := Classes.Rect(ColLeft, 0, 0, ColHdrHeight); LRect := Classes.Rect(ColLeft, CalcGroupHdrHeight, 0, CalcGroupColHdrsHeight); // Set right by adding this col's width to the left value LRect.Right := LRect.Left + TheCol.Width; LRect := CellRect(I, -1); InflateRect(LRect, -2, -2); Txt := Copy(TheCol.Title, 1, Length(TheCol.Title)); if ColIsSelected(I) then begin ACanvas.Brush.Color := SelHdrAttr.Color; ACanvas.Font.Assign(SelHdrAttr.Font); end else begin ACanvas.Brush.Color := HdrAttr.Color; ACanvas.Font.Assign(HdrAttr.Font); end; // All parameters now specified. Now calc text height. Flags := DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_CALCRECT; TxtHt := DrawText(ACanvas.Handle, PChar(Txt), -1, LRect, Flags); if TxtHt > Tallest then Tallest := TxtHt; Inc(ColLeft, TheCol.Width); end; Result := Tallest; end; {$IFNDEF Jv_TIMEBLOCKS} // remove { procedure TJvTFDays.DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean); var OldPenColor: TColor; begin OldPenColor := ACanvas.Pen.Color; if Draw3D then ACanvas.Pen.Color := clBtnShadow else ACanvas.Pen.Color := GridLineColor; ACanvas.MoveTo(ARect.Right - 1, ARect.Top); ACanvas.LineTo(ARect.Right - 1, ARect.Bottom); ACanvas.MoveTo(ARect.Left, ARect.Bottom - 1); ACanvas.LineTo(ARect.Right, ARect.Bottom - 1); if Draw3D then begin ACanvas.Pen.Color := clBtnHighlight; ACanvas.MoveTo(ARect.Left, ARect.Top); ACanvas.LineTo(ARect.Right, ARect.Top); ACanvas.MoveTo(ARect.Left, ARect.Top); ACanvas.LineTo(ARect.Left, ARect.Bottom); end; ACanvas.Pen.Color := OldPenColor; end; } {$ENDIF !Jv_TIMEBLOCKS} procedure TJvTFDays.DrawAppts(ACanvas: TCanvas; DrawAll: Boolean); var FromCol, ToCol, FromRow, ToRow, Col, I: Integer; ApptStartRow, ApptEndRow, SchedDate: Integer; Appt: TJvTFAppt; TempSelAppt: TJvTFAppt; begin if DrawAll then begin FromCol := 0; ToCol := Cols.Count - 1; FromRow := 0; ToRow := RowCount - 1; end else begin FromCol := LeftCol; ToCol := RightCol; FromRow := TopRow; ToRow := BottomRow; end; for Col := FromCol to ToCol do if Cols[Col].Connected then begin TempSelAppt := nil; SchedDate := Trunc(Cols[Col].SchedDate); for I := 0 to Cols[Col].Schedule.ApptCount - 1 do begin Appt := Cols[Col].Schedule.Appts[I]; // Added by Mike 10/31/01 7:04pm - Happy Haloween!! // We want to draw the selected appt last. Check to see if the // current appt is selected, if so, save a reference in TempSelAppt // and then use TempSelAppt to draw the appt after the loop finishes. // This solves the problem of having the bottom grab handle // overwritten by an appt that lies immediately below the sel appt. if Appt = SelAppt then TempSelAppt := Appt else begin CalcStartEndRows(Appt, SchedDate, ApptStartRow, ApptEndRow); if (ApptStartRow <= ToRow) and (ApptEndRow >= FromRow) then DrawAppt(ACanvas, Col, Appt, ApptStartRow, ApptEndRow); end; end; // Added by Mike 10/31/01 7:04 pm - see above if Assigned(TempSelAppt) then begin CalcStartEndRows(TempSelAppt, SchedDate, ApptStartRow, ApptEndRow); if (ApptStartRow <= ToRow) and (ApptEndRow >= FromRow) then DrawAppt(ACanvas, Col, TempSelAppt, ApptStartRow, ApptEndRow); end; end; end; procedure TJvTFDays.AdjustForMargins(var ARect: TRect); begin // Make room for side margins and grab handles // Changed by TIM: // Windows.InflateRect(ARect, -2, -2); InflateRect(ARect, -1, -1); // Commented out by Tim: // if agoMoveAppt in Options then // Inc(ARect.Top, GrabHandles.Height - 1); // if agoSizeAppt in Options then // Dec(ARect.Bottom, GrabHandles.Height - 1); end; procedure TJvTFDays.CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect; PicsHeight: Integer; out CanDrawText, CanDrawPics: Boolean); //var // TextHeightThreshold, // TextWidthThreshold: Integer; begin // TextHeightThreshold := CanvasMaxTextHeight(ACanvas) * Thresholds.TextHeight; // TextWidthThreshold := ACanvas.TextWidth('Bi') div 2 * Thresholds.TextWidth; // if TextHeightThreshold + PicsHeight < RectHeight(ApptRect) then // begin // CanDrawText := RectWidth(ApptRect) >= TextWidthThreshold; // CanDrawPics := True; // end // else // if Thresholds.DropTextFirst then // begin // CanDrawText := False; // CanDrawPics := True; // if Thresholds.WholePicsOnly then // if PicsHeight > RectHeight(ApptRect) then // CanDrawPics := False; // end // else // begin // CanDrawText := (RectHeight(ApptRect) >= TextHeightThreshold) and // (RectWidth(ApptRect) >= TextWidthThreshold); // CanDrawPics := False; // end; CanDrawText := True; CanDrawPics := True; if not (agoShowPics in Options) then CanDrawPics := False; if not (agoShowText in Options) then CanDrawText := False; end; procedure TJvTFDays.ManualFocusRect(ACanvas: TCanvas; ARect: TRect); var Mark: Boolean; I: Integer; OldPenMode: TPenMode; begin OldPenMode := ACanvas.Pen.Mode; ACanvas.Pen.Mode := pmNot; Mark := True; // Top side for I := ARect.Left to ARect.Right - 1 do begin if Mark then ACanvas.Pixels[I, ARect.Top] := clBlack; Mark := not Mark; end; // Right side for I := ARect.Top + 1 to ARect.Bottom - 1 do begin if Mark then ACanvas.Pixels[ARect.Right - 1, I] := clBlack; Mark := not Mark; end; // Bottom side for I := ARect.Right - 2 downto ARect.Left do begin if Mark then ACanvas.Pixels[I, ARect.Bottom - 1] := clBlack; Mark := not Mark; end; // Left side for I := ARect.Bottom - 2 downto ARect.Top + 1 do begin if Mark then ACanvas.Pixels[ARect.Left, I] := clBlack; Mark := not Mark; end; ACanvas.Pen.Mode := OldPenMode; end; procedure TJvTFDays.DrawFancyRowHdrs(ACanvas: TCanvas); var I, J, MajorTickLength, MinorTickLength, TickLength: Integer; LRect: TRect; Lbl: string; PrevHour, CurrentHour: Word; // FirstMajor, Selected, PrevHrSel, CurrHrSel, Switch: Boolean; begin MajorTickLength := GetMajorTickLength; MinorTickLength := GetMinorTickLength; // FirstMajor := True; PrevHour := RowToHour(TopRow); PrevHrSel := False; CurrHrSel := False; for I := TopRow to BottomRow do begin CurrentHour := RowToHour(I); Switch := (CurrentHour <> PrevHour) or (I = BottomRow); if Switch then begin PrevHrSel := CurrHrSel; CurrHrSel := False; end; // Determine if this row is selected Selected := False; J := 0; while (J < Cols.Count) and not Selected do if CellIsSelected(Point(J, I)) then Selected := True else Inc(J); CurrHrSel := CurrHrSel or Selected; LRect := CellRect(-1, I); Lbl := GetMinorLabel(I); if not RowEndsHour(I) then TickLength := MinorTickLength else TickLength := MajorTickLength; DrawMinor(ACanvas, LRect, I, Lbl, TickLength, Selected); // Draw Major if needed if Switch and (Granularity <> 60) then begin if I <> TopRow + 1 then begin {$IFDEF Jv_TIMEBLOCKS} // ok LRect.Left := CalcBlockHdrWidth; LRect.Right := LRect.Left + RowHdrWidth - MinorTickLength; {$ELSE} // remove //LRect.Left := 0; //LRect.Right := RowHdrWidth - MinorTickLength; {$ENDIF Jv_TIMEBLOCKS} LRect.Top := VirtualCellRect(-1, HourStartRow(PrevHour)).Top; //group if LRect.Top < ColHdrHeight then //group LRect.Top := ColHdrHeight; if LRect.Top < CalcGroupColHdrsHeight then LRect.Top := CalcGroupColHdrsHeight; LRect.Bottom := VirtualCellRect(-1, HourEndRow(PrevHour)).Bottom - 1; if LRect.Bottom > ClientHeight then LRect.Bottom := ClientHeight; if FancyRowHdrAttr.Hr2400 then Lbl := IntToStr(PrevHour) else begin if PrevHour = 0 then Lbl := '12' else if PrevHour > 12 then Lbl := IntToStr(PrevHour - 12) else Lbl := IntToStr(PrevHour); if (PrevHour = 0) or (PrevHour = 12) then if PrevHour < 12 then Lbl := Lbl + 'a' else Lbl := Lbl + 'p'; end; if PrevHrSel then ACanvas.Font.Assign(SelFancyRowHdrAttr.MajorFont) else ACanvas.Font.Assign(FancyRowHdrAttr.MajorFont); ACanvas.Brush.Style := bsClear; DrawText(ACanvas.Handle, PChar(Lbl), -1, LRect, DT_NOPREFIX or DT_SINGLELINE or DT_CENTER or DT_VCENTER); if Assigned(FOnDrawMajorRowHdr) then FOnDrawMajorRowHdr(Self, ACanvas, LRect, I - 1, PrevHrSel); // FirstMajor := False; end; if Switch then PrevHour := CurrentHour; end; end; end; procedure TJvTFDays.DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer; const LabelStr: string; TickLength: Integer; Selected: Boolean); var Attr: TJvTFDaysFancyRowHdrAttr; MinorRect, TxtRect: TRect; begin // do the background shading ACanvas.Brush.Color := FancyRowHdrAttr.Color; ACanvas.FillRect(ARect); MinorRect := ARect; MinorRect.Left := MinorRect.Right - GetMinorTickLength; if Selected then begin Attr := SelFancyRowHdrAttr; // Shade the minor rect if selected ACanvas.Brush.Color := Attr.Color; ACanvas.FillRect(MinorRect); end else Attr := FancyRowHdrAttr; with ACanvas do begin // draw the right border line Pen.Color := Attr.TickColor; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom); // now draw the tick MoveTo(ARect.Right - 5, ARect.Bottom - 1); LineTo(ARect.Right - 5 - TickLength, ARect.Bottom - 1); end; // set up a 2 pel margin on the right and bottom sides TxtRect := ARect; TxtRect.Right := TxtRect.Right - 6; TxtRect.Bottom := TxtRect.Bottom - 2; // now draw the LabelStr right aligned ACanvas.Brush.Style := bsClear; ACanvas.Font.Assign(Attr.MinorFont); // draw the focus rect if needed if (RowNum = FocusedRow) and Focused and ShowFocus and (LabelStr <> '') then begin MinorRect := TxtRect; InflateRect(MinorRect, 0, -1); inc(MinorRect.Right, 2); MinorRect.Left := TxtRect.Right - ACanvas.TextWidth(LabelStr) - 2; ManualFocusRect(ACanvas, MinorRect); end; DrawText(ACanvas.Handle, PChar(LabelStr), -1, TxtRect, DT_SINGLELINE or DT_RIGHT or DT_NOPREFIX or DT_VCENTER); if Assigned(FOnDrawMinorRowHdr) then FOnDrawMinorRowHdr(Self, ACanvas, ARect, RowNum, Selected); end; function TJvTFDays.GetMinorLabel(RowNum: Integer): string; const Full24 = 'h:nn'; FullAP = 'h:nna/p'; MinOnly = 'nn'; var FirstHourRow: Integer; TimeFmt: string; RowTime: TTime; // LastFullRow, LastHourStart: Integer; // LastHour: Word; begin if Granularity = 60 then begin if FancyRowHdrAttr.Hr2400 then TimeFmt := Full24 else TimeFmt := FullAP end else TimeFmt := MinOnly; // else // if (RowNum = TopRow) and (not RowStartsHour(RowNum) or (PossVisibleRows = 1)) then // TimeFmt := Full24 // else // begin // LastFullRow := TopRow + FullVisibleRows - 1; // LastHour := RowToHour(LastFullRow); // LastHourStart := HourStartRow(LastHour); // // if (RowNum = LastHourStart) or // ((LastHourStart = TopRow) and (RowNum = TopRow)) then // TimeFmt := Full24 // else // TimeFmt := MinOnly; // end; // Get the Row Time RowTime := RowToTime(RowNum); if (FancyRowHdrAttr.OnlyShow00Minutes and (ExtractMins(RowTime) = 0)) or (not FancyRowHdrAttr.OnlyShow00Minutes) then begin if (not FancyRowHdrAttr.Hr2400) and (Granularity < 60) then begin // Get the first row with a 00 hour FirstHourRow := TopRow; while (FirstHourRow < BottomRow) and (ExtractMins(RowToTime(FirstHourRow)) <> 0) do Inc(FirstHourRow); if RowTime = 0 then Result := FormatSettings.TimeAMString else if RowTime = 0.50 then Result := FormatSettings.TimePMString else if (RowNum = FirstHourRow) and (ExtractMins(RowTime) = 0) then begin if RowTime < 0.50 then Result := FormatSettings.TimeAMString else Result := FormatSettings.TimePMString; end else Result := FormatDateTime(TimeFmt, RowTime); end else Result := FormatDateTime(TimeFmt, RowTime); end else Result := ''; end; function TJvTFDays.GetMinorTickLength: Integer; var TempFont: TFont; begin TempFont := TFont.Create; try TempFont.Assign(Canvas.Font); Canvas.Font.Assign(FancyRowHdrAttr.MinorFont); Result := Canvas.TextWidth('00') + 6; Canvas.Font.Assign(TempFont); finally TempFont.Free; end; end; function TJvTFDays.GetMajorTickLength: Integer; begin Result := RowHdrWidth - 8; end; procedure TJvTFDays.Resize; var ColsResized: Boolean; begin if Editing then FinishEditAppt; AlignScrollBars; if not (csLoading in ComponentState) then begin if RowHeight > GetDataHeight then RowHeight := GetDataHeight; Cols.EnsureMaxColWidth; if AutoSizeCols then begin ColsResized := CheckSBVis; if not (vsbHorz in VisibleScrollBars) and not ColsResized then Cols.ResizeCols; end else CheckSBVis; end; CheckSBParams; inherited Resize; end; procedure TJvTFDays.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := LRESULT(False); end; procedure TJvTFDays.CMFontChanged(var Msg: TLMessage); begin HdrAttr.ParentFontChanged; SelHdrAttr.ParentFontChanged; ApptAttr.ParentFontChanged; SelApptAttr.ParentFontChanged; inherited; end; procedure TJvTFDays.CMEnabledChanged(var Msg: TLMessage); begin FVScrollBar.Enabled := Enabled; FHScrollBar.Enabled := Enabled; Invalidate; if Enabled and FNeedCheckSBParams then begin // This is needed because of a TScrollBar bug. If the Max or LargeChange // properties are changed while the scrollbar is disabled, the // scrollbar will magically enable itself. Very frustrating. Anyway... // This check and call to CheckSBParams will work around the problem. // See TJvTFDays.CheckSBParams for other part of workaround. FNeedCheckSBParams := False; CheckSBParams; end; end; procedure TJvTFDays.WMSetCursor(var Msg: TLMSetCursor); var Cur: HCURSOR; Coord: TJvTFDaysCoord; begin exit; Cur := 0; with Msg do if HitTest = HTCLIENT then begin Coord := PtToCell(FHitTest.X, FHitTest.Y); case CanDragWhat(Coord) of agsSizeCol, agsSizeRowHdr: Cur := Screen.Cursors[crHSplit]; agsSizeRow, agsSizeColHdr: Cur := Screen.Cursors[crVSplit]; agsSizeAppt: Cur := Screen.Cursors[crSizeNS]; agsMoveAppt: Cur := Screen.Cursors[crDrag]; end; end; if Cur <> 0 then SetCursor(Cur) else inherited; end; procedure TJvTFDays.WMNCHitTest(var Msg: TLMNCHitTest); begin DefaultHandler(Msg); FHitTest := ScreenToClient(SmallPointToPoint(Msg.Pos)); end; procedure TJvTFDays.CMDesignHitTest(var Msg: TCMDesignHitTest); var TempState: TJvTFDaysState; Coord: TJvTFDaysCoord; begin Coord := PtToCell(Msg.Pos.X, Msg.Pos.Y); TempState := CanDragWhat(Coord); Msg.Result := LRESULT(Ord(TempState <> agsNormal)); end; procedure TJvTFDays.CNRequestRefresh(var Msg: TCNRequestRefresh); var I: Integer; begin for I := 0 to Cols.Count - 1 do if (Cols[I].Schedule = Msg.Schedule) or (Msg.Schedule = nil) then Cols[I].RefreshMap; inherited; end; procedure TJvTFDays.Loaded; var I: Integer; begin FHScrollBar.Position := LeftCol; FVScrollBar.Position := TopRow; inherited Loaded; CheckSBVis; CheckSBParams; Template.UpdateGrid; Cols.FOldCount := Cols.Count; for I := 0 to Cols.Count - 1 do Cols[I].Connect; AlignScrollBars; end; procedure TJvTFDays.RefreshControl; var I: Integer; begin for I := 0 to Cols.Count - 1 do // Should do some additional checking here (which is commented out) //if (Cols[I].Schedule = Msg.Schedule) or (Msg.Schedule = nil) then Cols[I].RefreshMap; inherited RefreshControl; end; procedure TJvTFDays.UpdateDesigner; var ParentForm: TCustomForm; begin if (csDesigning in ComponentState) and HandleAllocated and not (csUpdating in ComponentState) then begin ParentForm := GetParentForm(Self); if Assigned(ParentForm) and Assigned(ParentForm.Designer) then ParentForm.Designer.Modified; end; end; procedure TJvTFDays.CheckSBParams; var I, TempWidth, lRightCol: Integer; begin if not Enabled then begin // This is needed because of a TScrollBar bug. if the Max or LargeChange // properties are changed while the scrollbar is disabled, the // scrollbar will magically enable itself. Very frustrating. Anyway... // This check and exit will workaround the problem. // See TJvTFDays.CMEnabledChanged for other part of workaround. FNeedCheckSBParams := True; Exit; end; if vsbVert in VisibleScrollBars then with FVScrollBar do begin Max := RowCount - FullVisibleRows; //RowCount - 2; LargeChange := FullVisibleRows; end; if vsbHorz in VisibleScrollBars then with FHScrollBar do begin Max := Cols.Count - 1; lRightCol := LeftCol + VisibleCols - 1; TempWidth := 0; for I := LeftCol to lRightCol do Inc(TempWidth, Cols[I].Width); if TempWidth <= RectWidth(GetDataAreaRect) then LargeChange := VisibleCols else LargeChange := VisibleCols - 1; end; end; procedure TJvTFDays.ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); var SB: TJvTFDaysScrollBar; I, TempWidth: Integer; begin if csLoading in ComponentState then Exit; if not (csDesigning in ComponentState) then SetFocus; if Editing then FinishEditAppt; SB := TJvTFDaysScrollBar(Sender); case ScrollCode of scLineUp, scLineDown, scPageUp, scPageDown, scTrack: if SB.Kind = sbVertical then begin if (ScrollCode = scLineDown) or (ScrollCode = scPageDown) then ScrollPos := Lesser(ScrollPos, RowCount - FullVisibleRows); TopRow := ScrollPos; UpdateDesigner; end else begin if ScrollPos > LeftCol then begin TempWidth := 0; for I := LeftCol to Cols.Count - 1 do Inc(TempWidth, Cols[I].Width); if TempWidth <= GetDataWidth then ScrollPos := LeftCol; end; LeftCol := ScrollPos; UpdateDesigner; end; end; end; procedure TJvTFDays.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var GridCoord: TJvTFDaysCoord; DragWhat: TJvTFDaysState; begin if not Enabled then Exit; FHint.ReleaseHandle; inherited; if ssDouble in Shift then Exit; if not (csDesigning in ComponentState) then SetFocus; GridCoord := PtToCell(X, Y); if ssLeft in Shift then with GridCoord do begin SetSelAppt(Appt); // need to recalculate GridCoord here because component user may have // freed the appt (esp. in a multi-user environment). GridCoord := PtToCell(X, Y); if Col > gcHdr then FocusedCol := Col; if Row > gcHdr then FocusedRow := Row; if (Col > gcHdr) and (Row > gcHdr) then SelStart := Point(Col, Row) else if (Col = gcHdr) and (Row > gcHdr) then SelStart := Point(FocusedCol, Row) else if (Col > gcHdr) and (Row = gcHdr) then SelStart := Point(Col, FocusedRow); end; if (State = agsNormal) and (ssLeft in Shift) then begin DragWhat := CanDragWhat(GridCoord); case DragWhat of agsSizeCol, agsSizeRow, agsSizeColHdr, agsSizeRowHdr, agsMoveCol, agsSizeAppt: BeginDragging(GridCoord, DragWhat, GridCoord.Appt); agsMoveAppt: BeginDrag(False); agsNormal: if Assigned(SelAppt) then EditAppt(GridCoord.Col, SelAppt); end; if DragWhat in [agsSizeAppt, agsMoveAppt, agsNormal] then begin FAutoScrollDir := asdNowhere; FLiveTimer := True; SetTimer(Handle, 1, 60, nil); end; end; end; procedure TJvTFDays.MouseMove(Shift: TShiftState; X, Y: Integer); var GridCoord: TJvTFDaysCoord; AutoScrollMargin: TRect; SelStartDate, SelEndDate: TDate; SelStartTime, SelEndTime: TTime; OldFSelEnd, HintTopLeft: TPoint; FSelEndChanged: Boolean; procedure UpdateAutoScroll; begin AutoScrollMargin := GetDataAreaRect; //Windows.InflateRect(AutoScrollMargin, -10, -10); if Y < AutoScrollMargin.Top then FAutoScrollDir := asdUp else if Y > AutoScrollMargin.Bottom then FAutoScrollDir := asdDown else if X < AutoScrollMargin.Left then FAutoScrollDir := asdLeft else if X > AutoScrollMargin.Right then FAutoScrollDir := asdRight else FAutoScrollDir := asdNowhere; end; begin if not Enabled then Exit; inherited MouseMove(Shift, X, Y); GridCoord := PtToCell(X, Y); if State = agsNormal then if Assigned(GridCoord.Appt) then DoApptHint(GridCoord) else DoCellHint(GridCoord); if not Focused and not (csDesigning in ComponentState) then Exit; FMouseMovePt := Point(X, Y); FMouseMoveState := Shift; case State of agsNormal: if ssLeft in Shift then begin with GridCoord do begin if Col > gcHdr then FocusedCol := Col else FocusedCol := LeftCol; if Row > gcHdr then FocusedRow := Lesser(Row, Lesser(RowCount - 1, BottomRow + 1)) else if FAutoScrollDir = asdDown then FocusedRow := RowCount - 1 else FocusedRow := TopRow; end; OldFSelEnd := FSelEnd; SelEnd := Point(FocusedCol, FocusedRow); FSelEndChanged := (OldFSelEnd.X <> FSelEnd.X) or (OldFSelEnd.Y <> FSelEnd.Y); if (agoShowSelHint in Options) and (SelStart.X > gcHdr) and (SelStart.Y > gcHdr) and (SelEnd.X > gcHdr) and (SelEnd.Y > gcHdr) and ((SelStart.X <> SelEnd.X) or (SelStart.Y <> SelEnd.Y)) then begin HintTopLeft := CellRect(GridCoord.Col, GridCoord.Row).TopLeft; if FSelEndChanged then begin SelStartDate := Cols[SelStart.X].SchedDate; SelStartTime := RowToTime(SelStart.Y); SelEndDate := Cols[SelEnd.X].SchedDate; SelEndTime := RowToTime(SelEnd.Y) + EncodeTime(0, Granularity - 1, 0, 0); FHint.StartEndHint(SelStartDate, SelEndDate, SelStartTime, SelEndTime, HintTopLeft.X, HintTopLeft.Y, True); end end else FHint.ReleaseHandle; UpdateAutoScroll; end; agsSizeCol..agsMoveCol: ContinueDragging(GridCoord, nil); agsSizeAppt: begin UpdateAutoScroll; if Y > GetDataAreaRect.Bottom then GridCoord.Row := Lesser(BottomRow + 1, RowCount - 1); if FAutoScrollDir = asdNowhere then ContinueDragging(GridCoord, nil); end; end; end; procedure TJvTFDays.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var GridCoord: TJvTFDaysCoord; begin if not Enabled then Exit; inherited MouseUp(Button, Shift, X, Y); if not Focused and not (csDesigning in ComponentState) then Exit; KillAutoScrollTimer; GridCoord := PtToCell(X, Y); case State of agsSizeCol..agsSizeAppt: EndDragging(GridCoord, nil); agsNormal: FHint.ReleaseHandle; end; end; procedure TJvTFDays.DblClick; begin if Editing then FinishEditAppt; inherited DblClick; end; procedure TJvTFDays.DoStartDrag(var DragObject: TDragObject); begin if Editing then FinishEditAppt; inherited DoStartDrag(DragObject); FDragInfo.Appt := SelAppt; if FocusedCol > gcHdr then FDragInfo.Schedule := Cols[FocusedCol].Schedule; end; procedure TJvTFDays.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var GridCoord: TJvTFDaysCoord; Appt: TJvTFAppt; SrcDragInfo: TJvTFDragInfo; AutoScrollMargin: TRect; procedure UpdateAutoScroll; begin AutoScrollMargin := GetDataAreaRect; InflateRect(AutoScrollMargin, -10, -10); if Y < AutoScrollMargin.Top then FAutoScrollDir := asdUp else if Y > AutoScrollMargin.Bottom then FAutoScrollDir := asdDown else if X < AutoScrollMargin.Left then FAutoScrollDir := asdLeft else if X > AutoScrollMargin.Right then FAutoScrollDir := asdRight else FAutoScrollDir := asdNowhere; end; begin inherited DragOver(Source, X, Y, State, Accept); if Source is TJvTFControl then begin SrcDragInfo := TJvTFControl(Source).DragInfo; GridCoord := PtToCell(X, Y); Accept := GridCoord.DragAccept; Appt := SrcDragInfo.Appt; case State of dsDragEnter: begin if not Assigned(FDragInfo) then FDragInfo := SrcDragInfo; BeginDragging(GridCoord, agsMoveAppt, Appt); end; dsDragLeave: begin EndDragging(GridCoord, Appt); if FDragInfo.ApptCtrl <> Self then FDragInfo := nil; end; dsDragMove: begin FMouseMovePt := Point(X, Y); UpdateAutoScroll; if Y > GetDataAreaRect.Bottom then GridCoord.Row := Lesser(BottomRow + 1, RowCount - 1); if FAutoScrollDir = asdNowhere then ContinueDragging(GridCoord, Appt); end; end; end; end; procedure TJvTFDays.DoEndDrag(Target: TObject; X, Y: Integer); begin KillAutoScrollTimer; FState := agsNormal; inherited DoEndDrag(Target, X, Y); end; procedure TJvTFDays.DropAppt(ADragInfo: TJvTFDragInfo; X, Y: Integer); const cClassName = 'TJvTFCustomGlance'; var Appt: TJvTFAppt; Coord: TJvTFDaysCoord; Confirm, SchedNameChange, StartDateChange, Share: Boolean; NewSchedName: string; NewStartDate, NewEndDate: TDate; NewStartTime: TTime; NewEndTime: TDateTime; NewStartDT, NewEndDT: TDateTime; begin FHint.ReleaseHandle; // APPOINTMENT CAN ONLY BE DROPPED IN THE DATA AREA !!! Appt := ADragInfo.Appt; // Calc new info // DragAppt.Shift --> Ctrl = share, Shift = keep dates, Alt = keep times Coord := PtToCell(X, Y); NewSchedName := Cols[Coord.Col].SchedName; CalcMoveStartEnd(Appt, Coord, ssShift in ADragInfo.Shift, ssAlt in ADragInfo.Shift, NewStartDT, NewEndDT); NewStartDate := Trunc(NewStartDT); NewStartTime := Frac(NewStartDT); NewEndDate := Trunc(NewEndDT); NewEndTime := Frac(NewEndDT); // Do a confirm drop event Confirm := True; if Assigned(FOnDropAppt) then FOnDropAppt(Appt, NewSchedName, NewStartDate, NewStartTime, NewEndDate, NewEndTime, ssCtrl in ADragInfo.Shift, Confirm); if Confirm then begin //SchedNameChange := NewSchedName <> ADragInfo.Schedule.SchedName; SchedNameChange := IsClassByName(ADragInfo.ApptCtrl, cClassName) or (NewSchedName <> ADragInfo.Schedule.SchedName); StartDateChange := (Trunc(NewStartDate) <> Trunc(Appt.StartDate)) or (Trunc(NewEndDate) <> Trunc(Appt.EndDate)); Share := ssCtrl in ADragInfo.Shift; Appt.BeginUpdate; try if (SchedNameChange and not StartDateChange and not Share) or (not SchedNameChange and StartDateChange and not Share) or (SchedNameChange and StartDateChange and not Share) or (not SchedNameChange and StartDateChange and Share) or (SchedNameChange and StartDateChange and Share) then begin if ADragInfo.ApptCtrl is TJvTFDays then Appt.RemoveSchedule(ADragInfo.Schedule.SchedName) else if IsClassByName(ADragInfo.ApptCtrl, cClassName) then Appt.ClearSchedules; // THE FOLLOWING CODE SHOULD NOT BE NECESSARY. // Make sure the old schedules get refreshed { aDate := Appt.StartDate; while Trunc(aDate) <= Trunc(Appt.EndDate) do begin Sched := ScheduleManager.FindSchedule(ADragInfo.Schedule.SchedName, aDate); if Assigned(Sched) then ScheduleManager.RefreshConnections(Sched); aDate := aDate + 1; end; } end; // Now we set the new StartEnd Appt.SetStartEnd(NewStartDate, NewStartTime, NewEndDate, NewEndTime); // if there's a change in SchedName then add the appt to the schedule Appt.AddSchedule(NewSchedName); // THE FOLLOWING CODE SHOULD NOT BE NECESSARY. //ScheduleManager.RefreshConnections(Appt); finally Appt.EndUpdate; end; end; if ADragInfo.ApptCtrl <> Self then FState := agsNormal; end; procedure TJvTFDays.BeginDragging(Coord: TJvTFDaysCoord; DragWhat: TJvTFDaysState; Appt: TJvTFAppt); begin Update; FState := DragWhat; FBeginDraggingCoord := Coord; FDraggingCoord := Coord; if (State <> agsMoveAppt) or Coord.DragAccept then DrawDrag(Coord, Appt, False); end; procedure TJvTFDays.DrawDrag(Coord: TJvTFDaysCoord; AAppt: TJvTFAppt; AClear: Boolean); var OldPen: TPen; DragRect: TRect; I, LineLeft, StartRow, EndRow, DragRectHt: Integer; Sched: TJvTFSched; StartDT, EndDT: TDateTime; SchedName: string; procedure InternalDrawFrame(ARect: TRect); begin Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Right - 2, ARect.Top); Canvas.LineTo(ARect.Right - 2, ARect.Bottom - 2); Canvas.LineTo(ARect.Left, ARect.Bottom - 2); Canvas.LineTo(ARect.Left, ARect.Top); end; begin if ((State = agsSizeAppt) and not Assigned(Coord.Schedule)) or ((State = agsMoveAppt) and ((Coord.Row < 0) or (Coord.Col < 0))) then Exit; OldPen := TPen.Create; try with Canvas, Coord do begin OldPen.Assign(Pen); Pen.Style := psDot; Pen.Mode := pmXOR; Pen.Width := 1; case State of agsSizeCol, agsSizeRowHdr: begin MoveTo(AbsX, 0); LineTo(AbsX, ClientHeight); end; agsSizeRow, agsSizeColHdr: begin MoveTo(0, AbsY); LineTo(ClientWidth, AbsY); end; agsMoveCol: begin Pen.Mode := pmNotXOR; Pen.Style := psSolid; Pen.Width := 3; LineLeft := AbsX - CellX; if FDraggingCoord.Col > FBeginDraggingCoord.Col then Inc(LineLeft, Cols[FDraggingCoord.Col].Width); MoveTo(LineLeft, 0); LineTo(LineLeft, ClientHeight); end; agsSizeAppt: begin Pen.Style := psSolid; Pen.Mode := pmNotXOR; AAppt := FBeginDraggingCoord.Appt; CalcSizeEndTime(AAppt, EndDT); if AClear and FHint.HandleAllocated then begin FHint.ReleaseHandle; // Control must be updated here. if not, drag lines will // not be drawn properly. Update; end; SchedName := Coord.Schedule.SchedName; for I := 0 to Cols.Count - 1 do begin Sched := Cols[I].Schedule; if Assigned(Sched) and (Sched.SchedName = SchedName) and ((Trunc(Sched.SchedDate) >= Trunc(AAppt.StartDate)) and (Trunc(Sched.SchedDate) <= Trunc(EndDT))) then begin //Calc Start and end rows if Trunc(Sched.SchedDate) = Trunc(AAppt.StartDate) then StartRow := TimeToRow(AAppt.StartTime) else StartRow := 0; if Trunc(Sched.SchedDate) = Trunc(EndDT) then EndRow := TimeToRow(AdjustEndTime(EndDT)) else EndRow := RowCount - 1; DragRectHt := (EndRow - StartRow + 1) * RowHeight; DragRect := VirtualCellRect(I, StartRow); DragRect.Bottom := DragRect.Top + DragRectHt; DragRect.Top := Greater(DragRect.Top, GetDataAreaRect.Top); DragRect.Bottom := Lesser(DragRect.Bottom, GetDataAreaRect.Bottom); InternalDrawFrame(DragRect); end; end; if not AClear and (agoShowApptHints in Options) then FHint.StartEndHint(AAppt.StartDate, Trunc(EndDT), AAppt.StartTime, Frac(EndDT), DragRect.Left + 2, DragRect.Bottom + 2, True); end; agsMoveAppt: begin Pen.Style := psSolid; Pen.Mode := pmNotXOR; Coord.Row := Greater(0, Greater(Coord.Row, TopRow - 1)); CalcMoveStartEnd(AAppt, Coord, ssShift in FDragInfo.Shift, ssAlt in FDragInfo.Shift, StartDT, EndDT); if AClear and FHint.HandleAllocated then begin FHint.ReleaseHandle; Update; end; if Assigned(Coord.Schedule) then SchedName := Coord.Schedule.SchedName; DragRect := Classes.Rect(-1, -1, -1, -1); // Used to not show hint if outside a valid day. for I := 0 to Cols.Count - 1 do begin Sched := Cols[I].Schedule; if Assigned(Sched) and (Sched.SchedName = SchedName) and ((Trunc(Sched.SchedDate) >= Trunc(StartDT)) and (Trunc(Sched.SchedDate) <= Trunc(EndDT))) then begin //Calc Start and end rows if Trunc(Sched.SchedDate) = Trunc(StartDT) then StartRow := TimeToRow(StartDT) else StartRow := 0; if Trunc(Sched.SchedDate) = Trunc(EndDT) then EndRow := TimeToRow(AdjustEndTime(EndDT)) else EndRow := RowCount - 1; DragRectHt := (EndRow - StartRow + 1) * RowHeight; DragRect := VirtualCellRect(I, StartRow); DragRect.Bottom := DragRect.Top + DragRectHt; DragRect.Top := Greater(DragRect.Top, GetDataAreaRect.Top); InternalDrawFrame(DragRect); end; end; if not AClear and (agoShowApptHints in Options) and (DragRect.Top <> -1) and (DragRect.Left <> -1) and (DragRect.Right <> -1) and (DragRect.Bottom <> -1) then FHint.StartEndHint(Trunc(StartDT), Trunc(EndDT), Frac(StartDT), Frac(EndDT), DragRect.Right + 2, DragRect.Top + 2, True); end; end; end; finally Canvas.Pen.Assign(OldPen); OldPen.Free; end; end; procedure TJvTFDays.ContinueDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt); var ValidDrag, SameSchedName, ValidEnd, DiffCoord: Boolean; SameDateLaterTime, LaterDate, DoDrawDrag: Boolean; OldLeft, NewLeft: Integer; begin if State = agsSizeAppt then begin Coord.Row := Greater(Coord.Row, TopRow); Coord.Row := Lesser(Coord.Row, BottomRow); end; DoDrawDrag := False; case State of agsSizeCol, agsSizeRowHdr, agsSizeRow, agsSizeColHdr: DoDrawDrag := True; agsMoveCol: begin OldLeft := FDraggingCoord.AbsX - FDraggingCoord.CellX; NewLeft := Coord.AbsX - Coord.CellX; DoDrawDrag := (OldLeft <> NewLeft) and (Coord.Row = gcHdr) and (Coord.Col > gcHdr); end; agsSizeAppt: begin SameSchedName := False; ValidEnd := False; DiffCoord := False; ValidDrag := Assigned(FBeginDraggingCoord.Schedule) and Assigned(FDraggingCoord.Schedule) and Assigned(Coord.Schedule); if ValidDrag then begin SameSchedName := FDraggingCoord.Schedule.SchedName = FBeginDraggingCoord.Schedule.SchedName; LaterDate := (Trunc(Coord.Schedule.SchedDate) > Trunc(FBeginDraggingCoord.Appt.StartDate)) and (Coord.Row >= 0); SameDateLaterTime := (Trunc(Coord.Schedule.SchedDate) = Trunc(FBeginDraggingCoord.Appt.StartDate)) and (Coord.Row >= TimeToRow(FBeginDraggingCoord.Appt.StartTime)); ValidEnd := LaterDate or SameDateLaterTime; DiffCoord := not ((Coord.Row = FDraggingCoord.Row) and (Coord.Col = FDraggingCoord.Col)); end; DoDrawDrag := ValidDrag and SameSchedName and ValidEnd and DiffCoord; end; agsMoveAppt: DoDrawDrag := (Coord.Col <> FDraggingCoord.Col) or (Coord.Row <> FDraggingCoord.Row); end; if DoDrawDrag then begin if (State <> agsMoveAppt) or FDraggingCoord.DragAccept then DrawDrag(FDraggingCoord, Appt, True); // clear old line FDraggingCoord := Coord; if (State <> agsMoveAppt) or FDraggingCoord.DragAccept then DrawDrag(FDraggingCoord, Appt, False); // draw new line end; end; procedure TJvTFDays.EndDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt); var Confirm: Boolean; ColNum, DeltaSize, NewSize: Integer; NewEndDT: TDateTime; begin Confirm := True; try if (State <> agsMoveAppt) or FDraggingCoord.DragAccept then DrawDrag(FDraggingCoord, Appt, True); // clear old line case State of agsSizeCol: begin ColNum := FBeginDraggingCoord.Col; DeltaSize := Coord.AbsX - FBeginDraggingCoord.AbsX; NewSize := Cols[ColNum].Width + DeltaSize; if Assigned(FOnSizeCol) then FOnSizeCol(Self, ColNum, NewSize, Confirm); if Confirm then begin Cols[ColNum].Width := NewSize; UpdateDesigner; end; end; agsSizeRow: begin DeltaSize := Coord.AbsY - FBeginDraggingCoord.AbsY; NewSize := RowHeight + DeltaSize; if Assigned(FOnSizeRow) then FOnSizeRow(Self, 0, NewSize, Confirm); if Confirm then begin RowHeight := NewSize; UpdateDesigner; end; end; agsSizeColHdr: begin DeltaSize := Coord.AbsY - FBeginDraggingCoord.AbsY; NewSize := ColHdrHeight + DeltaSize; if Assigned(FOnSizeColHdr) then FOnSizeColHdr(Self, 0, NewSize, Confirm); if Confirm then begin ColHdrHeight := NewSize; UpdateDesigner; end; end; agsSizeRowHdr: begin DeltaSize := Coord.AbsX - FBeginDraggingCoord.AbsX; NewSize := RowHdrWidth + DeltaSize; if Assigned(FOnSizeRowHdr) then FOnSizeRowHdr(Self, 0, NewSize, Confirm); if Confirm then begin RowHdrWidth := NewSize; UpdateDesigner; end; end; agsMoveCol: begin NewSize := FDraggingCoord.Col; if Assigned(FOnMoveCol) then FOnMoveCol(Self, FBeginDraggingCoord.Col, NewSize, Confirm); if Confirm then begin Cols.MoveCol(FBeginDraggingCoord.Col, NewSize); UpdateDesigner; end; end; agsSizeAppt: begin FHint.ReleaseHandle; Appt := FBeginDraggingCoord.Appt; CalcSizeEndTime(Appt, NewEndDT); if Assigned(FOnSizeAppt) then FOnSizeAppt(Self, Appt, NewEndDT, Confirm); if Confirm then begin // WHY AM I CALLING RefreshControls HERE????? ScheduleManager.RefreshConnections(Appt); Appt.SetStartEnd(Appt.StartDate, Appt.StartTime, Trunc(NewEndDT), Frac(NewEndDT)); ScheduleManager.RefreshConnections(Appt); end; end; //agsMoveAppt: nothing special here - see DropAppt method end; finally // Don't reset state if moving appt. State will be reset in DoEndDrag // and/or DropAppt methods. Resetting State here will cause problems when // dragging between multiple appt controls. if State <> agsMoveAppt then FState := agsNormal; end; end; function TJvTFDays.CanDragWhat(Coord: TJvTFDaysCoord): TJvTFDaysState; var TopHandleRect, BottomHandleRect: TRect; begin case State of agsSizeCol, agsSizeRow, agsSizeColHdr, agsSizeRowHdr, agsMoveCol, agsSizeAppt, agsMoveAppt: begin Result := State; Exit; end; else Result := agsNormal; end; with Coord do begin if ((agoSizeCols in Options) or (csDesigning in ComponentState)) and (Row = gcHdr) and (Col > gcHdr) and (CellX > Cols[Col].Width - SizingThreshold) then begin Result := agsSizeCol; Exit; end; if ((agoSizeRows in Options) or (csDesigning in ComponentState)) and (Row > gcHdr) and (Col = gcHdr) and (CellY > RowHeight - SizingThreshold) then begin Result := agsSizeRow; Exit; end; if ((agoSizeColHdr in Options) or (csDesigning in ComponentState)) and (Row = gcHdr) and (Col > gcUndef) and (CellY > ColHdrHeight - SizingThreshold) then begin Result := agsSizeColHdr; Exit; end; if ((agoSizeRowHdr in Options) or (csDesigning in ComponentState)) and (Row > gcUndef) and (Col = gcHdr) and (CellX > RowHdrWidth - SizingThreshold) then begin Result := agsSizeRowHdr; Exit; end; if ((agoMoveCols in Options) or (csDesigning in ComponentState)) and (Coord.Row = gcHdr) and (Coord.Col > gcHdr) and not (Template.ActiveTemplate = agtLinear) and ((State = agsNormal) or (State = agsMoveCol)) and (Cols.Count > 1) then begin Result := agsMoveCol; Exit; end; // move grab handles if Assigned(SelAppt) then begin TopHandleRect := GetTopGrabHandleRect(Col, SelAppt); BottomHandleRect := GetBottomGrabHandleRect(Col, SelAppt); if PtInRect(TopHandleRect, Point(AbsX, AbsY)) and (agoMoveAppt in Options) then Result := agsMoveAppt else if PtInRect(BottomHandleRect, Point(AbsX, AbsY)) and (agoSizeAppt in Options) then Result := agsSizeAppt; end; // if ((agoSizeAppt in Options) or (agoMoveAppt in Options)) and // Assigned(Appt) and (Appt = SelAppt) then // begin // ApptRect := GetApptRect(Col, Appt); // if (AbsY <= ApptRect.Top + GrabHandles.Height - 1) and // (agoMoveAppt in Options) then // begin // Result := agsMoveAppt; // Exit; // end // else // if (AbsY >= ApptRect.Bottom - GrabHandles.Height + 1) and // (agoSizeAppt in Options) then // begin // Result := agsSizeAppt; // Exit; // end; // end; end; end; procedure TJvTFDays.CalcSizeEndTime(Appt: TJvTFAppt; out NewEndDT: TDateTime); var TimeOffset: TTime; Sched: TJvTFSched; begin Sched := FDraggingCoord.Schedule; if (Sched.SchedName = FBeginDraggingCoord.Schedule.SchedName) and (Trunc(Sched.SchedDate) >= Trunc(Appt.StartDate)) then if agoSnapSize in Options then if FDraggingCoord.Row <> RowCount - 1 then NewEndDT := Trunc(Sched.SchedDate) + Frac(RowToTime(FDraggingCoord.Row + 1)) else NewEndDT := Trunc(Sched.SchedDate) + Frac(RowEndTime(FDraggingCoord.Row)) else begin TimeOffset := Frac(Appt.EndTime) - Frac(RowToTime(TimeToRow(AdjustEndTime(Appt.EndTime)))); NewEndDT := Trunc(Sched.SchedDate) + Frac(RowToTime(FDraggingCoord.Row)) + TimeOffset; end else NewEndDT := Trunc(Appt.EndDate) + Frac(Appt.EndTime); end; {$IFNDEF Jv_TIMEBLOCKS} // remove { procedure TJvTFDays.CalcMoveStartEnd(Appt: TJvTFAppt; Coord: TJvTFDaysCoord; KeepDates, KeepTimes: Boolean; var StartDT, EndDT: TDateTime); var NewStart, NewEnd: TDateTime; begin NewStart := Trunc(Cols[Coord.Col].SchedDate) + Frac(RowToTime(Coord.Row)); if not (agoSnapMove in Options) then NewStart := NewStart + Frac(Appt.StartTime) - RowToTime(TimeToRow(Appt.StartTime)); NewEnd := (Trunc(Appt.EndDate) + Frac(Appt.EndTime)) - (Trunc(Appt.StartDate) + Frac(Appt.StartTime)) + NewStart; if KeepDates then begin NewStart := Trunc(Appt.StartDate) + Frac(NewStart); NewEnd := Trunc(Appt.EndDate) + Frac(NewEnd); end; if KeepTimes then begin NewStart := Trunc(NewStart) + Frac(Appt.StartTime); NewEnd := Trunc(NewEnd) + Frac(Appt.EndTime); end; StartDT := NewStart; EndDT := NewEnd; end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok procedure TJvTFDays.CalcMoveStartEnd(Appt: TJvTFAppt; Coord: TJvTFDaysCoord; KeepDates, KeepTimes: Boolean; out StartDT, EndDT: TDateTime); var NewStart, NewEnd: TDateTime; TimeBlockIndex, BlockStartRow, BlockEndRow: Integer; BlockStartTime, BlockEndTime: TTime; H, M, S, MS: Word; begin TimeBlockIndex := RowToTimeBlock(Coord.Row); if TimeBlockProps.SnapMove and (TimeBlockIndex > -1) then begin GetTimeBlockStartEnd(TimeBlockIndex, BlockStartRow, BlockEndRow); BlockStartTime := RowToTime(BlockStartRow); BlockEndTime := RowEndTime(BlockEndRow); NewStart := Trunc(Cols[Coord.Col].SchedDate) + Frac(BlockStartTime); NewEnd := Trunc(NewStart) + Frac(BlockEndTime); end else begin NewStart := Trunc(Cols[Coord.Col].SchedDate) + Frac(RowToTime(Coord.Row)); if not (agoSnapMove in Options) then NewStart := NewStart + Frac(Appt.StartTime) - RowToTime(TimeToRow(Appt.StartTime)); NewEnd := (Trunc(Appt.EndDate) + Frac(Appt.EndTime)) - (Trunc(Appt.StartDate) + Frac(Appt.StartTime)) + NewStart; // NewEnd cannot fall exactly on midnight. Bad things happen. DecodeTime(NewEnd, H, M, S, MS); if (H = 0) and (M = 0) and (S = 0) then NewEnd := NewEnd - ONE_SECOND; if KeepDates then begin NewStart := Trunc(Appt.StartDate) + Frac(NewStart); NewEnd := Trunc(Appt.EndDate) + Frac(NewEnd); end; if KeepTimes then begin NewStart := Trunc(NewStart) + Frac(Appt.StartTime); NewEnd := Trunc(NewEnd) + Frac(Appt.EndTime); end; end; StartDT := NewStart; EndDT := NewEnd; end; {$ENDIF Jv_TIMEBLOCKS} procedure TJvTFDays.EnsureCol(ACol: Integer); begin if (ACol < 0) or (ACol > Cols.Count - 1) then raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds); end; procedure TJvTFDays.EnsureRow(ARow: Integer); begin if (ARow < 0) or (ARow > RowCount - 1) then raise EJvTFDaysError.CreateRes(@RsERowIndexOutOfBounds); end; procedure TJvTFDays.KeyDown(var Key: Word; Shift: TShiftState); var H: Word; Handled: Boolean; procedure DoSel; begin if ssShift in Shift then SelEnd := Point(FocusedCol, FocusedRow) else SelStart := Point(FocusedCol, FocusedRow); ColInView(FocusedCol); RowInView(FocusedRow); end; begin Handled := True; inherited KeyDown(Key, Shift); case Key of VK_RETURN: if ssAlt in Shift then EditAppt(FocusedCol, SelAppt); VK_UP: if ssCtrl in Shift then ScrollDays(-7) else if ssAlt in Shift then SelPrevAppt else begin FocusedRow := Greater(FocusedRow - 1, 0); DoSel; end; VK_DOWN: if ssCtrl in Shift then ScrollDays(7) else if ssAlt in Shift then SelNextAppt else begin FocusedRow := Lesser(FocusedRow + 1, RowCount - 1); DoSel; end; VK_RIGHT: if ssCtrl in Shift then NextDate else if ssAlt in Shift then SelFirstApptNextCol else begin FocusedCol := Lesser(FocusedCol + 1, Cols.Count - 1); DoSel; end; VK_LEFT: if ssCtrl in Shift then PrevDate else if ssAlt in Shift then SelFirstApptPrevCol else begin FocusedCol := Greater(FocusedCol - 1, 0); DoSel; end; VK_PRIOR: if ssCtrl in Shift then ScrollMonths(-1) else begin TopRow := Greater(TopRow - FullVisibleRows, 0); FocusedRow := Greater(FocusedRow - FullVisibleRows, TopRow); DoSel; end; VK_NEXT: if ssCtrl in Shift then ScrollMonths(1) else begin TopRow := Lesser(TopRow + FullVisibleRows, RowCount - FullVisibleRows); FocusedRow := Lesser(FocusedRow + FullVisibleRows, RowCount - 1); DoSel; end; VK_HOME: if ssCtrl in Shift then TopRow := TimeToRow(PrimeTime.StartTime) else begin TopRow := 0; FocusedRow := 0; DoSel; end; VK_END: if ssCtrl in Shift then RowInView(TimeToRow(AdjustEndTime(PrimeTime.EndTime))) else begin RowInView(RowCount - 1); FocusedRow := RowCount - 1; DoSel; end; VK_F1..VK_F12: if ssCtrl in Shift then begin H := Key - VK_F1 + 1; if ssShift in Shift then Inc(H, 12); if Key = VK_F12 then Dec(H, 12); RowInView(TimeToRow(EncodeTime(H, 0, 0, 0))); end; VK_INSERT: if Shift = [ssCtrl] then case Granularity of 2: Granularity := 1; 3: Granularity := 2; 4: Granularity := 3; 5: Granularity := 4; 6: Granularity := 5; 10: Granularity := 6; 12: Granularity := 10; 15: Granularity := 12; 20: Granularity := 15; 30: Granularity := 20; 60: Granularity := 30; end else if Shift = [ssShift] then DoInsertSchedule else if Shift = [] then DoInsertAppt; VK_DELETE: if Shift = [ssCtrl] then case Granularity of 1: Granularity := 2; 2: Granularity := 3; 3: Granularity := 4; 4: Granularity := 5; 5: Granularity := 6; 6: Granularity := 10; 10: Granularity := 12; 12: Granularity := 15; 15: Granularity := 20; 20: Granularity := 30; 30: Granularity := 60; end else if Shift = [ssShift] then DoDeleteSchedule else if Shift = [] then DoDeleteAppt; else Handled := False; end; if Handled then Key := 0; end; procedure TJvTFDays.KeyPress(var Key: Char); begin inherited KeyPress(Key); QuickEntry(Key); end; procedure TJvTFDays.DoInsertSchedule; begin if Assigned(FOnInsertSchedule) then FOnInsertSchedule(Self); end; procedure TJvTFDays.DoInsertAppt; begin if Assigned(FOnInsertAppt) then FOnInsertAppt(Self); end; procedure TJvTFDays.DoDeleteAppt; begin if Assigned(FOnDeleteAppt) then FOnDeleteAppt(Self); end; procedure TJvTFDays.DoDeleteSchedule; begin if Assigned(FOnDeleteSchedule) then FOnDeleteSchedule(Self); end; function TJvTFDays.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelDown(Shift, MousePos); if not Result then begin if TopRow < RowCount - FullVisibleRows then TopRow := TopRow + 1; Result := True; end; end; function TJvTFDays.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelUp(Shift, MousePos); if not Result then begin if TopRow > 0 then TopRow := TopRow - 1; Result := True; end; end; procedure TJvTFDays.DestroyApptNotification(AAppt: TJvTFAppt); begin if AAppt = SelAppt then SelAppt := nil; inherited DestroyApptNotification(AAppt); end; procedure TJvTFDays.CMMouseLeave(var Msg: TLMessage); begin FHint.ReleaseHandle; inherited; end; procedure TJvTFDays.DoEnter; begin inherited DoEnter; if Assigned(FOnFocusedColChanged) then FOnFocusedColChanged(Self); if Assigned(FOnFocusedRowChanged) then FOnFocusedRowChanged(Self); Invalidate; end; procedure TJvTFDays.DoExit; begin if Assigned(FOnFocusedColChanged) then FOnFocusedColChanged(Self); if Assigned(FOnFocusedRowChanged) then FOnFocusedRowChanged(Self); Invalidate; inherited DoExit; end; function TJvTFDays.GetSelStart: TPoint; begin // This routine will always return the start of the selection regardless // of whether FSelStart and FSelEnd are in the correct order or not. if FFromToSel then if (FSelStart.X < FSelEnd.X) or ((FSelStart.X = FSelEnd.X) and (FSelStart.Y < FSelEnd.Y)) then Result := FSelStart else Result := FSelEnd else Result := Point(Lesser(FSelStart.X, FSelEnd.X), Lesser(FSelStart.Y, FSelEnd.Y)); end; function TJvTFDays.GetSelEnd: TPoint; begin // This routine will always return the end of the selection regardless // of whether FSelStart and FSelEnd are in the correct order or not. if FFromToSel then if (FSelStart.X < FSelEnd.X) or ((FSelStart.X = FSelEnd.X) and (FSelStart.Y < FSelEnd.Y)) then Result := FSelEnd else Result := FSelStart else Result := Point(Greater(FSelStart.X, FSelEnd.X), Greater(FSelStart.Y, FSelEnd.Y)); end; {$IFNDEF Jv_TIMEBLOCKS} // remove { procedure TJvTFDays.SetSelStart(Value: TPoint); begin FSelStart := Value; FSelEnd := Value; DoNavigate; Invalidate; end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok procedure TJvTFDays.SetSelStart(Value: TPoint); var TimeBlock: Integer; StartRow: Integer = -1; // to silence the compiler EndRow: Integer = -1; // dto. begin TimeBlock := RowToTimeBlock(Value.Y); if (TimeBlock = -1) and (TimeBlocks.Count > 0) then Exit; FSelStart := Value; FSelEnd := Value; if TimeBlock > -1 then begin GetTimeBlockStartEnd(TimeBlock, StartRow, EndRow); FSelStart.Y := StartRow; FSelEnd.Y := EndRow; end; // DoNavigate; Invalidate; end; {$ENDIF Jv_TIMEBLOCKS} {$IFNDEF Jv_TIMEBLOCKS} // remove { procedure TJvTFDays.SetSelEnd(Value: TPoint); var SameName, Consecutive: Boolean; I, TestStart, TestEnd, DateDiff: Integer; begin ///////////////////////////////////////////////////////////////////// // This routine enforces the rules by which cells can be selected. // There are two different types of selection: // 1. From/To - As mouse moves from cell(1, 4) to cell(2, 8)... // Cell(1, 4) through cell(1, LastRow) is selected, AND // Cell(2, TopRow) through cell(2, 8) is selected. // 2. Block - As mouse moves from cell(1, 4) to cell(2, 8)... // Cell(1, 4) through cell(1, 8) is selected, AND // Cell(2, 4) through cell(2, 8) is selected. // // There are six different cases that are possible: // 1. Same SchedName (resource), contiguous dates ==> From/To selection // (Mike - 1/1/99 and Mike - 1/2/99) // 2. Same name, non-contiguous dates ==> Selection not allowed // (Mike - 1/1/99 and Mike - 2/1/99) // 3. Same name, same date ==> Block selection // (Mike - 1/1/99 and Mike - 1/1/99) // 4. Different name, contiguous dates ==> Selection not allowed // (Mike - 1/1/99 and Jennifer - 1/2/99) // 5. Different name, non-contiguous dates ==> Selection not allowed // (Mike - 1/1/99 and Jennifer - 2/1/99) // 6. Different name, same date ==> Block selection // (Mike - 1/1/99 and Jennifer - 1/1/99) /////////////////////////////////////////////////////////////////////// // Check for different end value if (FSelEnd.X <> Value.X) or (FSelEnd.Y <> Value.Y) then begin // Check for valid end if (FSelStart.X > gcHdr) and (Value.X > gcHdr) and (FSelEnd.X > gcHdr) and (FSelStart.Y > gcHdr) and (Value.Y > gcHdr) and (FSelEnd.Y > gcHdr) then begin // FFromToSel flag needed for drawing selection frame when // SelCellAttr.Style = scsFrame. Frame is drawn in DrawDataCell. //FFromToSel := False; // We need a two-level check. First check new end (Value) against // old end (FSelEnd). if that is NOT a valid end then check // new end (Value) against start (FSelStart). // IMPORTANT NOTE: When in a case #1 and selection moves up or down // within the same column, the code below will interpret that as // Case #3. This is not exactly correct, but it still yields the // correct results. // First check new end against old end SameName := Cols[FSelEnd.X].SchedName = Cols[Value.X].SchedName; DateDiff := Abs(Trunc(Cols[FSelEnd.X].SchedDate) - Trunc(Cols[Value.X].SchedDate)); if ( SameName and (DateDiff = 1)) or // Case #1 ( SameName and (DateDiff = 0)) or // Case #3 (not SameName and (DateDiff = 0)) then // Case #6 begin FFromToSel := (SameName and (DateDiff = 1)) or (FFromToSel and (SameName and (DateDiff = 0))); FSelEnd := Value; DoNavigate; Invalidate; end else // if first check fails then check new end against start begin SameName := Cols[FSelStart.X].SchedName = Cols[Value.X].SchedName; DateDiff := Abs(Trunc(Cols[FSelStart.X].SchedDate) - Trunc(Cols[Value.X].SchedDate)); if ( SameName and (DateDiff = 1)) or // Case #1 ( SameName and (DateDiff = 0)) or // Case #3 (not SameName and (DateDiff = 0)) then // Case #6 begin FFromToSel := (SameName and (DateDiff = 1)) or (FFromToSel and (SameName and (DateDiff = 0))); FSelEnd := Value; DoNavigate; Invalidate; end else // Do a third check for "lagging selection" // (Sometimes mouse loses selection, especially when speed // threshold is exceeded.) begin // Check for consecutive dates TestStart := Lesser(SelStart.X, Value.X); TestEnd := Greater(SelStart.X, Value.X); I := TestStart; Consecutive := True; while (I < TestEnd) and Consecutive do if Trunc(Cols[I + 1].SchedDate) - Trunc(Cols[I].SchedDate) <> 1 then Consecutive := False else Inc(I); if Consecutive then begin FFromToSel := True; FSelEnd := Value; DoNavigate; Invalidate; end else FFromToSel := False; end; end; end; end; end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok procedure TJvTFDays.SetSelEnd(Value: TPoint); var SameName, Consecutive, InTimeBlock: Boolean; I, TestStart, TestEnd, DateDiff, TimeBlock: Integer; SelStartTimeBlock, StartRow, EndRow: Integer; procedure CheckFollowMouse; begin if (TimeBlocks.Count > 0) and SameName and (DateDiff = 1) and (Value.X <> SelStart.X) then SelStart := Point(Value.X, SelStart.Y); end; begin { This routine enforces the rules by which cells can be selected. There are two different types of selection: 1. From/To - As mouse moves from cell(1, 4) to cell(2, 8)... Cell(1, 4) through cell(1, LastRow) is selected, AND Cell(2, TopRow) through cell(2, 8) is selected. 2. Block - As mouse moves from cell(1, 4) to cell(2, 8)... Cell(1, 4) through cell(1, 8) is selected, AND Cell(2, 4) through cell(2, 8) is selected. NOTE: The Block selection type should not be confused with Time Blocks. They are two different things. The only type of allowable selection when using Time Blocks is Block, however a Block selection can exist without the use of Time Blocks. There are six different cases that are possible: 1. Same SchedName (resource), contiguous dates ==> From/To selection (Mike - 1/1/99 and Mike - 1/2/99) 2. Same name, non-contiguous dates ==> Selection not allowed (Mike - 1/1/99 and Mike - 2/1/99) 3. Same name, same date ==> Block selection (Mike - 1/1/99 and Mike - 1/1/99) 4. Different name, contiguous dates ==> Selection not allowed (Mike - 1/1/99 and Jennifer - 1/2/99) 5. Different name, non-contiguous dates ==> Selection not allowed (Mike - 1/1/99 and Jennifer - 2/1/99) 6. Different name, same date ==> Block selection (Mike - 1/1/99 and Jennifer - 1/1/99) } // Do a time block check and adjust Value.Y if necessary to always // select the entire time block. TimeBlock := RowToTimeBlock(Value.Y); if (TimeBlock = -1) and (TimeBlocks.Count > 0) then Exit; SelStartTimeBlock := RowToTimeBlock(SelStart.Y); InTimeBlock := (TimeBlock > -1) or (SelStartTimeBlock > -1); if InTimeBlock then begin if TimeBlock > -1 then begin GetTimeBlockStartEnd(TimeBlock, StartRow, EndRow); SelStart := Point(SelStart.X, StartRow); end else SelStart := Point(SelStart.X, Value.Y); Value.Y := EndRow; end; // Check for different end value if (FSelEnd.X <> Value.X) or (FSelEnd.Y <> Value.Y) then begin // Check for valid end if (FSelStart.X > gcHdr) and (Value.X > gcHdr) and (FSelEnd.X > gcHdr) and (FSelStart.Y > gcHdr) and (Value.Y > gcHdr) and (FSelEnd.Y > gcHdr) then begin // FFromToSel flag needed for drawing selection frame when // SelCellAttr.Style = scsFrame. Frame is drawn in DrawDataCell. //FFromToSel := False; // We need a two-level check. First check new end (Value) against // old end (FSelEnd). if that is NOT a valid end then check // new end (Value) against start (FSelStart). // IMPORTANT NOTE: When in a case #1 and selection moves up or down // within the same column, the code below will interpret that as // Case #3. This is not exactly correct, but it still yields the // correct results. // First check new end against old end SameName := Cols[FSelEnd.X].SchedName = Cols[Value.X].SchedName; DateDiff := Abs(Trunc(Cols[FSelEnd.X].SchedDate) - Trunc(Cols[Value.X].SchedDate)); CheckFollowMouse; if (SameName and (DateDiff = 1) and (TimeBlocks.Count = 0)) or // Case #1 only if no timeblocks (SameName and (DateDiff = 0)) or // Case #3 (not SameName and (DateDiff = 0)) then // Case #6 begin FFromToSel := (SameName and (DateDiff = 1)) or (FFromToSel and (SameName and (DateDiff = 0))); FSelEnd := Value; // DoNavigate; Invalidate; end else // if first check fails then check new end against start begin SameName := Cols[FSelStart.X].SchedName = Cols[Value.X].SchedName; DateDiff := Abs(Trunc(Cols[FSelStart.X].SchedDate) - Trunc(Cols[Value.X].SchedDate)); CheckFollowMouse; if (SameName and (DateDiff = 1) and (TimeBlocks.Count = 0)) or // Case #1 only if no timeblocks (SameName and (DateDiff = 0)) or // Case #3 (not SameName and (DateDiff = 0)) then // Case #6 begin FFromToSel := (SameName and (DateDiff = 1)) or (FFromToSel and (SameName and (DateDiff = 0))); FSelEnd := Value; // DoNavigate; Invalidate; end else // Do a third check for "lagging selection" // (Sometimes mouse loses selection, especially when speed // threshold is exceeded.) begin // Check for consecutive dates TestStart := Lesser(SelStart.X, Value.X); TestEnd := Greater(SelStart.X, Value.X); I := TestStart; Consecutive := False; while (I < TestEnd) and Consecutive do if Trunc(Cols[I + 1].SchedDate) - Trunc(Cols[I].SchedDate) <> 1 then Consecutive := False else Inc(I); if Consecutive then begin FFromToSel := True; FSelEnd := Value; // DoNavigate; Invalidate; end else FFromToSel := False; end; end; end; end; end; {$ENDIF Jv_TIMEBLOCKS} procedure TJvTFDays.QuickEntry(Key: Char); var Appt: TJvTFAppt; ApptStartDate, ApptEndDate: TDate; ApptStartTime, ApptEndTime: TTime; I: Integer; ID: string; Confirm: Boolean; begin // Ord(key) must be >= 32 to quick entry an appt. if (Ord(Key) >= 32) and ValidSelection and not Assigned(SelAppt) and (agoQuickEntry in Options) and (agoEditing in Options) and CanEdit then begin // Calc the appt's start and end info ApptStartDate := Cols[SelStart.X].SchedDate; ApptEndDate := Cols[SelEnd.X].SchedDate; ApptStartTime := RowToTime(SelStart.Y); // subtract one min from granularity and then add it back in. This // avoids min overflow when granularity = 60. ApptEndTime := RowToTime(SelEnd.Y) + EncodeTime(0, Granularity - 1, 0, 0) + EncodeTime(0, 1, 0, 0); // if we're on the last row make sure end time is not = 0 (12am next day) // This avoids InvalidStartEnd exception when calling Appt.SetStartEnd if SelEnd.Y = RowCount - 1 then ApptEndTime := ApptEndTime - EncodeTime(0, 0, 1, 0); ID := ''; Confirm := True; if Assigned(FOnCreateQuickEntry) then FOnCreateQuickEntry(Self, ID, ApptStartDate, ApptStartTime, ApptEndDate, ApptEndTime, Confirm); if Confirm and Assigned(ScheduleManager) then begin Appt := ScheduleManager.dbNewAppt(ID); Appt.Persistent := True; // Set the Start/end info Appt.SetStartEnd(ApptStartDate, ApptStartTime, ApptEndDate, ApptEndTime); // Set the Schedule (resource) names for I := SelStart.X to SelEnd.X do if ColIsSelected(I) then Appt.AddSchedule(Cols[I].SchedName); Appt.Persistent := False; SetSelAppt(Appt); EditAppt(SelStart.X, SelAppt); // Put the Key in the editor and set the caret FEditor.Text := Key; FEditor.SelStart := 1; FEditor.QuickCreate := True; if Assigned(FOnQuickEntry) then FOnQuickEntry(Self); end; end; end; function TJvTFDays.GetAdjClientRect: TRect; begin Result := GetClientRect; if Assigned(FVScrollBar) and FVScrollBar.Visible then Dec(Result.Right, FVScrollBar.Width); if Assigned(FHScrollBar) and FHScrollBar.Visible then Dec(Result.Bottom, FHScrollBar.Height); end; function TJvTFDays.GetDataAreaRect: TRect; begin Result := GetAdjClientRect; {$IFDEF Jv_TIMEBLOCKS} // ok Inc(Result.Left, CalcBlockRowHdrsWidth); {$ELSE} // remove //Inc(Result.Left, RowHdrWidth); {$ENDIF Jv_TIMEBLOCKS} //group Inc(Result.Top, ColHdrHeight); Inc(Result.Top, CalcGroupColHdrsHeight); end; function TJvTFDays.GetDataWidth: Integer; begin Result := RectWidth(GetDataAreaRect); end; function TJvTFDays.GetDataHeight: Integer; begin Result := RectHeight(GetDataAreaRect); end; {$IFNDEF Jv_TIMEBLOCKS} // remove { function TJvTFDays.PtToCell(X, Y: Integer): TJvTFDaysCoord; Var ColNum, RowNum, AdjX, AdjY, Temp, TotalWidth, SegCount, MapCol: Integer; Done: Boolean; ApptRect: TRect; begin With Result do begin Col := gcUndef; Row := gcUndef; CellX := -100; CellY := -100; AbsX := X; AbsY := Y; Schedule := nil; Appt := nil; end; if X < RowHdrWidth then begin Result.Col := gcHdr; Result.CellX := X; end else if LeftCol > -1 then begin // Find the col that PtX falls in ColNum := LeftCol; AdjX := X - RowHdrWidth; Done := False; Temp := 0; while (ColNum < Cols.Count) and not Done do begin Inc(Temp, Cols[ColNum].Width); if AdjX < Temp then begin Done := True; Result.Col := ColNum; Result.CellX := AdjX - (Temp - Cols[ColNum].Width); end else Inc(ColNum); end; end; if Y < CalcGroupHdrHeight then begin Result.Row := gcGroupHdr; Result.CellY := Y; end //else //if Y < ColHdrHeight then else if Y < CalcGroupColHdrsHeight then begin Result.Row := gcHdr; Result.CellY := Y - CalcGroupHdrHeight; end else if TopRow > -1 then begin RowNum := TopRow; //group AdjY := Y - ColHdrHeight; AdjY := Y - CalcGroupColHdrsHeight; Done := False; Temp := 0; while (RowNum < RowCount) and not Done do begin Inc(Temp, RowHeight); if AdjY < Temp then begin Done := True; Result.Row := RowNum; Result.CellY := AdjY - (Temp - RowHeight); end else Inc(RowNum); end; end; if Result.Col > gcHdr then begin Result.Schedule := Cols[Result.Col].Schedule; if (Result.Row > gcHdr) and Assigned(Result.Schedule) then begin TotalWidth := Cols[Result.Col].Width; SegCount := Cols[Result.Col].MapColCount(Result.Row); if SegCount > 0 then begin MapCol := LocateDivCol(Result.CellX, TotalWidth, SegCount); Result.Appt := Cols[Result.Col].MapLocation(MapCol, Result.Row); ApptRect := GetApptRect(Result.Col, Result.Appt); if not Windows.PtInRect(ApptRect, Point(X, Y)) then Result.Appt := nil; end; end; end; Result.DragAccept := (Result.Row > gcHdr) and (Result.Col > gcHdr); end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok function TJvTFDays.PtToCell(X, Y: Integer): TJvTFDaysCoord; var ColNum, RowNum, AdjX, AdjY, Temp, TotalWidth, SegCount, MapCol: Integer; Done: Boolean; ApptRect: TRect; begin with Result do begin Col := gcUndef; Row := gcUndef; CellX := -100; CellY := -100; AbsX := X; AbsY := Y; Schedule := nil; Appt := nil; end; if X < CalcBlockHdrWidth then begin // POSSIBLE BUG!! //Result.Row := gcGroupHdr; // WRONG CODE Result.Col := gcGroupHdr; // UNTESTED - CORRECT CODE Result.CellX := X; end //block if X < RowHdrWidth then else if X < CalcBlockRowHdrsWidth then begin Result.Col := gcHdr; Result.CellX := X - CalcBlockHdrWidth; end else if LeftCol > -1 then begin // Find the col that PtX falls in ColNum := LeftCol; //block AdjX := X - RowHdrWidth; AdjX := X - CalcBlockRowHdrsWidth; Done := False; Temp := 0; while (ColNum < Cols.Count) and not Done do begin Inc(Temp, Cols[ColNum].Width); if AdjX < Temp then begin Done := True; Result.Col := ColNum; Result.CellX := AdjX - (Temp - Cols[ColNum].Width); end else Inc(ColNum); end; if not Done then begin Result.Col := Cols.Count-1; Result.CellX := AdjX - (Temp - Cols[Cols.Count-1].Width); end; end; if Y < CalcGroupHdrHeight then begin Result.Row := gcGroupHdr; Result.CellY := Y; end //else if Y < ColHdrHeight then else if Y < CalcGroupColHdrsHeight then begin Result.Row := gcHdr; Result.CellY := Y - CalcGroupHdrHeight; end else if TopRow > -1 then begin RowNum := TopRow; //group AdjY := Y - ColHdrHeight; AdjY := Y - CalcGroupColHdrsHeight; Done := False; Temp := 0; while (RowNum < RowCount) and not Done do begin Inc(Temp, RowHeight); if AdjY < Temp then begin Done := True; Result.Row := RowNum; Result.CellY := AdjY - (Temp - RowHeight); end else Inc(RowNum); end; if not Done then begin Result.Row := RowCount-1; Result.CellY := AdjY - (Temp - RowHeight); end; end; if Result.Col > gcHdr then begin Result.Schedule := Cols[Result.Col].Schedule; // move grab handles if PtInTopHandle(Point(X, Y), Result.Col, SelAppt) then Result.Appt := SelAppt else if PtInBottomHandle(Point(X, Y), Result.Col, SelAppt) then Result.Appt := SelAppt else if (Result.Row > gcHdr) and Assigned(Result.Schedule) then begin TotalWidth := Cols[Result.Col].Width; SegCount := Cols[Result.Col].MapColCount(Result.Row); if SegCount > 0 then begin MapCol := LocateDivCol(Result.CellX, TotalWidth, SegCount); Result.Appt := Cols[Result.Col].MapLocation(MapCol, Result.Row); ApptRect := GetApptRect(Result.Col, Result.Appt); if not PtInRect(ApptRect, Point(X, Y)) then Result.Appt := nil; end; end; end; Result.DragAccept := (Result.Row > gcHdr) and (Result.Col > gcHdr); end; {$ENDIF Jv_TIMEBLOCKS} {$IFNDEF Jv_TIMEBLOCKS} // remove { function TJvTFDays.CellRect(Col, Row: Integer): TRect; Var I: Integer; VisGrpHdrRect: TRect; begin if (Row = gcGroupHdr) and (Col > gcHdr) then begin VisGrpHdrRect := Classes.Rect(RowHdrWidth, 0, RowHdrWidth + GetDataWidth, CalcGroupHdrHeight); Windows.IntersectRect(Result, VisGrpHdrRect, VirtualGroupHdrRect(Col)); end else if Col < 0 then // Row hdr if Row < 0 then //group Result := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight) // origin cell Result := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight) // origin cell else if (Row >= TopRow) and (Row <= BottomRow) then // Row Hdr for visible data row begin Result.Left := 0; //group Top := ColHdrHeight + (Row - TopRow) * RowHeight; Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight; Result.Right := RowHdrWidth; Result.Bottom := Result.Top + RowHeight; end else // Row Hdr for non-visible data row Result := EmptyRect else if (Col >= LeftCol) and (Col <= RightCol) then // visible data col if Row < 0 then // Col hdr for visible data col begin Result.Left := RowHdrWidth; For I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; //group Top := 0; Result.Top := CalcGroupHdrHeight; //group Bottom := ColHdrHeight; Result.Bottom := CalcGroupColHdrsHeight; end else if (Row >= TopRow) and (Row <= BottomRow) then // visible data cell begin Result.Left := RowHdrWidth; For I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; //group Top := ColHdrHeight + (Row - TopRow) * RowHeight; Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight; Result.Bottom := Result.Top + RowHeight; end else // non-visible data cell (visible col, but non-visible row) Result := EmptyRect else // non-visible data col Result := EmptyRect; end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok function TJvTFDays.CellRect(Col, Row: Integer): TRect; var I: Integer; VisGrpHdrRect: TRect; begin Result := EmptyRect; if (Col = gcGroupHdr) and (Row > gcHdr) then begin VisGrpHdrRect := Classes.Rect(0, CalcGroupColHdrsHeight, CalcBlockRowHdrsWidth, CalcGroupColHdrsHeight + GetDataHeight); IntersectRect(Result, VisGrpHdrRect, VirtualBlockHdrRect(Row)); end else if (Row = gcGroupHdr) and (Col > gcHdr) then begin //block VisGrpHdrRect := Classes.Rect(RowHdrWidth, 0, RowHdrWidth + GetDataWidth, // CalcGroupHdrHeight); VisGrpHdrRect := Classes.Rect(CalcBlockRowHdrsWidth, 0, CalcBlockRowHdrsWidth + GetDataWidth, CalcGroupHdrHeight); IntersectRect(Result, VisGrpHdrRect, VirtualGroupHdrRect(Col)); end else if Col < 0 then // Row hdr if Row < 0 then //group Result := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight) // origin cell //block Result := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight) // origin cell Result := Classes.Rect(0, 0, CalcBlockRowHdrsWidth, CalcGroupColHdrsHeight) else if (Row >= TopRow) and (Row <= BottomRow) then // Row Hdr for visible data row begin //block Left := 0; Result.Left := CalcBlockHdrWidth; //group Top := ColHdrHeight + (Row - TopRow) * RowHeight; Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight; //block Right := RowHdrWidth; Result.Right := Result.Left + RowHdrWidth; Result.Bottom := Result.Top + RowHeight; end else // Row Hdr for non-visible data row Result := EmptyRect else if (Col >= LeftCol) and (Col <= RightCol) then // visible data col if Row < 0 then // Col hdr for visible data col begin //block Result.Left := RowHdrWidth; Result.Left := CalcBlockRowHdrsWidth; for I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; //group Result.Top := 0; Result.Top := CalcGroupHdrHeight; //group Result.Bottom := ColHdrHeight; Result.Bottom := CalcGroupColHdrsHeight; end else if (Row >= TopRow) and (Row <= BottomRow) then // visible data cell begin //block Result.Left := RowHdrWidth; Result.Left := CalcBlockRowHdrsWidth; for I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; //group Result.Top := ColHdrHeight + (Row - TopRow) * RowHeight; Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight; Result.Bottom := Result.Top + RowHeight; end else // non-visible data cell (visible col, but non-visible row) Result := EmptyRect else // non-visible data col Result := EmptyRect; end; {$ENDIF Jv_TIMEBLOCKS} {$IFNDEF Jv_TIMEBLOCKS} // remove { function TJvTFDays.VirtualCellRect(Col, Row: Integer): TRect; Var I: Integer; begin if Row = gcGroupHdr then Result := VirtualGroupHdrRect(Col) else begin if Col > -1 then begin Result.Left := RowHdrWidth; // At most, only one of the following For loops will execute // depending on whether Col is to the left or to the right of LeftCol For I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); For I := LeftCol - 1 downto Col do Dec(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; end else begin Result.Left := 0; Result.Right := RowHdrWidth; end; if Row > -1 then begin //group Result.Top := ColHdrHeight + (Row - TopRow) * RowHeight; Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight; Result.Bottom := Result.Top + RowHeight; end else begin //group Result.Top := 0; Result.Top := CalcGroupHdrHeight; Result.Bottom := Result.Top + ColHdrHeight; end; end; end; } {$ENDIF !Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // ok function TJvTFDays.VirtualCellRect(Col, Row: Integer): TRect; var I: Integer; begin if (Col = gcGroupHdr) and (Row > gcHdr) then Result := VirtualBlockHdrRect(Row) else if (Row = gcGroupHdr) and (Col > gcHdr) then Result := VirtualGroupHdrRect(Col) else begin if Col > -1 then begin //block Result.Left := RowHdrWidth; Result.Left := CalcBlockRowHdrsWidth; // At most, only one of the following For loops will execute // depending on whether Col is to the Result.Left or to the Result.Right of LeftCol for I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); for I := LeftCol - 1 downto Col do Dec(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; end else begin //block Result.Left := 0; Result.Left := CalcBlockHdrWidth; //block Result.Right := RowHdrWidth; Result.Right := Result.Left + RowHdrWidth; end; if Row > -1 then begin //group Result.Top := ColHdrHeight + (Row - TopRow) * RowHeight; Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight; Result.Bottom := Result.Top + RowHeight; end else begin //group Result.Top := 0; Result.Top := CalcGroupHdrHeight; Result.Bottom := Result.Top + ColHdrHeight; end; end; end; {$ENDIF Jv_TIMEBLOCKS} function TJvTFDays.GetApptRect(Col: Integer; Appt: TJvTFAppt): TRect; var MapCol, MapColCount, Base, MakeUp, BaseWidth, MakeUpWidth: Integer; BaseCount, GridColWidth, ApptWidth, StartRow, EndRow: Integer; VirtCellRect: TRect; begin if not Assigned(Appt) then begin Result := EmptyRect; Exit; end; CalcStartEndRows(Appt, Cols[Col].SchedDate, StartRow, EndRow); if (StartRow < 0) and (EndRow >= 0) then StartRow := 0; // if the above condition fails and the StartRow is STILL invalid then // let the 'Map col not found' catch the error. EndRow := Lesser(EndRow, RowCount - 1); MapCol := Cols[Col].LocateMapCol(Appt, StartRow); if MapCol < 1 then begin //Cols[Col].DumpMap; raise EJvTFDaysError.CreateRes(@RsEMapColNotFoundForAppointment); end; MapColCount := Cols[Col].MapColCount(StartRow); if MapColCount < 1 then begin //Cols[Col].FMap.Dump('corrupt dump.txt'); !!! FOR DEBUGGING ONLY !!!! //Cols[Col].DumpMap; raise EJvTFDaysError.CreateRes(@RsECorruptAppointmentMap); end; // Col guaranteed to be partially visible VirtCellRect := VirtualCellRect(Col, StartRow); GridColWidth := RectWidth(VirtCellRect); // The Base* and MakeUp* code that follows calcs the appt width and Result.Left // and takes into account a total width that isn't evenly divisible by // the map col count. If there is a discrepancy then that discrepancy // is divided up among the cols working Result.Left to Result.Right. // // Example: Total width = 113, col count = 5 // col 1 = 23 // col 2 = 23 // col 3 = 23 // col 4 = 22 // col 5 = 22 // Total = 113 // // As opposed to: // width of all cols = Total div colcount = 22 // ==> Total = 22 * 5 = 110 [110 <> 113] Base := GridColWidth div MapColCount; MakeUp := GridColWidth mod MapColCount; MakeUpWidth := Lesser(MapCol - 1, MakeUp) * (Base + 1); BaseCount := MapCol - 1 - MakeUp; if BaseCount > 0 then BaseWidth := BaseCount * Base else BaseWidth := 0; ApptWidth := Base; if MapCol <= MakeUp then Inc(ApptWidth); Result.Left := VirtCellRect.Left + MakeUpWidth + BaseWidth; Result.Right := Result.Left + ApptWidth - ApptBuffer; Result.Top := VirtCellRect.Top - 1; Result.Bottom := VirtualCellRect(Col, EndRow).Bottom; end; function TJvTFDays.LocateDivCol(X, TotalWidth, SegCount: Integer): Integer; var Base, MakeUp, ApproxSeg, MakeUpWidth: Integer; BaseCount, BaseWidth, SegWidth, NextSegStart: Integer; begin if X <= 0 then Result := 1 else if X >= TotalWidth then Result := SegCount else begin Base := TotalWidth div SegCount; // Protect against div by zero if Base < 1 then Base := 1; MakeUp := TotalWidth mod SegCount; ApproxSeg := X div Base; MakeUpWidth := Lesser(ApproxSeg - 1, MakeUp) * (Base + 1); BaseCount := ApproxSeg - 1 - MakeUp; if BaseCount > 0 then BaseWidth := BaseCount * Base else BaseWidth := 0; SegWidth := Base; if ApproxSeg <= MakeUp then Inc(SegWidth); NextSegStart := MakeUpWidth + BaseWidth + SegWidth; if X < NextSegStart then Result := ApproxSeg else Result := ApproxSeg + 1; end; end; procedure TJvTFDays.EditAppt(Col: Integer; Appt: TJvTFAppt); var Schedule: TJvTFSched; ApptRect, EditorRect: TRect; // EditHeightThreshold, EditWidthThreshold: Integer; FailEditor: Boolean; PicsHeight, PicsWidth, FrameOffset: Integer; DrawList: TList; CanDrawText, CanDrawPics: Boolean; DrawInfo: TJvTFDaysApptDrawInfo; AllowEdit: Boolean; begin FEditor.QuickCreate := False; EnsureCol(Col); Schedule := Cols[Col].Schedule; if not Assigned(Schedule) or not Assigned(Appt) or not (agoEditing in Options) or not CanEdit then Exit; AllowEdit := True; if Assigned(FOnBeginEdit) then FOnBeginEdit(Self, Appt, AllowEdit); if not AllowEdit then Exit; DrawInfo := TJvTFDaysApptDrawInfo.Create; try GetApptDrawInfo(DrawInfo, Appt, SelApptAttr); FrameOffset := DrawInfo.FrameWidth div 2 * 2; Canvas.Font := DrawInfo.Font; FEditor.Font := DrawInfo.Font; FEditor.Color := DrawInfo.Color; finally DrawInfo.Free; end; ApptRect := GetApptRect(Col, Appt); InflateRect(ApptRect, -FrameOffset, -FrameOffset); if ApptBar.Visible then Inc(ApptRect.Left, ApptBar.Width); AdjustForMargins(ApptRect); DrawList := TList.Create; try CreatePicDrawList(ApptRect, Appt, DrawList); FilterPicDrawList(ApptRect, DrawList, PicsHeight, PicsWidth); CanDrawWhat(Canvas, ApptRect, PicsHeight, CanDrawText, CanDrawPics); finally ClearPicDrawList(DrawList); DrawList.Free; end; if CanDrawPics then Inc(ApptRect.Left, PicsHeight); IntersectRect(EditorRect{%H-}, GetDataAreaRect, ApptRect); // Commented out by Tim - No longer required since no editor failure. // EditHeightThreshold := CanvasMaxTextHeight(Canvas) * Thresholds.EditHeight; // EditWidthThreshold := Canvas.TextWidth('Bi') div 2 * Thresholds.EditWidth; // Commented out by Tim - The editor should no longer ever fail. // FailEditor := (RectHeight(EditorRect) < EditHeightThreshold) or // (RectWidth(EditorRect) < EditWidthThreshold); FailEditor := False; if FailEditor then begin if Assigned(FOnFailEditor) then FOnFailEditor(Self, Col, Appt, EditorRect, FailEditor); if not FailEditor then FEditor.BorderStyle := bsSingle; end else FEditor.BorderStyle := bsNone; if not FailEditor then with FEditor do begin FEditor.LinkedAppt := Appt; BoundsRect := EditorRect; if agoFormattedDesc in Options then Text := Appt.Description else Text := StripCRLF(Appt.Description); Self.Update; // not calling update here increases flicker Visible := True; if not (csDesigning in ComponentState) and CanFocus then SetFocus; SelLength := 0; SelStart := 0; end; end; procedure TJvTFDays.FinishEditAppt; begin if Assigned(FEditor.LinkedAppt) then FEditor.LinkedAppt.Description := FEditor.Text; FEditor.Visible := False; end; function TJvTFDays.Editing: Boolean; begin Result := (FEditor <> nil) and FEditor.Visible; end; function TJvTFDays.CanEdit: Boolean; begin Result := agoShowText in Options; end; function TJvTFDays.RowsPerHour: Integer; begin Result := 60 div Granularity; end; function TJvTFDays.RowCount: Integer; var Adjustment, H, M, S, MS: Word; WorkTime: TTime; begin WorkTime := GridEndTime; DecodeTime(WorkTime, H, M, S, MS); Adjustment := 0; if (H = 0) and (M = 0) then begin WorkTime := EncodeTime(23, 59, 59, 999); Adjustment := 1; end; //DecodeTime(GridEndTime - GridStartTime, H, M, S, MS); DecodeTime(WorkTime - GridStartTime, H, M, S, MS); Result := (H * 60 + M) div Granularity + Adjustment; end; function TJvTFDays.PossVisibleRows: Integer; var DataHt: Integer; begin //group DataHt := GetAdjClientRect.Bottom - ColHdrHeight; DataHt := GetAdjClientRect.Bottom - CalcGroupColHdrsHeight; Result := DataHt div RowHeight; if DataHt mod RowHeight <> 0 then Inc(Result); end; function TJvTFDays.VisibleRows: Integer; begin Result := Lesser(PossVisibleRows, RowCount - TopRow); end; function TJvTFDays.FullVisibleRows: Integer; var Poss, Vis: Integer; begin Poss := PossVisibleRows; Vis := VisibleRows; if Poss = Vis then if GetDataHeight mod RowHeight = 0 then Result := Vis else Result := Vis - 1 else Result := Vis; end; function TJvTFDays.VisibleCols: Integer; var DataWidth, ColNum, TempColWidths: Integer; begin if Cols.Count > 0 then begin // Calc the width of the data area DataWidth := GetDataWidth; // loop through cols until sum of col widths is >= width of data area TempColWidths := 0; ColNum := LeftCol; repeat Inc(TempColWidths, Cols[ColNum].Width); Inc(ColNum); until (TempColWidths >= DataWidth) or (ColNum = Cols.Count); Result := ColNum - LeftCol; end else Result := 0; end; function TJvTFDays.FullVisibleCols: Integer; var I, lRightCol, TempWidth: Integer; begin // sum the widths of all visible cols lRightCol := LeftCol + VisibleCols - 1; TempWidth := 0; for I := LeftCol to lRightCol do Inc(TempWidth, Cols[I].Width); // if TempWidth > Data width then fully vis cols = one less the visible cols if TempWidth <= GetDataWidth then Result := VisibleCols else Result := VisibleCols - 1; end; function TJvTFDays.RowToTime(RowNum: Integer): TTime; var TotalMins: Integer; WorkHours, WorkMins: Word; H, M, S, MS: Word; Offset: Integer; begin EnsureRow(RowNum); DecodeTime(GridStartTime, H, M, S, MS); Offset := H * 60 + M; TotalMins := RowNum * Granularity + Offset; WorkHours := TotalMins div 60; WorkMins := TotalMins mod 60; if WorkHours < 24 then Result := EncodeTime(WorkHours, WorkMins, 0, 0) else Result := EncodeTime(23, 59, 59, 999); end; function TJvTFDays.TimeToRow(ATime: TTime): Integer; var TotalMins: Integer; WorkHours, WorkMins, WorkSecs, WorkMSecs: Word; H, M, S, MS: Word; Offset: Integer; begin DecodeTime(ATime, WorkHours, WorkMins, WorkSecs, WorkMSecs); // Convert the given time to minutes DecodeTime(GridStartTime, H, M, S, MS); Offset := H * 60 + M; TotalMins := WorkHours * 60 + WorkMins - Offset; // Find the row number by dividing the time in minutes by the granularity Result := TotalMins div Granularity; if (TotalMins < 0) and (TotalMins mod Granularity <> 0) then Dec(Result); end; procedure TJvTFDays.TimeToTop(ATime: TTime); begin TopRow := TimeToRow(ATime); end; function TJvTFDays.AdjustEndTime(ATime: TTime): TTime; begin Result := Frac(Frac(ATime) - Frac(EncodeTime(0, 0, 1, 0))); end; function TJvTFDays.RowStartsHour(RowNum: Integer): Boolean; var H, M, S, MS: Word; begin EnsureRow(RowNum); DecodeTime(RowToTime(RowNum), H, M, S, MS); Result := M = 0; end; function TJvTFDays.RowEndsHour(RowNum: Integer): Boolean; var H, M, S, MS: Word; TempTime: TTime; begin EnsureRow(RowNum); TempTime := RowToTime(RowNum) + EncodeTime(0, Granularity - 1, 0, 0); DecodeTime(TempTime, H, M, S, MS); Result := M = 59; end; function TJvTFDays.RowEndTime(RowNum: Integer): TTime; begin Result := RowToTime(RowNum) + Granularity * EncodeTime(0, 1, 0, 0) - EncodeTime(0, 0, 1, 0); end; function TJvTFDays.RowToHour(RowNum: Integer): Word; var H, M, S, MS: Word; begin DecodeTime(RowToTime(RowNum), H, M, S, MS); Result := H; end; function TJvTFDays.HourStartRow(Hour: Word): Integer; begin Result := TimeToRow(EncodeTime(Hour, 0, 0, 0)); end; function TJvTFDays.HourEndRow(Hour: Word): Integer; begin Result := TimeToRow(EncodeTime(Hour, 59, 0, 0)); end; function TJvTFDays.BottomRow: Integer; begin Result := TopRow + VisibleRows - 1; end; function TJvTFDays.RightCol: Integer; begin Result := LeftCol + VisibleCols - 1; end; procedure TJvTFDays.DragDrop(Source: TObject; X, Y: Integer); begin if Source is TJvTFControl then DropAppt(TJvTFControl(Source).DragInfo, X, Y); inherited DragDrop(Source, X, Y); end; procedure TJvTFDays.CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate; out StartRow, EndRow: Integer); begin if Trunc(AAppt.StartDate) = Trunc(SchedDate) then StartRow := TimeToRow(AAppt.StartTime) else StartRow := 0; if Trunc(AAppt.EndDate) = Trunc(SchedDate) then EndRow := TimeToRow(AdjustEndTime(AAppt.EndTime)) else EndRow := RowCount - 1; end; function TJvTFDays.CurrentDate: TDate; begin case Template.ActiveTemplate of agtLinear: Result := Template.LinearStartDate; agtComparative: Result := Template.CompDate; end; end; procedure TJvTFDays.PrevDate; begin case Template.ActiveTemplate of agtLinear: Template.LinearStartDate := Template.LinearStartDate - 1; agtComparative: Template.CompDate := Template.CompDate - 1; end; end; procedure TJvTFDays.NextDate; begin case Template.ActiveTemplate of agtLinear: Template.LinearStartDate := Template.LinearStartDate + 1; agtComparative: Template.CompDate := Template.CompDate + 1; end; end; procedure TJvTFDays.GotoDate(aDate: TDate); begin case Template.ActiveTemplate of agtLinear: Template.LinearStartDate := aDate; agtComparative: Template.CompDate := aDate; end; end; procedure TJvTFDays.ScrollDays(NumDays: Integer); var OldDate: TDate; CanScroll: Boolean; begin CanScroll := True; OldDate := Template.LinearStartDate; case Template.ActiveTemplate of agtLinear: OldDate := Template.LinearStartDate; agtComparative: OldDate := Template.CompDate; else CanScroll := False; end; if CanScroll then GotoDate(OldDate + NumDays); end; procedure TJvTFDays.ScrollMonths(NumMonths: Integer); var OldDate, EOM: TDate; CanScroll: Boolean; Y, M, D, EOMY, EOMM, EOMD, DeltaY, DeltaM: Word; begin CanScroll := True; OldDate := Template.LinearStartDate; case Template.ActiveTemplate of agtLinear: OldDate := Template.LinearStartDate; agtComparative: OldDate := Template.CompDate; else CanScroll := False; end; if CanScroll then begin DecodeDate(OldDate, Y, M, D); DeltaY := NumMonths div 12; DeltaM := NumMonths mod 12; M := M + DeltaM; if M < 1 then begin Dec(DeltaY); M := 12 + M; end else if M > 12 then begin Inc(DeltaY); M := M - 12; end; Y := Y + DeltaY; EOM := EndOfMonth(EncodeDate(Y, M, 1)); DecodeDate(EOM, EOMY, EOMM, EOMD); D := Lesser(D, EOMD); GotoDate(EncodeDate(Y, M, D)); end; end; procedure TJvTFDays.ScrollYears(NumYears: Integer); var OldDate, EOM: TDate; Y, M, D, EOMY, EOMM, EOMD: Word; CanScroll: Boolean; begin CanScroll := True; OldDate := Template.LinearStartDate; case Template.ActiveTemplate of agtLinear: OldDate := Template.LinearStartDate; agtComparative: OldDate := Template.CompDate; else CanScroll := False; end; if CanScroll then begin DecodeDate(OldDate, Y, M, D); Inc(Y, NumYears); EOM := EndOfMonth(EncodeDate(Y, M, 1)); DecodeDate(EOM, EOMY, EOMM, EOMD); D := Lesser(D, EOMD); GotoDate(EncodeDate(Y, M, D)); end; end; procedure TJvTFDays.ReleaseSchedule(const SchedName: string; SchedDate: TDate); var Used: Boolean; I: Integer; Col: TJvTFDaysCol; begin // Only release schedule if not used by any grid cols Used := False; for I := 0 to Cols.Count - 1 do begin Col := Cols[I]; if (Col.SchedName = SchedName) and (Trunc(Col.SchedDate) = Trunc(SchedDate)) and Col.Connected then Used := True and not (csDestroying in ScheduleManager.ComponentState); end; if not Used then inherited ReleaseSchedule(SchedName, SchedDate); end; procedure TJvTFDays.RowInView(ARow: Integer); begin EnsureRow(ARow); if ARow < TopRow then TopRow := ARow else if ARow > TopRow + FullVisibleRows - 1 then TopRow := Greater(ARow - FullVisibleRows + 1, 0); end; procedure TJvTFDays.ColInView(ACol: Integer); var I, ColSizes: Integer; DataWidth: Integer; begin EnsureCol(ACol); if ACol < LeftCol then LeftCol := ACol else if ACol > RightCol then begin ColSizes := 0; DataWidth := RectWidth(GetDataAreaRect); I := ACol + 1; while (ColSizes < DataWidth) and (I >= 0) do begin Dec(I); Inc(ColSizes, Cols[I].Width); end; LeftCol := I + 1; end; end; function TJvTFDays.CellIsSelected(ACell: TPoint): Boolean; var SelSameName, SelSameDate: Boolean; NameList: TStringList; I, TestStart, TestEnd: Integer; TestDate: TDate; function PointInDataArea(APoint: TPoint): Boolean; begin Result := (APoint.X > gcHdr) and (APoint.Y > gcHdr); end; begin Result := False; if PointInDataArea(SelStart) and PointInDataArea(SelEnd) and PointInDataArea(ACell) then begin SelSameName := Cols[SelStart.X].SchedName = Cols[SelEnd.X].SchedName; SelSameDate := Trunc(Cols[SelStart.X].SchedDate) = Trunc(Cols[SelEnd.X].SchedDate); if SelSameName and SelSameDate then begin if (Cols[ACell.X].SchedName = Cols[SelStart.X].SchedName) and (Trunc(Cols[ACell.X].SchedDate) = Trunc(Cols[SelStart.X].SchedDate)) then Result := (ACell.Y >= SelStart.Y) and (ACell.Y <= SelEnd.Y) end else if SelSameName then begin if Cols[ACell.X].SchedName = Cols[SelStart.X].SchedName then begin TestDate := Cols[ACell.X].SchedDate; if Trunc(TestDate) = Trunc(Cols[SelStart.X].SchedDate) then Result := ACell.Y >= SelStart.Y else if (Trunc(TestDate) > Trunc(Cols[SelStart.X].SchedDate)) and (Trunc(TestDate) < Trunc(Cols[SelEnd.X].SchedDate)) then Result := True else if Trunc(TestDate) = Trunc(Cols[SelEnd.X].SchedDate) then Result := ACell.Y <= SelEnd.Y; end end else if SelSameDate then begin NameList := TStringList.Create; NameList.Sorted := True; NameList.Duplicates := dupIgnore; try for I := SelStart.X to SelEnd.X do NameList.Add(Cols[I].SchedName); if (NameList.IndexOf(Cols[ACell.X].SchedName) > -1) and (Trunc(Cols[SelStart.X].SchedDate) = Trunc(Cols[ACell.X].SchedDate)) then begin TestStart := Lesser(SelStart.Y, SelEnd.Y); TestEnd := Greater(SelStart.Y, SelEnd.Y); Result := (ACell.Y >= TestStart) and (ACell.Y <= TestEnd); end; finally NameList.Free; end; end; end; end; function TJvTFDays.ColIsSelected(ACol: Integer): Boolean; var SelSameName, SelSameDate: Boolean; I: Integer; StartCol, EndCol, TestCol: TJvTFDaysCol; begin Result := False; if (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then // Don't know if we really should be doing the follow check //and (ACol >= SelStart.X) and (ACol <= SelEnd.X) then begin // Determine type of selection (case) StartCol := Cols[SelStart.X]; EndCol := Cols[SelEnd.X]; TestCol := Cols[ACol]; SelSameName := StartCol.SchedName = EndCol.SchedName; SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate); if SelSameName and SelSameDate then Result := (TestCol.SchedName = StartCol.SchedName) and (Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate)) else if SelSameName then Result := (TestCol.SchedName = StartCol.SchedName) and (Trunc(TestCol.SchedDate) >= Trunc(StartCol.SchedDate)) and (Trunc(TestCol.SchedDate) <= Trunc(EndCol.SchedDate)) else if SelSameDate then if Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate) then begin I := SelStart.X; while (I <= SelEnd.X) and not Result do if TestCol.SchedName = Cols[I].SchedName then Result := True else Inc(I); end; end; end; function TJvTFDays.RowIsSelected(ARow: Integer): Boolean; var SelSameName, SelSameDate: Boolean; StartCol, EndCol: TJvTFDaysCol; begin Result := False; if (SelStart.Y > gcHdr) and (SelEnd.Y > gcHdr) and (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then begin StartCol := Cols[SelStart.X]; EndCol := Cols[SelEnd.X]; SelSameName := StartCol.SchedName = EndCol.SchedName; SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate); if (SelSameName and SelSameDate) or SelSameDate then Result := (ARow >= SelStart.Y) and (ARow <= SelEnd.Y) else if SelSameName then Result := (ARow >= SelStart.Y) or (ARow <= SelEnd.Y); end; end; procedure TJvTFDays.ClearSelection; begin SelStart := Point(-1, -1); end; function TJvTFDays.ValidSelection: Boolean; begin Result := (SelStart.X > gcHdr) and (SelStart.Y > gcHdr) and (SelEnd.X > gcHdr) and (SelEnd.Y > gcHdr); end; function TJvTFDays.EnumSelCells: TDynPointArray; var SelSameName, SelSameDate: Boolean; NameList: TStringList; NextEntry, ACol, ARow: Integer; TestDate: TDate; procedure AddToArray(X, Y: Integer); begin Result[NextEntry] := Point(X, Y); Inc(NextEntry); end; procedure BumpLength(Bump: Integer); begin SetLength(Result, Length(Result) + Bump); end; begin SetLength(Result, 0); NextEntry := 0; // EXIT IF NOTHING SELECTED if (SelStart.X <= gcHdr) or (SelStart.Y <= gcHdr) or (SelEnd.X <= gcHdr) or (SelEnd.Y <= gcHdr) then Exit; SelSameName := Cols[SelStart.X].SchedName = Cols[SelEnd.X].SchedName; SelSameDate := Trunc(Cols[SelStart.X].SchedDate) = Trunc(Cols[SelEnd.X].SchedDate); if SelSameName and SelSameDate then for ACol := 0 to Cols.Count - 1 do begin if (Cols[ACol].SchedName = Cols[SelStart.X].SchedName) and (Trunc(Cols[ACol].SchedDate) = Trunc(Cols[SelStart.X].SchedDate)) then begin BumpLength(SelEnd.Y - SelStart.Y + 1); for ARow := SelStart.Y to SelEnd.Y do AddToArray(ACol, ARow); end; end else if SelSameName then // only have to go to SelEnd.X?? // What about if two cols have same SchedName and SchedDate?? for ACol := 0 to Cols.Count - 1 do begin if Cols[ACol].SchedName = Cols[SelStart.X].SchedName then begin TestDate := Cols[ACol].SchedDate; if Trunc(TestDate) = Trunc(Cols[SelStart.X].SchedDate) then begin BumpLength(RowCount - SelStart.Y); for ARow := SelStart.Y to RowCount - 1 do AddToArray(ACol, ARow); end else if (Trunc(TestDate) > Trunc(Cols[SelStart.X].SchedDate)) and (Trunc(TestDate) < Trunc(Cols[SelEnd.X].SchedDate)) then begin BumpLength(RowCount); for ARow := 0 to RowCount - 1 do AddToArray(ACol, ARow); end else if Trunc(TestDate) = Trunc(Cols[SelEnd.X].SchedDate) then begin BumpLength(SelEnd.Y + 1); for ARow := 0 to SelEnd.Y do AddToArray(ACol, ARow); end; end; end else if SelSameDate then begin NameList := TStringList.Create; NameList.Sorted := True; NameList.Duplicates := dupIgnore; TestDate := Cols[SelStart.X].SchedDate; try for ACol := SelStart.X to SelEnd.X do NameList.Add(Cols[ACol].SchedName); for ACol := 0 to Cols.Count - 1 do if (NameList.IndexOf(Cols[ACol].SchedName) > -1) and (Trunc(Cols[ACol].SchedDate) = Trunc(TestDate)) then begin BumpLength(SelEnd.Y - SelStart.Y + 1); for ARow := SelStart.Y to SelEnd.Y do AddToArray(ACol, ARow); end; finally NameList.Free; end; end; end; function TJvTFDays.EnumSelCols: TDynIntArray; var SelSameName, SelSameDate: Boolean; I: Integer; TempList: TStringList; StartCol, EndCol, TestCol: TJvTFDaysCol; procedure AddToArray(ACol: Integer); begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := ACol; end; begin SetLength(Result, 0); if (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then begin StartCol := Cols[SelStart.X]; EndCol := Cols[SelEnd.X]; SelSameName := StartCol.SchedName = EndCol.SchedName; SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate); if SelSameName and SelSameDate then for I := 0 to Cols.Count - 1 do begin TestCol := Cols[I]; if (TestCol.SchedName = StartCol.SchedName) and (Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate)) then AddToArray(I); end else if SelSameName then for I := 0 to Cols.Count - 1 do begin TestCol := Cols[I]; if (TestCol.SchedName = StartCol.SchedName) and ((Trunc(TestCol.SchedDate) >= Trunc(StartCol.SchedDate)) and (Trunc(TestCol.SchedDate) <= Trunc(EndCol.SchedDate))) then AddToArray(I); end else if SelSameDate then begin TempList := TStringList.Create; TempList.Sorted := True; TempList.Duplicates := dupIgnore; try for I := SelStart.X to SelEnd.X do TempList.Add(Cols[I].SchedName); for I := 0 to Cols.Count - 1 do begin TestCol := Cols[I]; if (Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate)) and (TempList.IndexOf(TestCol.SchedName) > -1) then AddToArray(I); end; finally TempList.Free; end; end; end; end; function TJvTFDays.EnumSelRows: TDynIntArray; var SelSameName, SelSameDate: Boolean; StartCol, EndCol: TJvTFDaysCol; I: Integer; procedure AddToArray(ACol: Integer); begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := ACol; end; begin SetLength(Result, 0); if (SelStart.Y > gcHdr) and (SelEnd.Y > gcHdr) and (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then begin StartCol := Cols[SelStart.X]; EndCol := Cols[SelEnd.X]; SelSameName := StartCol.SchedName = EndCol.SchedName; SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate); if (SelSameName and SelSameDate) or SelSameDate then for I := SelStart.Y to SelEnd.Y do AddToArray(I) else if SelSameName then for I := 0 to RowCount - 1 do if (I >= SelStart.Y) or (I <= SelEnd.Y) then AddToArray(I); end; end; function TJvTFDays.GetApptDispColor(Appt: TJvTFAppt; Selected: Boolean): TColor; begin if Selected then if SelApptAttr.Color = clDefault then if Appt.Color = clDefault then Result := ApptAttr.Color else Result := Appt.Color else Result := SelApptAttr.Color else if Appt.Color = clDefault then Result := ApptAttr.Color else Result := Appt.Color; end; procedure TJvTFDays.ReqSchedNotification(Schedule: TJvTFSched); var I: Integer; Col: TJvTFDaysCol; begin inherited ReqSchedNotification(Schedule); for I := 0 to Cols.Count - 1 do begin Col := Cols[I]; if (Col.SchedName = Schedule.SchedName) and (Trunc(Col.SchedDate) = Trunc(Schedule.SchedDate)) then Col.Connect; end; end; procedure TJvTFDays.SelFirstAppt; var FirstAppt: TJvTFAppt; RefCol: Integer; begin RefCol := 0; FirstAppt := nil; while not Assigned(FirstAppt) and (RefCol < Cols.Count) do begin FirstAppt := Cols[RefCol].GetFirstAppt; Inc(RefCol); end; if Assigned(FirstAppt) then begin SelAppt := FirstAppt; // The actual Reference Col will be one less than RefCol coming out of // the above loop. ApptInView(FirstAppt, RefCol - 1); SelApptCell(FirstAppt, RefCol - 1); end; end; procedure TJvTFDays.SelLastAppt; var LastAppt: TJvTFAppt; RefCol: Integer; begin RefCol := Cols.Count - 1; LastAppt := nil; while not Assigned(LastAppt) and (RefCol > -1) do begin LastAppt := Cols[RefCol].GetLastAppt; Dec(RefCol); end; if Assigned(LastAppt) then begin SelAppt := LastAppt; ApptInView(LastAppt, RefCol + 1); SelApptCell(LastAppt, RefCol + 1); end; { if Cols.Count > 0 then LastAppt := Cols[Cols.Count - 1].GetLastAppt; if not Assigned(LastAppt) and (Cols.Count > 1) then begin RefCol := Cols.Count - 2; while not Assigned(LastAppt) and (RefCol >= 0) do begin LastAppt := Cols[RefCol].GetLastAppt; Dec(RefCol); end; if Assigned(LastAppt) then Inc(RefCol); end; SelAppt := LastAppt; ApptInView(LastAppt, RefCol); SelApptCell(LastAppt, RefCol); } end; procedure TJvTFDays.SelNextAppt; var RefAppt, NextAppt: TJvTFAppt; RefCol: Integer; begin RefAppt := SelAppt; RefCol := FocusedCol; if RefCol < 0 then RefCol := 0; NextAppt := nil; while not Assigned(NextAppt) and (RefCol < Cols.Count) do begin NextAppt := Cols[RefCol].GetNextAppt(RefAppt); Inc(RefCol); end; if Assigned(NextAppt) then begin SelAppt := NextAppt; ApptInView(NextAppt, RefCol - 1); SelApptCell(NextAppt, RefCol - 1); end; { RefAppt := SelAppt; RefCol := Greater(FocusedCol, 0); if Assigned(RefAppt) then NextAppt := Cols[RefCol].GetNextAppt(RefAppt) else NextAppt := Cols[RefCol].GetFirstAppt; if not Assigned(NextAppt) then begin NextCol := RefCol + 1; if NextCol = Cols.Count then NextCol := 0; while not Assigned(NextAppt) and (NextCol <> RefCol) do begin NextAppt := Cols[NextCol].GetFirstAppt; if not Assigned(NextAppt) then begin Inc(NextCol); if NextCol = Cols.Count then NextCol := 0; end; end; RefCol := NextCol; end; SelAppt := NextAppt; ApptInView(NextAppt, RefCol); SelApptCell(NextAppt, RefCol); } end; procedure TJvTFDays.SelPrevAppt; var RefAppt, PrevAppt: TJvTFAppt; RefCol: Integer; begin RefAppt := SelAppt; RefCol := FocusedCol; if RefCol < 0 then RefCol := Cols.Count - 1; PrevAppt := nil; while not Assigned(PrevAppt) and (RefCol > -1) do begin PrevAppt := Cols[RefCol].GetPrevAppt(RefAppt); Dec(RefCol); end; if Assigned(PrevAppt) then begin SelAppt := PrevAppt; ApptInView(PrevAppt, RefCol + 1); SelApptCell(PrevAppt, RefCol + 1); end; { if Assigned(RefAppt) then PrevAppt := Cols[RefCol].GetPrevAppt(RefAppt) else PrevAppt := Cols[RefCol].GetFirstAppt; if not Assigned(PrevAppt) then begin PrevCol := RefCol - 1; if PrevCol = -1 then PrevCol := Cols.Count - 1; while not Assigned(PrevAppt) and (PrevCol <> RefCol) do begin PrevAppt := Cols[PrevCol].GetLastAppt; if not Assigned(PrevAppt) then begin Dec(PrevCol); if PrevCol = -1 then PrevCol := Cols.Count - 1; end; end; RefCol := PrevCol; end; SelAppt := PrevAppt; ApptInView(PrevAppt, RefCol); SelApptCell(PrevAppt, RefCol); } end; procedure TJvTFDays.ApptInView(AAppt: TJvTFAppt; ACol: Integer); var StartRow, EndRow: Integer; begin if Assigned(AAppt) and Assigned(Cols[ACol].Schedule) then begin CalcStartEndRows(AAppt, Cols[ACol].Schedule.SchedDate, StartRow, EndRow); RowInView(StartRow); ColInView(ACol); //TopRow := StartRow; //LeftCol := ACol; end; end; procedure TJvTFDays.SelApptCell(AAppt: TJvTFAppt; ACol: Integer); var StartRow, EndRow: Integer; begin if Assigned(AAppt) and Assigned(Cols[ACol].Schedule) and (Cols[ACol].Schedule.ApptByID(AAppt.ID) <> nil) then begin CalcStartEndRows(AAppt, Cols[ACol].Schedule.SchedDate, StartRow, EndRow); SelStart := Point(ACol, StartRow); FocusedCol := ACol; FocusedRow := StartRow; end; end; procedure TJvTFDays.SetGrouping(Value: TJvTFDaysGrouping); var CheckSB: Boolean; begin if Value <> FGrouping then begin CheckSB := (Value = grNone) or (FGrouping = grNone); FGrouping := Value; Cols.UpdateTitles; if CheckSB then begin AlignScrollBars; if not (csLoading in ComponentState) then begin CheckSBVis; CheckSBParams; end; end; Invalidate; end; end; { procedure TJvTFDays.SetGroupTitles; var I: Integer; begin Case Grouping of grNone : For I := 0 to Cols.Count - 1 do begin Cols[I].GroupTitle := ''; //Cols[I].UpdateTitle; Cols[I].UpdateTitles; end; grDate : For I := 0 to Cols.Count - 1 do begin Cols[I].GroupTitle := FormatDateTime(DateFormat, Cols[I].SchedDate); Cols[I].Title := Cols[I].SchedName; end; grResource : For I := 0 to Cols.Count - 1 do begin Cols[I].GroupTitle := Cols[I].SchedName; Cols[I].Title := FormatDateTime(DateFormat, Cols[I].SchedDate); end; grCustom : For I := 0 to Cols.Count - 1 do begin Cols[I].GroupTitle := ''; end; end; end; } procedure TJvTFDays.SetTFHintProps(Value: TJvTFHintProps); begin FHintProps.Assign(Value); end; procedure TJvTFDays.DrawDither(ACanvas: TCanvas; ARect: TRect; Color1, Color2: TColor); var DitherBitmap: TBitmap; I, J: Integer; begin DitherBitmap := TBitmap.Create; try // create dithered bitmap DitherBitmap.Width := 8; DitherBitmap.Height := 8; for I := 0 to DitherBitmap.Width - 1 do for J := 0 to DitherBitmap.Height - 1 do if (I + J) mod 2 = 0 then DitherBitmap.Canvas.Pixels[I, J] := Color1 else DitherBitmap.Canvas.Pixels[I, J] := Color2; ACanvas.Brush.Bitmap := DitherBitmap; ACanvas.FillRect(ARect); finally DitherBitmap.Free; end; end; procedure TJvTFDays.SelFirstApptNextCol; var FirstAppt: TJvTFAppt; RefCol: Integer; begin RefCol := FocusedCol + 1; FirstAppt := nil; while not Assigned(FirstAppt) and (RefCol < Cols.Count) do begin FirstAppt := Cols[RefCol].GetFirstAppt; Inc(RefCol); end; if Assigned(FirstAppt) then begin SelAppt := FirstAppt; // The actual Reference Col will be one less than RefCol coming out of // the above loop. ApptInView(FirstAppt, RefCol - 1); SelApptCell(FirstAppt, RefCol - 1); end; end; procedure TJvTFDays.SelFirstApptPrevCol; var FirstAppt: TJvTFAppt; RefCol: Integer; begin if Cols.Count = 0 then Exit; RefCol := FocusedCol - 1; if RefCol < 0 then RefCol := 0; FirstAppt := nil; while not Assigned(FirstAppt) and (RefCol > -1) do begin FirstAppt := Cols[RefCol].GetFirstAppt; Dec(RefCol); end; if Assigned(FirstAppt) then begin SelAppt := FirstAppt; ApptInView(FirstAppt, RefCol + 1); SelApptCell(FirstAppt, RefCol + 1); end; end; procedure TJvTFDays.SetGroupHdrHeight(Value: Integer); begin if Value > RectHeight(GetAdjClientRect) then Value := RectHeight(GetAdjClientRect); if Value < 0 then Value := 0; if Value <> FGroupHdrHeight then begin FGroupHdrHeight := Value; AlignScrollBars; if not (csLoading in ComponentState) then begin CheckSBVis; CheckSBParams; Invalidate; end; end; end; function TJvTFDays.IsStoredGroupHdrHeight: Boolean; begin Result := FGroupHdrHeight <> Scale96ToFont(DEFAULT_GROUP_HDR_HEIGHT); end; procedure TJvTFDays.DrawGroupHdrs(ACanvas: TCanvas); var CurrGroup: string; I: Integer; begin if (CalcGroupHdrHeight > 0) and (Cols.Count > 0) then begin CurrGroup := Cols[LeftCol].GroupTitle; DrawColGroupHdr(ACanvas, LeftCol, True); for I := LeftCol + 1 to RightCol do if Cols[I].GroupTitle <> CurrGroup then begin CurrGroup := Cols[I].GroupTitle; DrawColGroupHdr(ACanvas, I, True); end; end; end; function TJvTFDays.CalcGroupColHdrsHeight: Integer; begin Result := CalcGroupHdrHeight + ColHdrHeight; end; function TJvTFDays.CalcGroupHdrHeight: Integer; begin if Grouping = grNone then Result := 0 else Result := GroupHdrHeight; end; function TJvTFDays.VirtualGroupHdrRect(Col: Integer): TRect; var GroupStartCol: Integer = -1; // to silence the compiler GroupEndCol: Integer = -1; // dto. I, GroupWidth: Integer; begin EnsureCol(Col); Result.Top := 0; Result.Bottom := CalcGroupHdrHeight; GetGroupStartEndCols(Col, GroupStartCol, GroupEndCol); GroupWidth := 0; for I := GroupStartCol to GroupEndCol do Inc(GroupWidth, Cols[I].Width); {$IFDEF Jv_TIMEBLOCKS} // ok Result.Left := CalcBlockRowHdrsWidth; {$ELSE} // remove //Result.Left := RowHdrWidth; {$ENDIF Jv_TIMEBLOCKS} // At most, only one of the following For loops will execute // depending on whether Col is to the left or to the right of LeftCol for I := LeftCol - 1 downto GroupStartCol do Dec(Result.Left, Cols[I].Width); for I := LeftCol to GroupStartCol - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + GroupWidth; end; procedure TJvTFDays.GetGroupStartEndCols(Col: Integer; var StartCol, EndCol: Integer); var I: Integer; begin EnsureCol(Col); // find group start col I := Col; while (I >= 0) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do begin StartCol := I; Dec(I); end; // find group end col I := Col; while (I < Cols.Count) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do begin EndCol := I; Inc(I); end; end; (* procedure TJvTFDays.DrawGroupHdr(ACanvas: TCanvas; ACol: Integer); var ARect: TRect; Attr: TJvTFDaysHdrAttr; begin ARect := VirtualGroupHdrRect(ACol); if GroupHdrIsSelected(ACol) then Attr := SelGroupHdrAttr else Attr := GroupHdrAttr; With ACanvas do begin Font.Assign(Attr.Font); Brush.Color := Attr.Color; FillRect(ARect); { Brush.Color := clWhite; FillRect(ARect); Pen.Color := clBlack; MoveTo(ARect.Left, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom - 1); MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Left, ARect.Bottom - 1); } { MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom - 1); LineTo(ARect.Left, ARect.Bottom - 1); } { end; end; *) procedure TJvTFDays.SetGroupHdrAttr(Value: TJvTFDaysHdrAttr); begin FGroupHdrAttr.Assign(Value); Invalidate; end; procedure TJvTFDays.SetSelGroupHdrAttr(Value: TJvTFDaysHdrAttr); begin FSelGroupHdrAttr.Assign(Value); Invalidate; end; function TJvTFDays.GroupHdrIsSelected(ACol: Integer): Boolean; var I: Integer; GroupStartCol: Integer = -1; // to silence the compiler GroupEndCol: Integer = -1; // dto. begin GetGroupStartEndCols(ACol, GroupStartCol, GroupEndCol); Result := False; I := GroupStartCol; while (I <= GroupEndCol) and not Result do begin if ColIsSelected(I) then Result := True; Inc(I); end; end; procedure TJvTFDays.DrawColGroupHdr(ACanvas: TCanvas; Index: Integer; IsGroupHdr: Boolean); var ARect, TxtRect, CalcRect, TxtBounds: TRect; Txt: string; PTxt: PChar; UseAttr: TJvTFDaysHdrAttr; Flags: UINT; TxtHt, TxtRectHt: Integer; begin if IsGroupHdr then begin ARect := VirtualGroupHdrRect(Index); ARect.Left := Greater(ARect.Left, GetDataAreaRect.Left); Txt := Copy(Cols[Index].GroupTitle, 1, Length(Cols[Index].GroupTitle)); if GroupHdrIsSelected(Index) then UseAttr := SelGroupHdrAttr else UseAttr := GroupHdrAttr; end else begin ARect := CellRect(Index, -1); //Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title)); Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title)); if ColIsSelected(Index) then UseAttr := SelHdrAttr else UseAttr := HdrAttr; end; ACanvas.Brush.Color := UseAttr.Color; ACanvas.Font.Assign(UseAttr.Font); Flags := DT_NOPREFIX or DT_CENTER; case ColTitleStyle of ctsSingleClip: Flags := Flags or DT_SINGLELINE or DT_VCENTER; ctsSingleEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER; ctsMultiClip: Flags := Flags or DT_WORDBREAK; ctsMultiEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or DT_EDITCONTROL; ctsHide: Flags := Flags or DT_SINGLELINE or DT_VCENTER; end; ACanvas.FillRect(ARect); TxtRect := ARect; InflateRect(TxtRect, -2, -2); CalcRect := TxtRect; // Allocate length of Txt + 4 chars // (1 char for null terminator, 3 chars for ellipsis) // Ahh, what the hell. Allocate + dozen chars for good measure. // (This is continuing to give me problems and I don't know why.) //PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char)); PTxt := StrAlloc((Length(Txt) + 12) * SizeOf(Char)); try StrPCopy(PTxt, Txt); if (ColTitleStyle = ctsMultiClip) or (ColTitleStyle = ctsMultiEllipsis) then begin TxtHt := DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT); // "reset" PTxt StrPCopy(PTxt, Txt); if TxtHt < RectHeight(TxtRect) then begin // we need to vertically center the text TxtRectHt := RectHeight(TxtRect); TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2; TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom); end; end else if ColTitleStyle = ctsHide then begin DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT); if RectWidth(CalcRect) > RectWidth(TxtRect) then StrPCopy(PTxt, ''); end {$IFDEF Jv_TIMEBLOCKS} // okay to leave else if ColTitleStyle = ctsRotated then //DrawAngleText(ACanvas, TxtRect, UseAttr.TitleRotation, Txt); DrawAngleText(ACanvas, TxtRect, TxtBounds, UseAttr.TitleRotation, taCenter, vaCenter, Txt); {$ELSE} // remove //; // semi-colon needed to terminate last end {$ENDIF Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS} // okay to leave if ColTitleStyle <> ctsRotated then DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags); {$ELSE} // remove //Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags); {$ENDIF Jv_TIMEBLOCKS} finally StrDispose(PTxt); end; if not IsGroupHdr and (Index = FocusedCol) and Focused then begin CalcRect := ARect; InflateRect(CalcRect, -2, -2); ManualFocusRect(ACanvas, CalcRect); { if Windows.IsRectEmpty(TxtRect) then Windows.InflateRect(TxtRect, 5, 5); ManualFocusRect(ACanvas, TxtRect); } end; {$IFDEF Jv_TIMEBLOCKS} // okay to leave DrawFrame(ACanvas, ARect, UseAttr.Frame3D, UseAttr.FrameColor); {$ELSE} // remove //DrawFrame(ACanvas, ARect, UseAttr.Frame3D); {$ENDIF Jv_TIMEBLOCKS} if IsGroupHdr then begin if Assigned(FOnDrawGroupHdr) then FOnDrawGroupHdr(Self, ACanvas, ARect, Index, GroupHdrIsSelected(Index)); end else if Assigned(FOnDrawColHdr) then FOnDrawColHdr(Self, ACanvas, ARect, Index, ColIsSelected(Index)); end; {$IFDEF Jv_TIMEBLOCKS} // ok procedure TJvTFDays.SetTimeBlocks(Value: TJvTFDaysTimeBlocks); begin FTimeBlocks.Assign(Value); end; procedure TJvTFDays.SetTimeBlockProps(Value: TJvTFDaysBlockProps); begin FTimeBlockProps.Assign(Value); end; procedure TJvTFDays.SetWeekend(Value: TTFDaysOfWeek); begin if Value <> FWeekend then begin FWeekend := Value; Invalidate; end; end; procedure TJvTFDays.SetWeekendColor(Value: TColor); begin if Value <> FWeekendColor then begin FWeekendColor := Value; UpdateWeekendFillPic; Invalidate; end; end; procedure TJvTFDays.UpdateWeekendFillPic; begin FWeekendFillPic.Canvas.Brush.Color := WeekendColor; FWeekendFillPic.Canvas.FillRect(Classes.Rect(0, 0, FWeekendFillPic.Width, FWeekendFillPic.Height)); end; procedure TJvTFDays.DrawBlockHdr(ACanvas: TCanvas; BlockIndex: Integer); var StartRow: Integer = -1; EndRow: Integer = -1; ARect, HdrPicRect, TxtBounds: TRect; ClipIt: Boolean; Attr: TJvTFDaysHdrAttr; TimeBlock: TJvTFDaysTimeBlock; HdrPic: TBitmap; begin TimeBlock := TimeBlocks[BlockIndex]; GetTimeBlockStartEnd(BlockIndex, StartRow, EndRow); //ARect := VirtualBlockHdrRect(StartRow); ARect := CellRect(gcGroupHdr, StartRow); HdrPicRect := VirtualBlockHdrRect(StartRow); ClipIt := HdrPicRect.Top < ARect.Top; OffsetRect(HdrPicRect, -HdrPicRect.Left, -HdrPicRect.Top); HdrPic := TBitmap.Create; try HdrPic.Width := RectWidth(HdrPicRect); HdrPic.Height := RectHeight(HdrPicRect); if BlockHdrIsSelected(StartRow) then Attr := TimeBlockProps.SelBlockHdrAttr else Attr := TimeBlockProps.BlockHdrAttr; //With ACanvas do with HdrPic.Canvas do begin Brush.Color := Attr.Color; FillRect(HdrPicRect); Font.Assign(Attr.Font); //DrawAngleText(HdrPic.Canvas, HdrPicRect, Attr.TitleRotation, //TimeBlock.Title); DrawAngleText(HdrPic.Canvas, HdrPicRect, TxtBounds, Attr.TitleRotation, taCenter, vaCenter, TimeBlock.Title); if Attr.Frame3D then DrawFrame(HdrPic.Canvas, HdrPicRect, True, Attr.FrameColor) else begin Pen.Color := Attr.FrameColor; MoveTo(HdrPicRect.Right - 1, HdrPicRect.Top); LineTo(HdrPicRect.Right - 1, HdrPicRect.Bottom); MoveTo(HdrPicRect.Left, HdrPicRect.Bottom - 1); LineTo(HdrPicRect.Right, HdrPicRect.Bottom - 1); end; end; if ClipIt then HdrPicRect.Top := HdrPicRect.Bottom - RectHeight(ARect); BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect), RectHeight(ARect), HdrPic.Canvas.Handle, 0, HdrPicRect.Top, SRCCOPY); finally HdrPic.Free; end; end; procedure TJvTFDays.FillBlockHdrDeadSpace(ACanvas: TCanvas); var ARect: TRect; StartRow: Integer = -1; EndRow: Integer = -1; procedure FillIt; begin with ACanvas do begin //Brush.Color := TimeBlockProps.BlockHdrAttr.Color; Brush.Color := TimeBlockProps.OffTimeColor; FillRect(ARect); Pen.Color := TimeBlockProps.BlockHdrAttr.FrameColor; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom); MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); end; end; begin if TimeBlocks.Count = 0 then Exit; ARect.Left := 0; ARect.Right := CalcBlockHdrWidth; GetTimeBlockStartEnd(0, StartRow, EndRow); if StartRow > TopRow then begin ARect.Top := CalcGroupColHdrsHeight; ARect.Bottom := Lesser(VirtualBlockHdrRect(StartRow).Top, GetDataAreaRect.Bottom); FillIt; end; GetTimeBlockStartEnd(TimeBlocks.Count - 1, StartRow, EndRow); if EndRow < BottomRow then begin ARect.Top := Greater(VirtualBlockHdrRect(EndRow).Bottom, GetDataAreaRect.Top); ARect.Bottom := GetDataAreaRect.Bottom; FillIt; end; end; ////////////////////////////////////////////////////////////////// // Credit for the CalcTextPos routine goes to Joerg Lingner. // // It comes from his JLLabel component (freeware - Torry's). // // It is used here with his permission. Thanks Joerg! // // He can be reached at jlingner att t-online dott de // ////////////////////////////////////////////////////////////////// { procedure TJvTFDays.CalcTextPos(var ARect: TRect; aAngle: Integer; aTxt: string); //========================================================================== // Calculate text pos. depend. on: Font, Escapement, Alignment and length //-------------------------------------------------------------------------- var DC : HDC; hSavFont: HFont; Size : TSize; x,y : Integer; cStr : array [0..255] of Char; SaveRect: TRect; begin aAngle := aAngle div 10; SaveRect := ARect; StrPCopy(cStr, aTxt); DC := GetDC(HWND_DESKTOP); hSavFont := SelectObject(DC, Font.Handle); GetTextExtentPoint32(DC, cStr, Length(aTxt), Size); SelectObject(DC, hSavFont); ReleaseDC(HWND_DESKTOP, DC); x := 0; y := 0; if aAngle<=90 then begin // 1.Quadrant x := 0; y := Trunc(Size.cx * sin(aAngle*Pi/180)); end else if aAngle<=180 then begin // 2.Quadrant x := Trunc(Size.cx * -cos(aAngle*Pi/180)); y := Trunc(Size.cx * sin(aAngle*Pi/180) + Size.cy * cos((180-aAngle)*Pi/180)); end else if aAngle<=270 then begin // 3.Quadrant x := Trunc(Size.cx * -cos(aAngle*Pi/180) + Size.cy * sin((aAngle-180)*Pi/180)); y := Trunc(Size.cy * sin((270-aAngle)*Pi/180)); end else if aAngle<=360 then begin // 4.Quadrant x := Trunc(Size.cy * sin((360-aAngle)*Pi/180)); y := 0; end; ARect.Top := ARect.Top + y; ARect.Left := ARect.Left + x; x := Abs(Trunc(Size.cx * cos(aAngle*Pi/180))) + Abs(Trunc(Size.cy * sin(aAngle*Pi/180))); y := Abs(Trunc(Size.cx * sin(aAngle*Pi/180))) + Abs(Trunc(Size.cy * cos(aAngle*Pi/180))); //Mike: ARect.Left := ARect.Left + ((RectWidth(SaveRect) - X) div 2); // align center //ARect.Left := ARect.Left + RectWidth(SaveRect) - X; // align right ARect.Top := ARect.Top + ((RectHeight(SaveRect) - Y) div 2); // align center //ARect.Top := ARect.Top + RectHeight(SaveRect) - Y; // align bottom end; } { procedure TJvTFDays.DrawAngleText(ACanvas: TCanvas; ARect: TRect; aAngle: Integer; aTxt: string); var LogFont: TLogFont; TxtRect: TRect; Flags: UINT; PTxt: PChar; ClipRgn: HRgn; begin TxtRect := ARect; CalcTextPos(TxtRect, aAngle, aTxt); Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont); LogFont.lfEscapement := aAngle; LogFont.lfOrientation := LogFont.lfEscapement; ACanvas.Font.Handle := CreateFontIndirect(LogFont); Flags := DT_NOPREFIX or DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE; PTxt := StrAlloc((Length(aTxt) + 4) * SizeOf(Char)); StrPCopy(PTxt, aTxt); ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); Windows.SelectClipRgn(ACanvas.Handle, ClipRgn); Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags); Windows.SelectClipRgn(ACanvas.Handle, 0); Windows.DeleteObject(ClipRgn); StrDispose(PTxt); ACanvas.Font.Handle := 0; end; } procedure TJvTFDays.EnsureBlockRules(GridGran, BlockGran: Integer; DayStart: TTime); var GridHrs, GridMins, BlockHrs, BlockMins, S, MS: Word; RowStartTime: TTime; begin if TimeBlocks.Count > 0 then begin if GridGran > BlockGran then raise EJvTFBlockGranError.CreateRes(@RsEGridGranularityCannotBeGreater); if (BlockGran mod GridGran) <> 0 then raise EJvTFBlockGranError.CreateRes(@RsETimeBlockGranularityMustBeEvenly); DecodeTime(DayStart, BlockHrs, BlockMins, S, MS); RowStartTime := RowToTime(TimeToRow(DayStart)); DecodeTime(RowStartTime, GridHrs, GridMins, S, MS); if (BlockHrs <> GridHrs) or (BlockMins <> GridMins) then raise EJvTFBlockGranError.CreateRes(@RsETimeBlocksMustBeginExactlyOn); end; end; function TJvTFDays.ValidateBlockRules(GridGran, BlockGran: Integer; DayStart: TTime): Boolean; var GridHrs, GridMins, BlockHrs, BlockMins, S, MS: Word; RowStartTime: TTime; begin Result := True; if TimeBlocks.Count > 0 then begin if GridGran > BlockGran then Result := False; if (BlockGran mod GridGran) <> 0 then Result := False; DecodeTime(DayStart, BlockHrs, BlockMins, S, MS); RowStartTime := RowToTime(TimeToRow(DayStart)); DecodeTime(RowStartTime, GridHrs, GridMins, S, MS); if (BlockHrs <> GridHrs) or (BlockMins <> GridMins) then Result := False; end; end; function TJvTFDays.RowToTimeBlock(ARow: Integer): Integer; var I: Integer; BlockStart: Integer = -1; BlockEnd: Integer = -1; begin Result := -1; if TimeBlocks.Count = 0 then Exit; I := 0; repeat GetTimeBlockStartEnd(I, BlockStart, BlockEnd); if (BlockStart <= ARow) and (ARow <= BlockEnd) then Result := I; Inc(I); until (I = TimeBlocks.Count) or (Result <> -1); end; procedure TJvTFDays.GetTimeBlockStartEnd(ATimeBlock: Integer; out BlockStart, BlockEnd: Integer); var I: Integer; begin if ATimeBlock < 0 then begin BlockStart := -1; BlockEnd := -1; Exit; end; BlockStart := TimeToRow(TimeBlockProps.DayStart); I := 0; while (I < ATimeBlock) do begin //Inc(BlockStart, TimeBlocks[I].Length); Inc(BlockStart, TimeBlocks[I].GridLength); Inc(I); end; //BlockEnd := BlockStart + TimeBlocks[ATimeBlock].Length - 1; BlockEnd := BlockStart + TimeBlocks[ATimeBlock].GridLength - 1; end; function TJvTFDays.CalcBlockHdrWidth: Integer; begin if TimeBlocks.Count > 0 then Result := TimeBlockProps.BlockHdrWidth else Result := 0; end; function TJvTFDays.CalcBlockRowHdrsWidth: Integer; begin Result := CalcBlockHdrWidth + RowHdrWidth; end; procedure TJvTFDays.GetBlockStartEndRows(Row: Integer; out StartRow, EndRow: Integer); begin GetTimeBlockStartEnd(RowToTimeBlock(Row), StartRow, EndRow); end; function TJvTFDays.VirtualBlockHdrRect(Row: Integer): TRect; var BlockStartRow: Integer = -1; BlockEndRow: Integer = -1; BlockHeight: Integer; begin EnsureRow(Row); Result.Left := 0; Result.Right := CalcBlockHdrWidth; GetBlockStartEndRows(Row, BlockStartRow, BlockEndRow); BlockHeight := (BlockEndRow - BlockStartRow + 1) * RowHeight; Result.Top := CalcGroupColHdrsHeight + ((BlockStartRow - TopRow) * RowHeight); Result.Bottom := Result.Top + BlockHeight; end; function TJvTFDays.IsWeekend(ColIndex: Integer): Boolean; begin Result := BorlToDOW(DayOfWeek(Cols[ColIndex].SchedDate)) in Weekend; end; function TJvTFDays.BlockHdrIsSelected(ARow: Integer): Boolean; var I: Integer; StartRow: Integer = -1; EndRow: Integer = -1; begin GetBlockStartEndRows(ARow, StartRow, EndRow); Result := False; I := StartRow; while (I <= EndRow) and not Result do begin if RowIsSelected(I) then Result := True; Inc(I); end; end; procedure TJvTFDays.DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean; FrameColour: TColor); var OldPenColor: TColor; begin with ACanvas, ARect do begin OldPenColor := Pen.Color; if Draw3D then Pen.Color := clBtnShadow else Pen.Color := FrameColour; MoveTo(Right - 1, Top); LineTo(Right - 1, Bottom); MoveTo(Left, Bottom - 1); LineTo(Right, Bottom - 1); if Draw3D then begin Pen.Color := clBtnHighlight; MoveTo(Left, Top); LineTo(Right, Top); MoveTo(Left, Top); LineTo(Left, Bottom); end; Pen.Color := OldPenColor; end; end; {$ENDIF Jv_TIMEBLOCKS} procedure TJvTFDays.SetGridEndTime(Value: TTime); var I, NewTopRow: Integer; TopTime: TTime; WorkEnd: TTime; H, M, S, MS: Word; begin WorkEnd := Value; DecodeTime(WorkEnd, H, M, S, MS); if (H = 0) and (M = 0) then WorkEnd := EncodeTime(23, 59, 59, 999); if not (csLoading in ComponentState) and (WorkEnd <= GridStartTime) then raise EJvTFDaysError.CreateRes(@RsEGridEndTimeCannotBePriorToGridStart); TopTime := RowToTime(TopRow); FGridEndTime := Value; ClearSelection; if not (csLoading in ComponentState) then begin for I := 0 to Cols.Count - 1 do Cols[I].RefreshMap; //TopRow := TimeToRow(TopTime); if RowCount <= PossVisibleRows then TopRow := 0 else begin if TopTime < GridStartTime then NewTopRow := 0 else NewTopRow := TimeToRow(TopTime); TopRow := Lesser(NewTopRow, RowCount - 1 - VisibleRows + 1); end; CheckSBVis; CheckSBParams; Invalidate; end; end; procedure TJvTFDays.SetGridStartTime(Value: TTime); var I, NewTopRow: Integer; TopTime: TTime; WorkEnd: TTime; H, M, S, MS: Word; begin WorkEnd := GridEndTime; DecodeTime(WorkEnd, H, M, S, MS); if (H = 0) and (M = 0) then WorkEnd := EncodeTime(23, 59, 59, 999); if not (csLoading in ComponentState) and (Value >= WorkEnd) then raise EJvTFDaysError.CreateRes(@RsEGridStartTimeCannotBeAfterGridEndTi); TopTime := RowToTime(TopRow); FGridStartTime := Value; ClearSelection; if not (csLoading in ComponentState) then begin for I := 0 to Cols.Count - 1 do Cols[I].RefreshMap; //TopRow := TimeToRow(TopTime); if RowCount <= PossVisibleRows then TopRow := 0 else begin if TopTime < GridStartTime then NewTopRow := 0 else NewTopRow := TimeToRow(TopTime); TopRow := Lesser(NewTopRow, RowCount - 1 - VisibleRows + 1); end; CheckSBVis; CheckSBParams; Invalidate; end; end; procedure TJvTFDays.WMTimer(var Msg: TLMTimer); var I, TempWidth: Integer; PtInfo: TJvTFDaysCoord; OldTopRow, OldLeftCol: Integer; X, Y: Integer; begin if Cols.Count = 0 then Exit; OldTopRow := TopRow; OldLeftCol := LeftCol; case FAutoScrollDir of asdUp: TopRow := Greater(TopRow - 1, 0); asdDown: TopRow := Lesser(TopRow + 1, RowCount - FullVisibleRows); asdLeft: LeftCol := Greater(LeftCol - 1, 0); asdRight: begin TempWidth := 0; for I := LeftCol to Cols.Count - 1 do Inc(TempWidth, Cols[I].Width); if TempWidth > GetDataWidth then LeftCol := LeftCol + 1; end; end; if (FAutoScrollDir <> asdNowhere) and ((TopRow <> OldTopRow) or (LeftCol <> OldLeftCol)) then begin X := FMouseMovePt.X; Y := FMouseMovePt.Y; if State <> agsMoveAppt then MouseMove(FMouseMoveState, X, Y); Update; PtInfo := PtToCell(FMouseMovePt.X, FMouseMovePt.Y); if Y >= GetDataAreaRect.Bottom then PtInfo.Row := Lesser(BottomRow + 1, RowCount - 1); if State = agsSizeAppt then begin DrawDrag(PtInfo, nil, False); ContinueDragging(PtInfo, nil); end else if State = agsMoveAppt then begin DrawDrag(PtInfo, FDragInfo.Appt, False); FDraggingCoord.Row := PtInfo.Row; end; end; end; procedure TJvTFDays.KillAutoScrollTimer; begin if FLiveTimer then begin FLiveTimer := False; KillTimer(Handle, 1); end; end; procedure TJvTFDays.Navigate(AControl: TJvTFControl; SchedNames: TStringList; Dates: TJvTFDateList); var I, J: Integer; ACol: TJvTFDaysCol; begin inherited Navigate(AControl, SchedNames, Dates); if not Template.IgnoreNav and (Dates.Count > 0) then case Template.ActiveTemplate of agtLinear: Template.LinearStartDate := Dates[0]; agtComparative: Template.CompDate := Dates[0]; agtNone: begin Cols.BeginUpdate; try Cols.Clear; if Grouping = grDate then for I := 0 to Dates.Count - 1 do for J := 0 to SchedNames.Count - 1 do begin ACol := Cols.Add; ACol.SchedName := SchedNames[J]; ACol.SchedDate := Dates[I]; end else for I := 0 to SchedNames.Count - 1 do for J := 0 to Dates.Count - 1 do begin ACol := Cols.Add; ACol.SchedName := SchedNames[I]; ACol.SchedDate := Dates[J]; end; finally Cols.EndUpdate; end; end; end; end; { procedure TJvTFDays.ReorderCols; var NewList: TStringList; I, Slot: Integer; ColToAdd: TJvTFDaysCol; function SortCompare: Boolean; var CurrCol: TJvTFDaysCol; begin CurrCol := TJvTFDaysCol(NewList.Objects[Slot]); if Grouping = grDate then Result := Trunc(CurrCol.SchedDate) > Trunc(ColToAdd.SchedDate) else if Grouping = grResource then Result := CurrCol.SchedName > ColToAdd.SchedName else Result := True; end; begin NewList := TStringList.Create; Try For I := 0 to Cols.Count - 1 do begin ColToAdd := Cols[I]; Slot := 0; while (Slot < NewList.Count) and not SortCompare do Inc(Slot); NewList.InsertObject(Slot, '', ColToAdd); end; For I := 0 to NewList.Count - 1 do TJvTFDaysCol(NewList.Objects[I]).Index := I; Finally NewList.Free; end; end; } //procedure TJvTFDays.DoNavigate; //var // SchedNameList: TStringList; // DateList: TJvTFDateList; // I, // SMIndex: Integer; // ACol: TJvTFDaysCol; //begin // if not Assigned(Navigator) then // Exit; // // SchedNameList := TStringList.Create; // DateList := TJvTFDateList.Create; // try // for I := 0 to Cols.Count - 1 do // begin // ACol := Cols[I]; // if ColIsSelected(I) then // begin // SMIndex := SchedNameList.IndexOf(ACol.SchedName); // if SMIndex = -1 then // SchedNameList.Add(ACol.SchedName); // DateList.Add(ACol.SchedDate); // end; // end; // // Navigator.Navigate(Self, SchedNameList, DateList); // finally // SchedNameList.Free; // DateList.Free; // end; //end; function TJvTFDays.GetTFHintClass: TJvTFHintClass; begin Result := TJvTFHint; end; procedure TJvTFDays.DoApptHint(GridCoord: TJvTFDaysCoord); var ApptRect, VisApptRect: TRect; begin if Assigned(GridCoord.Appt) and not Editing and (agoShowApptHints in Options) then begin VisApptRect := EmptyRect; ApptRect := GetApptRect(GridCoord.Col, GridCoord.Appt); IntersectRect(VisApptRect, ApptRect, GetDataAreaRect); FHint.ApptHint(GridCoord.Appt, VisApptRect.Left + 2, VisApptRect.Bottom + 2, True, True, agoFormattedDesc in Options); end; end; procedure TJvTFDays.DoCellHint(GridCoord: TJvTFDaysCoord); var ColHdrRect: TRect; HintText: string; begin if csDesigning in ComponentState then Exit; if (GridCoord.Row = -1) and (GridCoord.Col > -1) and (agoShowColHdrHints in Options) then HintText := Cols[GridCoord.Col].Title else HintText := ''; ColHdrRect := CellRect(GridCoord.Col, GridCoord.Row); FHint.CellHint(GridCoord.Row, GridCoord.Col, HintText, ColHdrRect); end; procedure TJvTFDays.GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo; AAppt: TJvTFAppt; Attr: TJvTFDaysApptAttr); begin DrawInfo.Color := GetApptDispColor(AAppt, AAppt = SelAppt); DrawInfo.FrameColor := Attr.FrameColor; DrawInfo.FrameWidth := Attr.FrameWidth; DrawInfo.Font := Attr.Font; DrawInfo.Visible := True; if Assigned(FOnGetApptDrawInfo) then FOnGetApptDrawInfo(Self, AAppt, DrawInfo); end; // move grab handles //function TJvTFDays.GetBottomGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect; //begin // Result := Classes.Rect(0, 0, 0, 0); // if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and // Cols[Col].ApptInCol(Appt) then // begin // Result := GetApptRect(Col, Appt); // Result.Top := Result.Bottom - GrabHandles.Height; // Windows.OffsetRect(Result, 0, GrabHandles.Height); // end; //end; // //// move grab handles //function TJvTFDays.GetTopGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect; //begin // Result := Classes.Rect(0, 0, 0, 0); // if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and // Cols[Col].ApptInCol(Appt) then // begin // Result := GetApptRect(Col, Appt); // Result.Bottom := Result.Top + GrabHandles.Height; // Windows.OffsetRect(Result, 0, -GrabHandles.Height); // end; //end; // move grab handles function TJvTFDays.GetBottomGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect; begin Result := Classes.Rect(0, 0, 0, 0); // if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and if (Col > gcHdr) and Assigned(Appt) and Cols[Col].ApptInCol(Appt) then begin Result := GetApptRect(Col, Appt); Result.Top := Result.Bottom - GrabHandles.Height; OffsetRect(Result, 0, GrabHandles.Height); end; end; // move grab handles function TJvTFDays.GetTopGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect; begin Result := Classes.Rect(0, 0, 0, 0); // if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and if (Col > gcHdr) and Assigned(Appt) and Cols[Col].ApptInCol(Appt) then begin Result := GetApptRect(Col, Appt); Result.Bottom := Result.Top + GrabHandles.Height; OffsetRect(Result, 0, -GrabHandles.Height); end; end; function TJvTFDays.PtInBottomHandle(APoint: TPoint; Col: Integer; Appt: TJvTFAppt): Boolean; var HandleRect: TRect; begin Result := False; // move grab handles if Assigned(Appt) and Cols[Col].ApptInCol(Appt) then begin HandleRect := GetBottomGrabHandleRect(Col, Appt); Result := PtInRect(HandleRect, APoint) and (agoSizeAppt in Options); end; end; function TJvTFDays.PtInTopHandle(APoint: TPoint; Col: Integer; Appt: TJvTFAppt): Boolean; var HandleRect: TRect; begin Result := False; // move grab handles if Assigned(Appt) and Cols[Col].ApptInCol(Appt) then begin HandleRect := GetTopGrabHandleRect(Col, Appt); Result := PtInRect(HandleRect, APoint) and (agoMoveAppt in Options); end; end; procedure TJvTFDays.SetDitheredBackground(const Value: Boolean); begin FDitheredBackground := Value; Refresh; end; procedure TJvTFDays.SetShowFocus(const Value: Boolean); begin if FShowFocus <> Value then begin FShowFocus := Value; Invalidate; end; end; class function TJvTFDays.GetControlClassDefaultSize: TSize; begin Result.CX := 500; Result.CY := 300; end; //=== { TJvTFDaysPrinter } =================================================== constructor TJvTFDaysPrinter.Create(AOwner: TComponent); begin inherited Create(AOwner); FGroupHdrHeight := 25; FPageInfoList := TStringList.Create; FApptAttr := TJvTFDaysApptAttr.Create(nil); FApptBar := TJvTFDaysApptBar.Create(nil); FCols := TJvTFDaysCols.CreateForPrinter(Self); FFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(nil); FHdrAttr := TJvTFDaysHdrAttr.Create(nil); FGroupHdrAttr := TJvTFDaysHdrAttr.Create(nil); FPrimeTime := TJvTFDaysPrimeTime.Create(nil); FThresholds := TJvTFDaysThresholds.Create(nil); end; destructor TJvTFDaysPrinter.Destroy; begin FCols.Free; FApptAttr.Free; FApptBar.Free; FFancyRowHdrAttr.Free; FHdrAttr.Free; FGroupHdrAttr.Free; FPrimeTime.Free; FThresholds.Free; // ClearPageInfo *MUST* be called here. FreeDoc will not call ClearPageInfo // since we are freeing FPageInfoList here and the inherited Destroy calls // FreeDoc. (That call to FreeDoc would call ClearPageInfo AFTER // FPageInfoList has been destroyed.) ClearPageInfo; FPageInfoList.Free; FPageInfoList := nil; inherited Destroy; end; function TJvTFDaysPrinter.AdjustEndTime(ATime: TTime): TTime; begin Result := Frac(Frac(ATime) - Frac(EncodeTime(0, 0, 1, 0))); end; procedure TJvTFDaysPrinter.CalcPageColInfo(ShowRowHdrs: Boolean; out CalcColsPerPage, CalcColWidth: Integer); var DataWidth, TargetColsPerPage: Integer; begin // Calculate the cols per page if DaysPageLayout.ColsPerPage = 0 then TargetColsPerPage := Cols.Count else TargetColsPerPage := DaysPageLayout.ColsPerPage; DataWidth := GetDataWidth(ShowRowHdrs); if TargetColsPerPage > 0 then begin CalcColWidth := DataWidth div TargetColsPerPage; CalcColWidth := Greater(CalcColWidth, MinColWidth); CalcColsPerPage := DataWidth div CalcColWidth; end else begin CalcColsPerPage := 1; CalcColWidth := DataWidth; end; end; procedure TJvTFDaysPrinter.CalcPageInfo; var Segments: TStringList; lPageInfo, SegmentInfo: TJvTFDaysPageInfo; WorkRowHeight, WorkRowsPerPage, WorkColWidth, WorkColsPerPage: Integer; CurrRow, CurrCol, I, WorkEndCol: Integer; WorkShowRowHdr: Boolean; begin // ALL MEASUREMENTS ARE ASSUMED TO BE IN PIXELS !! ClearPageInfo; // Calculate the segments // A segment is concerned with rows only (if all rows fit on one page then // there is one segment. if the rows fit on two pages then there are two // segments...) Segments := TStringList.Create; try // create the segments CurrRow := 0; while CurrRow < RowCount do begin lPageInfo := TJvTFDaysPageInfo.Create; Segments.AddObject('', lPageInfo); with lPageInfo do begin PageNum := Segments.Count; StartRow := CurrRow; ShowColHdr := (CurrRow = 0) or DaysPageLayout.AlwaysShowColHdr; CalcPageRowInfo(ShowColHdr, WorkRowsPerPage, WorkRowHeight); EndRow := Lesser(CurrRow + WorkRowsPerPage - 1, RowCount - 1); RowHeight := WorkRowHeight; end; CurrRow := lPageInfo.EndRow + 1; end; // create the pages CurrCol := 0; while CurrCol < Cols.Count do begin WorkShowRowHdr := (CurrCol = 0) or DaysPageLayout.AlwaysShowRowHdr; CalcPageColInfo(WorkShowRowHdr, WorkColsPerPage, WorkColWidth); WorkEndCol := CurrCol + WorkColsPerPage - 1; WorkEndCol := Lesser(WorkEndCol, Cols.Count - 1); for I := 0 to Segments.Count - 1 do begin SegmentInfo := TJvTFDaysPageInfo(Segments.Objects[I]); lPageInfo := TJvTFDaysPageInfo.Create; FPageInfoList.AddObject('', lPageInfo); with lPageInfo do begin PageNum := FPageInfoList.Count; StartRow := SegmentInfo.StartRow; EndRow := SegmentInfo.EndRow; RowHeight := SegmentInfo.RowHeight; ShowColHdr := SegmentInfo.ShowColHdr; StartCol := CurrCol; EndCol := WorkEndCol; ColWidth := WorkColWidth; ShowRowHdr := WorkShowRowHdr; end; end; CurrCol := WorkEndCol + 1; end; finally // clean up the segments while Segments.Count > 0 do begin Segments.Objects[0].Free; Segments.Delete(0); end; Segments.Free; FValidPageInfo := True; end; end; procedure TJvTFDaysPrinter.CalcPageRowInfo(ShowColHdrs: Boolean; out CalcRowsPerPage, CalcRowHeight: Integer); var DataHeight, TargetRowsPerPage: Integer; begin // Calculate the rows per page if DaysPageLayout.RowsPerPage = 0 then TargetRowsPerPage := RowCount else TargetRowsPerPage := DaysPageLayout.RowsPerPage; DataHeight := GetDataHeight(ShowColHdrs); CalcRowHeight := DataHeight div TargetRowsPerPage; CalcRowHeight := Greater(CalcRowHeight, MinRowHeight); CalcRowsPerPage := DataHeight div CalcRowHeight; end; procedure TJvTFDaysPrinter.CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate; out StartRow, EndRow: Integer); begin if Trunc(AAppt.StartDate) = Trunc(SchedDate) then StartRow := TimeToRow(AAppt.StartTime) else StartRow := 0; if Trunc(AAppt.EndDate) = Trunc(SchedDate) then EndRow := TimeToRow(AdjustEndTime(AAppt.EndTime)) else EndRow := RowCount - 1; end; procedure TJvTFDaysPrinter.CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect; PicsHeight, PicsWidth: Integer; out CanDrawText, CanDrawPics: Boolean); var TextHeightThreshold, TextWidthThreshold: Integer; begin TextHeightThreshold := ACanvas.TextHeight('Wq') * Thresholds.TextHeight; TextWidthThreshold := ACanvas.TextWidth('Bi') div 2 * Thresholds.TextWidth; if TextHeightThreshold < RectHeight(ApptRect) then begin CanDrawText := RectWidth(ApptRect) >= TextWidthThreshold; CanDrawPics := True; end else if Thresholds.DropTextFirst then begin CanDrawText := False; CanDrawPics := True; if Thresholds.WholePicsOnly then if PicsHeight > RectHeight(ApptRect) then CanDrawPics := False; end else begin CanDrawText := (RectHeight(ApptRect) >= TextHeightThreshold) and (RectWidth(ApptRect) >= TextWidthThreshold); CanDrawPics := False; end; if not ShowPics then CanDrawPics := False; if not ShowText then CanDrawText := False; end; function TJvTFDaysPrinter.CellRect(Col, Row: Integer; PageInfo: TJvTFDaysPageInfo): TRect; var VisGrpHdrRect: TRect; begin Result := EmptyRect; if (Row = gcGroupHdr) and (Col > gcHdr) then begin VisGrpHdrRect := Classes.Rect(RowHdrWidth, 0, RowHdrWidth + GetDataWidth(PageInfo.ShowRowHdr), CalcGroupHdrHeight); IntersectRect(Result, VisGrpHdrRect, VirtualGroupHdrRect(Col, PageInfo)); end else if Col < 0 then // Row hdr if Row < 0 then // origin cell if PageInfo.ShowColHdr and PageInfo.ShowRowHdr then //group Result := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight) Result := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight) else Result := EmptyRect else if (Row >= PageInfo.StartRow) and (Row <= PageInfo.EndRow) then // Row Hdr for visible data row if PageInfo.ShowRowHdr then begin Result.Left := 0; if PageInfo.ShowColHdr then //group Result.Top := ColHdrHeight Result.Top := CalcGroupColHdrsHeight else Result.Top := 0; Result.Top := Result.Top + (Row - PageInfo.StartRow) * PageInfo.RowHeight; Result.Right := RowHdrWidth; Result.Bottom := Result.Top + PageInfo.RowHeight; end else Result := EmptyRect else // Row Hdr for non-visible data row Result := EmptyRect else if (Col >= PageInfo.StartCol) and (Col <= PageInfo.EndCol) then // visible data col if Row < 0 then // Col hdr for visible data col if PageInfo.ShowColHdr then begin if PageInfo.ShowRowHdr then Result.Left := RowHdrWidth else Result.Left := 0; Inc(Result.Left, PageInfo.ColWidth * (Col - PageInfo.StartCol)); Result.Right := Result.Left + PageInfo.ColWidth; { variable width columns, leave for future reference For I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; } //group Result.Top := 0; Result.Top := CalcGroupHdrHeight; //group Result.Bottom := ColHdrHeight; Result.Bottom := Result.Top + ColHdrHeight; end else Result := EmptyRect else if (Row >= PageInfo.StartRow) and (Row <= PageInfo.EndRow) then // visible data cell begin if PageInfo.ShowRowHdr then Result.Left := RowHdrWidth else Result.Left := 0; Inc(Result.Left, PageInfo.ColWidth * (Col - PageInfo.StartCol)); Result.Right := Result.Left + PageInfo.ColWidth; { variable width cols, leave for future reference For I := LeftCol to Col - 1 do Inc(Result.Left, Cols[I].Width); Result.Right := Result.Left + Cols[Col].Width; } if PageInfo.ShowColHdr then //group Result.Top := ColHdrHeight Result.Top := CalcGroupColHdrsHeight else Result.Top := 0; Inc(Result.Top, (Row - PageInfo.StartRow) * PageInfo.RowHeight); Result.Bottom := Result.Top + PageInfo.RowHeight; end else // non-visible data cell (visible col, but non-visible row) Result := EmptyRect else // non-visible data col Result := EmptyRect; end; procedure TJvTFDaysPrinter.ClearPageInfo; begin if not Assigned(FPageInfoList) then Exit; while FPageInfoList.Count > 0 do begin FPageInfoList.Objects[0].Free; FPageInfoList.Delete(0); end; FValidPageInfo := False; end; procedure TJvTFDaysPrinter.ClearPicDrawList(DrawList: TList); begin while DrawList.Count > 0 do begin TJvTFDrawPicInfo(DrawList[0]).Free; DrawList.Delete(0); end; end; procedure TJvTFDaysPrinter.CreateLayout; begin FPageLayout := TJvTFDaysPrinterPageLayout.Create(Self); end; procedure TJvTFDaysPrinter.CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt; DrawList: TList); var I, NextPicLeft, ImageIndex, PicWidth: Integer; ImageList: TCustomImageList; ImageMap: TJvTFStateImageMap; CustomImageMap: TJvTFCustomImageMap; procedure AddToList(AImageList: TCustomImageList; AImageIndex: Integer; APicLeft, APicTop: Integer); var DrawInfo: TJvTFDrawPicInfo; begin DrawInfo := TJvTFDrawPicInfo.Create; DrawInfo.ImageList := AImageList; DrawInfo.ImageIndex := AImageIndex; DrawInfo.PicLeft := APicLeft; DrawInfo.PicTop := APicTop; DrawList.Add(DrawInfo); end; begin NextPicLeft := ARect.Left; if ShowPics and Assigned(ScheduleManager.CustomImages) then begin ImageList := ScheduleManager.CustomImages; CustomImageMap := Appt.ImageMap; PicWidth := ScreenToPrinter(ImageList.Width + 2, True); for I := 0 to CustomImageMap.Count - 1 do begin ImageIndex := CustomImageMap[I]; AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top); Inc(NextPicLeft, PicWidth); end; end; if ShowPics and Assigned(ScheduleManager.StateImages) then begin ImageList := ScheduleManager.StateImages; PicWidth := ScreenToPrinter(ImageList.Width + 2, True); ImageMap := ScheduleManager.StateImageMap; if Appt.AlarmEnabled then begin ImageIndex := ImageMap.AlarmEnabled; if ImageIndex > -1 then begin AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top); Inc(NextPicLeft, PicWidth); end end else begin ImageIndex := ImageMap.AlarmDisabled; if ImageIndex > -1 then begin AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top); Inc(NextPicLeft, PicWidth); end; end; ImageIndex := ImageMap.Shared; if Appt.Shared and (ImageIndex > -1) then begin AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top); // The following line generates a compiler hint so comment out, // but leave here as reminder in case method is expanded. //Inc(NextPicLeft, ImageList.Width + 2); end; { don't show modified pic in printed page if Appt.Modified and (ImageMap.Modified > -1) then begin AddToList(ImageList, ImageMap.Modified, NextPicLeft, ARect.Top); // The following line generates a compiler hint so comment out, // but leave here as reminder in case method is expanded. //Inc(NextPicLeft, ImageList.Width + 2); end; } end; end; function TJvTFDaysPrinter.DaysPageLayout: TJvTFDaysPrinterPageLayout; begin Result := TJvTFDaysPrinterPageLayout(PageLayout); end; {*************************************************************************** * The following routine was based off of a routine originally found in the * PrinterDemo #1 project of Earl F. Glynn's Computer Lab and is used with * permission. * http://www.efg2.com/Lab/OtherProjects/PrinterDemo1.htm * * This routine solves a color "washing" problem encountered on some printers. * It demonstrates the proper use of StretchDIBits. Many thanks to Earl * for providing the Computer Lab. This solution saved me several hours * of research and trial and error. ****************************************************************************} procedure TJvTFDaysPrinter.PrintBitmap(ACanvas: TCanvas; SourceRect, DestRect: TRect; aBitmap: TBitmap); { var BitmapHeader: pBitmapInfo; BitmapImage: POINTER; HeaderSize: LongWord; ImageSize: LongWord; } begin { wp --- to do (GetDIBSizes not in LCL) GetDIBSizes(aBitmap.Handle, HeaderSize, ImageSize); GetMem(BitmapHeader, HeaderSize); GetMem(BitmapImage, ImageSize); try GetDIB(aBitmap.Handle, aBitmap.Palette, BitmapHeader^, BitmapImage^); StretchDIBits(ACanvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, SourceRect.Left, SourceRect.Top, RectWidth(SourceRect), RectHeight(SourceRect), BitmapImage, TBitmapInfo(BitmapHeader^), DIB_RGB_COLORS, SRCCOPY); finally FreeMem(BitmapHeader); FreeMem(BitmapImage) end; } end; procedure TJvTFDaysPrinter.DrawAppt(ACanvas: TCanvas; Col: Integer; Appt: TJvTFAppt; StartRow, EndRow: Integer; PageInfo: TJvTFDaysPageInfo); var ApptRect, DataRect: TRect; ClipRgn: HRgn; begin ApptRect := GetApptRect(Col, Appt, PageInfo); if IsRectEmpty(ApptRect) then Exit; // Printer bug start, fixed // Calc the data area rect on the given canvas if PageInfo.ShowRowHdr then DataRect.Left := RowHdrWidth else DataRect.Left := 0; if PageInfo.ShowColHdr then DataRect.Top := CalcGroupColHdrsHeight else DataRect.Top := 0; DataRect.Right := DataRect.Left + BodyWidth; DataRect.Bottom := DataRect.Top + BodyHeight; // Need to add BodyLeft and BodyTop to account for ViewPortOrg adjustment ClipRgn := CreateRectRgn(DataRect.Left + BodyLeft, DataRect.Top + BodyTop, DataRect.Right + BodyLeft, DataRect.Bottom + BodyTop); SelectClipRgn(ACanvas.Handle, ClipRgn); DrawApptDetail(ACanvas, ApptRect, Appt, Col, StartRow, EndRow); SelectClipRgn(ACanvas.Handle, 0); DeleteObject(ClipRgn); // Printer bug end, fixed end; function TJvTFDaysPrinter.CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer): TRect; var Offset, ApptLength: TTime; ColDate: TDate; StartPercent, EndPercent: Double; begin Result := BarRect; if StartRow < 0 then StartRow := 0; if EndRow > RowCount - 1 then EndRow := RowCount - 1; Offset := RowToTime(StartRow); ApptLength := RowEndTime(EndRow) - Offset; ColDate := Cols[Col].SchedDate; if Trunc(ColDate) <> Trunc(Appt.StartDate) then StartPercent := 0 else StartPercent := (Appt.StartTime - Offset) / ApptLength; if Trunc(ColDate) <> Trunc(Appt.EndDate) then EndPercent := 1.0 else EndPercent := (Appt.EndTime - Offset) / ApptLength; Result.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) + BarRect.Top; Result.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) + BarRect.Top; end; procedure TJvTFDaysPrinter.DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect); var OldColor: TColor; StampLeft: Integer; begin with ACanvas do case ApptBar.TimeStampStyle of tssFullI: begin OldColor := Pen.Color; Pen.Color := ApptBar.TimeStampColor; Pen.Width := ScreenToPrinter(2, False); MoveTo(TimeStampRect.Left + 1, TimeStampRect.Top); LineTo(TimeStampRect.Right - 1, TimeStampRect.Top); MoveTo(TimeStampRect.Left + 1, TimeStampRect.Bottom - 1); LineTo(TimeStampRect.Right - 1, TimeStampRect.Bottom - 1); if ApptBar.Width > 5 then Pen.Width := ScreenToPrinter(2, True) else Pen.Width := ScreenToPrinter(1, True); // Printer bug, fixed StampLeft := TimeStampRect.Left + RectWidth(TimeStampRect) div 2; MoveTo(StampLeft, TimeStampRect.Top + 1); LineTo(StampLeft, TimeStampRect.Bottom - 1); Pen.Width := 1; Pen.Color := OldColor; end; tssHalfI: begin // we only want the left half of the time stamp rect TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2; OldColor := Pen.Color; Pen.Color := ApptBar.TimeStampColor; Pen.Width := ScreenToPrinter(2, False); MoveTo(TimeStampRect.Left, TimeStampRect.Top); LineTo(TimeStampRect.Right - 0, TimeStampRect.Top); MoveTo(TimeStampRect.Left, TimeStampRect.Bottom - 0); LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom - 0); if ApptBar.Width > 5 then Pen.Width := ScreenToPrinter(2, True) else Pen.Width := ScreenToPrinter(1, True); MoveTo(TimeStampRect.Right - 0, TimeStampRect.Top + 1); LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom); Pen.Color := OldColor; Pen.Width := 1; end; tssBlock: begin // we only want the left half of the time stamp rect TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2; OldColor := Brush.Color; Brush.Color := ApptBar.TimeStampColor; FillRect(TimeStampRect); Brush.Color := OldColor; end; end; end; procedure TJvTFDaysPrinter.DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer); var OldColor: TColor; TimeStampRect: TRect; begin with ACanvas do begin // Fill Bar Color OldColor := Brush.Color; if Appt.BarColor = clDefault then Brush.Color := ApptBar.Color else Brush.Color := Appt.BarColor; FillRect(BarRect); Brush.Color := OldColor; // Draw Bar Border Pen.Width := 1; Pen.Color := ApptAttr.FrameColor; MoveTo(BarRect.Right - 1, BarRect.Top); LineTo(BarRect.Right - 1, BarRect.Bottom); // Draw Time Stamp TimeStampRect := CalcTimeStampRect(Appt, BarRect, Col, StartRow, EndRow); if ApptBar.TimeStampStyle <> tssNone then DrawTimeStamp(ACanvas, TimeStampRect); if Assigned(FOnDrawApptBar) then FOnDrawApptBar(Self, ACanvas, Appt, Col, BarRect, TimeStampRect); end; end; { procedure TJvTFDaysPrinter.DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect; Col, StartRow, EndRow: Integer); var OldColor: TColor; MarkerRect: TRect; Offset, ApptLength: TTime; ColDate: TDate; StartPercent, EndPercent: Double; begin With ACanvas do begin // Fill Bar Color OldColor := Brush.Color; if Appt.BarColor = clDefault then Brush.Color := ApptBar.Color else Brush.Color := Appt.BarColor; FillRect(BarRect); Brush.Color := OldColor; // Draw Bar Border Pen.Width := 1; Pen.Color := ApptAttr.FrameColor; MoveTo(BarRect.Right - 1, BarRect.Top); LineTo(BarRect.Right - 1, BarRect.Bottom); // Draw Time Stamp Case ApptBar.TimeStampStyle of tssFullI : begin MarkerRect := BarRect; Offset := RowToTime(StartRow); ApptLength := RowEndTime(EndRow) - Offset; ColDate := Cols[Col].SchedDate; if Trunc(ColDate) <> Trunc(Appt.StartDate) then StartPercent := 0 else StartPercent := (Appt.StartTime - Offset) / ApptLength; if Trunc(ColDate) <> Trunc(Appt.EndDate) then EndPercent := 1.0 else EndPercent := (Appt.EndTime - Offset) / ApptLength; MarkerRect.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) + BarRect.Top; MarkerRect.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) + BarRect.Top; OldColor := Pen.Color; Pen.Color := ApptBar.TimeStampColor; Pen.Width := ScreenToPrinter(2, False); MoveTo(MarkerRect.Left + 1, MarkerRect.Top); LineTo(MarkerRect.Right - 1, MarkerRect.Top); MoveTo(MarkerRect.Left + 1, MarkerRect.Bottom - 1); LineTo(MarkerRect.Right - 1, MarkerRect.Bottom - 1); if ApptBar.Width > 5 then Pen.Width := ScreenToPrinter(2, True) else Pen.Width := ScreenToPrinter(1, True); MoveTo((MarkerRect.Right) div 2, MarkerRect.Top + 1); LineTo((MarkerRect.Right) div 2, MarkerRect.Bottom - 1); Pen.Width := 1; Pen.Color := OldColor; end; tssHalfI : begin MarkerRect := BarRect; MarkerRect.Right := MarkerRect.Right div 2; Offset := RowToTime(StartRow); ApptLength := RowEndTime(EndRow) - Offset; ColDate := Cols[Col].SchedDate; if Trunc(ColDate) <> Trunc(Appt.StartDate) then StartPercent := 0 else StartPercent := (Appt.StartTime - Offset) / ApptLength; if Trunc(ColDate) <> Trunc(Appt.EndDate) then EndPercent := 1.0 else EndPercent := (Appt.EndTime - Offset) / ApptLength; MarkerRect.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) + BarRect.Top; MarkerRect.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) + BarRect.Top; OldColor := Pen.Color; Pen.Color := ApptBar.TimeStampColor; Pen.Width := ScreenToPrinter(2, False); MoveTo(MarkerRect.Left, MarkerRect.Top); LineTo(MarkerRect.Right - 0, MarkerRect.Top); MoveTo(MarkerRect.Left, MarkerRect.Bottom - 0); LineTo(MarkerRect.Right - 0, MarkerRect.Bottom - 0); if ApptBar.Width > 5 then Pen.Width := ScreenToPrinter(2, True) else Pen.Width := ScreenToPrinter(1, True); MoveTo(MarkerRect.Right - 0, MarkerRect.Top + 1); LineTo(MarkerRect.Right - 0, MarkerRect.Bottom); Pen.Color := OldColor; Pen.Width := 1; end; tssBlock : begin MarkerRect := BarRect; MarkerRect.Right := MarkerRect.Right div 2; Offset := RowToTime(StartRow); ApptLength := RowEndTime(EndRow) - Offset; ColDate := Cols[Col].SchedDate; if Trunc(ColDate) <> Trunc(Appt.StartDate) then StartPercent := 0 else StartPercent := (Appt.StartTime - Offset) / ApptLength; if Trunc(ColDate) <> Trunc(Appt.EndDate) then EndPercent := 1.0 else EndPercent := (Appt.EndTime - Offset) / ApptLength; MarkerRect.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) + BarRect.Top; MarkerRect.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) + BarRect.Top; OldColor := Brush.Color; Brush.Color := ApptBar.TimeStampColor; FillRect(MarkerRect); Brush.Color := OldColor; end; end; end; end; } procedure TJvTFDaysPrinter.DrawApptDetail(ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt; Col, StartRow, EndRow: Integer); var TheFrameRect, TxtRect, DetailRect, BarRect: TRect; Txt: string; Flags: UINT; CanDrawText, CanDrawPics, CanDrawAppt: Boolean; PicsHeight, PicsWidth: Integer; DrawList: TList; DrawInfo: TJvTFDaysApptDrawInfo; begin with ACanvas do begin DrawInfo := TJvTFDaysApptDrawInfo.Create; try GetApptDrawInfo(DrawInfo, Appt); Font.Assign(DrawInfo.Font); Brush.Color := DrawInfo.Color; Pen.Color := DrawInfo.FrameColor; Pen.Width := DrawInfo.FrameWidth; CanDrawAppt := DrawInfo.Visible; finally DrawInfo.Free; end; // !!!!!!!!!!!!!!!!!!!!!!!!!! // EXIT IF NOTHING TO DRAW !! // !!!!!!!!!!!!!!!!!!!!!!!!!! if not CanDrawAppt then Exit; //Brush.Color := GetApptDispColor(Appt); FillRect(ARect); //Pen.Color := ApptAttr.FrameColor; //Pen.Width := ApptAttr.FrameWidth; TheFrameRect := ARect; InflateRect(TheFrameRect, -(ApptAttr.FrameWidth div 2), -(ApptAttr.FrameWidth div 2)); // Need to fine tune the frame rect if ApptAttr.FrameWidth mod 2 = 0 then begin Inc(TheFrameRect.Right); Inc(TheFrameRect.Bottom); end; MoveTo(TheFrameRect.Left, TheFrameRect.Top); LineTo(TheFrameRect.Right - 1, TheFrameRect.Top); LineTo(TheFrameRect.Right - 1, TheFrameRect.Bottom - 1); LineTo(TheFrameRect.Left, TheFrameRect.Bottom - 1); LineTo(TheFrameRect.Left, TheFrameRect.Top); // Only go through the following work if all details must be drawn if (RectHeight(ARect) > Thresholds.DetailHeight) and (RectWidth(ARect) > Thresholds.DetailWidth) then begin InflateRect(TheFrameRect, -(ApptAttr.FrameWidth div 2), -(ApptAttr.FrameWidth div 2)); DetailRect := TheFrameRect; if ApptBar.Visible then begin Inc(DetailRect.Left, ApptBar.Width); SubtractRect(BarRect, TheFrameRect, DetailRect); Dec(BarRect.Bottom); DrawApptBar(ACanvas, Appt, BarRect, Col, StartRow, EndRow); end; TxtRect := DetailRect; InflateRect(TxtRect, -2, -2); DrawList := TList.Create; try // Set the canvas' font now so text height and width calc's will // be correct. //Font := ApptAttr.Font; CreatePicDrawList(TxtRect, Appt, DrawList); FilterPicDrawList(TxtRect, DrawList, PicsHeight, PicsWidth); // Calc'ing text height and width in CanDrawWhat CanDrawWhat(ACanvas, TxtRect, PicsHeight, PicsWidth, CanDrawText, CanDrawPics); if CanDrawPics then begin DrawListPics(ACanvas, TxtRect, DrawList); Inc(TxtRect.Left, PicsWidth); // Mantis 2340: Be coherent with JvTFDays end; finally ClearPicDrawList(DrawList); DrawList.Free; end; if CanDrawText then begin Flags := DT_WORDBREAK or DT_NOPREFIX or DT_EDITCONTROL; Txt := ScheduleManager.GetApptDisplayText(Self, Appt); if not FormattedDesc then begin Txt := StripCRLF(Txt); Flags := Flags or DT_END_ELLIPSIS; end; DrawText(ACanvas.Handle, PChar(Txt), -1, TxtRect, Flags); end; end; if Assigned(FOnDrawAppt) then FOnDrawAppt(Self, ACanvas, ARect, Appt, False); end; end; procedure TJvTFDaysPrinter.DrawAppts(ACanvas: TCanvas; DrawAll: Boolean; PageInfo: TJvTFDaysPageInfo); var FromCol, ToCol, FromRow, ToRow, Col, I: Integer; ApptStartRow, ApptEndRow, SchedDate: Integer; Appt: TJvTFAppt; begin if Aborted then Exit; if DrawAll then begin FromCol := 0; ToCol := Cols.Count - 1; FromRow := 0; ToRow := RowCount - 1; end else begin FromCol := PageInfo.StartCol; ToCol := PageInfo.EndCol; FromRow := PageInfo.StartRow; ToRow := PageInfo.EndRow; end; if Assigned(FOnApptProgress) and (FApptsDrawn = 0) then FOnApptProgress(Self, 0, ApptCount); Application.ProcessMessages; Col := FromCol; while (Col <= ToCol) and not Aborted do //For Col := FromCol to ToCol do begin if Cols[Col].Connected and not Aborted then begin SchedDate := Trunc(Cols[Col].SchedDate); I := 0; while (I < Cols[Col].Schedule.ApptCount) and not Aborted do //For I := 0 to Cols[Col].Schedule.ApptCount - 1 do begin Appt := Cols[Col].Schedule.Appts[I]; CalcStartEndRows(Appt, SchedDate, ApptStartRow, ApptEndRow); if (ApptStartRow <= ToRow) and (ApptEndRow >= FromRow) then begin DrawAppt(ACanvas, Col, Appt, ApptStartRow, ApptEndRow, PageInfo); Inc(FApptsDrawn); if Assigned(FOnApptProgress) then FOnApptProgress(Self, FApptsDrawn, ApptCount); Application.ProcessMessages; end; Inc(I); end; end; Inc(Col); end; end; procedure TJvTFDaysPrinter.DrawBody(ACanvas: TCanvas; ARect: TRect; PageNum: Integer); var SaveMeasure: TJvTFPrinterMeasure; lPageInfo: TJvTFDaysPageInfo; I, J: Integer; begin if Aborted then Exit; SaveMeasure := Measure; Measure := pmPixels; lPageInfo := TJvTFDaysPageInfo(FPageInfoList.Objects[PageNum - 1]); with ACanvas do begin Brush.Color := Self.Color; FillRect(ARect); DrawCorner(ACanvas); if lPageInfo.ShowColHdr then begin if Cols.Count = 0 then DrawEmptyColHdr(ACanvas, lPageInfo) else begin DrawGroupHdrs(ACanvas, lPageInfo); for I := lPageInfo.StartCol to lPageInfo.EndCol do begin if Aborted then Break; //DrawColHdr(ACanvas, I, lPageInfo); DrawColGroupHdr(ACanvas, I, lPageInfo, False); end; end; end; if lPageInfo.ShowRowHdr then if RowHdrType = rhFancy then DrawFancyRowHdrs(ACanvas, lPageInfo) else for I := lPageInfo.StartRow to lPageInfo.EndRow do begin if Aborted then Break; DrawRowHdr(ACanvas, I, lPageInfo); end; for I := lPageInfo.StartRow to lPageInfo.EndRow do for J := lPageInfo.StartCol to lPageInfo.EndCol do begin if Aborted then Break; DrawDataCell(ACanvas, J, I, lPageInfo); end; if not (csDesigning in ComponentState) and not Aborted then DrawAppts(ACanvas, False, lPageInfo); end; Measure := SaveMeasure; inherited DrawBody(ACanvas, ARect, PageNum); end; { procedure TJvTFDaysPrinter.DrawColHdr(ACanvas: TCanvas; Index: Integer; PageInfo: TJvTFDaysPageInfo); var ARect, TxtRect, CalcRect: TRect; Txt: string; PTxt: PChar; Flags: UINT; TxtHt, TxtRectHt: Integer; begin ARect := CellRect(Index, -1, PageInfo); //Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title)); Txt := Cols[Index].Title; ACanvas.Brush.Color := HdrAttr.Color; ACanvas.Font.Assign(HdrAttr.Font); Flags := DT_NOPREFIX or DT_CENTER; Case ColTitleStyle of ctsSingleClip : Flags := Flags or DT_SINGLELINE or DT_VCENTER; ctsSingleEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER; ctsMultiClip : Flags := Flags or DT_WORDBREAK; ctsMultiEllipsis : Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or DT_EDITCONTROL; ctsHide : Flags := Flags or DT_SINGLELINE or DT_VCENTER; end; ACanvas.FillRect(ARect); TxtRect := ARect; Windows.InflateRect(TxtRect, -2, -2); CalcRect := TxtRect; //PTxt := StrNew(PChar(Txt)); PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char)); StrPCopy(PTxt, Txt); if (ColTitleStyle = ctsMultiClip) or (ColTitleStyle = ctsMultiEllipsis) then begin TxtHt := Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT); if TxtHt < RectHeight(TxtRect) then begin // we need to vertically center the text TxtRectHt := RectHeight(TxtRect); TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2; TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom); end; end else if ColTitleStyle = ctsHide then begin Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT); if RectWidth(CalcRect) > RectWidth(TxtRect) then StrPCopy(PTxt, ''); end; Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags); StrDispose(PTxt); DrawFrame(ACanvas, ARect, HdrAttr.Frame3D); if Assigned(FOnDrawColHdr) then FOnDrawColHdr(Self, ACanvas, ARect, Index, False); end; } procedure TJvTFDaysPrinter.DrawCorner(ACanvas: TCanvas); var ARect: TRect; begin //group ARect := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight); ARect := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight); with ACanvas do begin Brush.Color := HdrAttr.Color; FillRect(ARect); if HdrAttr.Frame3D then DrawFrame(ACanvas, ARect, HdrAttr.Frame3D) else begin if RowHdrType = rhFancy then begin Pen.Color := FancyRowHdrAttr.TickColor; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom - 1); MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); end else DrawFrame(ACanvas, ARect, False); end; if Assigned(FOnDrawCorner) then FOnDrawCorner(Self, ACanvas, ARect, agcTopLeft); end; end; procedure TJvTFDaysPrinter.DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer; PageInfo: TJvTFDaysPageInfo); var ARect: TRect; PrimeStartRow, PrimeEndRow: Integer; CellColor: TColor; begin // Calc the cell rect if PageInfo.ShowRowHdr then ARect.Left := RowHdrWidth else ARect.Left := 0; ARect.Left := ARect.Left + (ColIndex - PageInfo.StartCol) * PageInfo.ColWidth; ARect.Right := ARect.Left + PageInfo.ColWidth; { variable col widths, leave for future reference For I := LeftCol to ColIndex - 1 do Inc(ARect.Left, Cols[I].Width); ARect.Right := ARect.Left + Cols[ColIndex].Width; } if PageInfo.ShowColHdr then //group ARect.Top := ColHdrHeight ARect.Top := CalcGroupColHdrsHeight else ARect.Top := 0; ARect.Top := ARect.Top + (RowIndex - PageInfo.StartRow) * PageInfo.RowHeight; ARect.Bottom := ARect.Top + PageInfo.RowHeight; PrimeStartRow := TimeToRow(PrimeTime.StartTime); PrimeEndRow := TimeToRow(AdjustEndTime(PrimeTime.EndTime)); if (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow) then CellColor := PrimeTime.Color else CellColor := Color; if Assigned(FOnShadeCell) then FOnShadeCell(Self, ColIndex, RowIndex, CellColor); if CellColor <> Color then begin ACanvas.Brush.Color := CellColor; ACanvas.FillRect(ARect); end; // Draw a line across the ARect.Bottom and down the ARect.Right side with ACanvas do begin Pen.Color := GridLineColor; Pen.Width := 1; MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom - 1); end; if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, ACanvas, ARect, ColIndex, RowIndex); end; procedure TJvTFDaysPrinter.DrawEmptyColHdr(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo); var ARect: TRect; begin ARect.Left := RowHdrWidth; ARect.Top := 0; ARect.Right := ARect.Left + GetDataWidth(PageInfo.ShowRowHdr); //group ARect.Bottom := ColHdrHeight; ARect.Bottom := CalcGroupColHdrsHeight; with ACanvas do begin Brush.Color := HdrAttr.Color; FillRect(ARect); Pen.Color := clGray; MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); end; end; procedure TJvTFDaysPrinter.DrawFancyRowHdrs(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo); var I, MajorTickLength, MinorTickLength, TickLength: Integer; ARect: TRect; Lbl: string; PrevHour, CurrentHour: Word; FirstMajor, Switch: Boolean; begin MajorTickLength := GetMajorTickLength; MinorTickLength := GetMinorTickLength(ACanvas); FirstMajor := True; PrevHour := RowToHour(PageInfo.StartRow); for I := PageInfo.StartRow to PageInfo.EndRow do begin CurrentHour := RowToHour(I); Switch := (CurrentHour <> PrevHour) or (I = PageInfo.EndRow); ARect := CellRect(-1, I, PageInfo); Lbl := GetMinorLabel(I, PageInfo); if not RowEndsHour(I) then TickLength := MinorTickLength else TickLength := MajorTickLength; DrawMinor(ACanvas, ARect, I, Lbl, TickLength); // Draw Major if needed if Switch and (Granularity <> 60) then begin if I <> PageInfo.StartRow + 1 then begin ARect.Left := ScreenToPrinter(2, true); // Allow for a small margin on ARect.Left side ARect.Right := RowHdrWidth - MinorTickLength; // ARect.Right := RowHdrWidth; // No "cutting" before the end of the cell. ARect.Top := CellRect(-1, HourStartRow(PrevHour), PageInfo).Top; //group if ARect.Top < ColHdrHeight then //group ARect.Top := ColHdrHeight; if ARect.Top < CalcGroupColHdrsHeight then ARect.Top := CalcGroupColHdrsHeight; ARect.Bottom := CellRect(-1, HourEndRow(PrevHour), PageInfo).Bottom - 1; // No need to check for ARect.Bottom to be outside the page, CellRect // calculates it so that it does not happen. And using GetDataHeight // is not a good idea as it removes the column header height, which // is NOT what we want here as we want the page's integral height. // If we wer to use it, we would trigger Mantis 2340. if FancyRowHdrAttr.Hr2400 then Lbl := IntToStr(PrevHour) else begin if PrevHour = 0 then Lbl := '12' else if PrevHour > 12 then Lbl := IntToStr(PrevHour - 12) else Lbl := IntToStr(PrevHour); if FirstMajor or (PrevHour = 0) or (PrevHour = 12) then if PrevHour < 12 then Lbl := Lbl + 'a' else Lbl := Lbl + 'p'; end; ACanvas.Font.Assign(FancyRowHdrAttr.MajorFont); ACanvas.Brush.Style := bsClear; DrawText(ACanvas.Handle, PChar(Lbl), -1, ARect, DT_NOPREFIX or DT_SINGLELINE or DT_CENTER or DT_VCENTER); if Assigned(FOnDrawMajorRowHdr) then FOnDrawMajorRowHdr(Self, ACanvas, ARect, I - 1, False); FirstMajor := False; end; if Switch then PrevHour := CurrentHour; end; end; end; procedure TJvTFDaysPrinter.DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean); var OldPenColor: TColor; begin with ACanvas do begin OldPenColor := Pen.Color; if Draw3D then Pen.Color := clBtnShadow else Pen.Color := GridLineColor; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom); MoveTo(ARect.Left, ARect.Bottom - 1); LineTo(ARect.Right, ARect.Bottom - 1); if Draw3D then begin Pen.Color := clBtnHighlight; MoveTo(ARect.Left, ARect.Top); LineTo(ARect.Right, ARect.Top); MoveTo(ARect.Left, ARect.Top); LineTo(ARect.Left, ARect.Bottom); end; Pen.Color := OldPenColor; end; end; procedure TJvTFDaysPrinter.DrawListPics(ACanvas: TCanvas; var ARect: TRect; DrawList: TList); var I: Integer; DrawInfo: TJvTFDrawPicInfo; Pic: TBitmap; DestRect: TRect; begin Pic := TBitmap.Create; Pic.Canvas.Brush.Color := ACanvas.Brush.Color; try for I := 0 to DrawList.Count - 1 do begin DrawInfo := TJvTFDrawPicInfo(DrawList[I]); Pic.Height := DrawInfo.ImageList.Height; Pic.Width := DrawInfo.ImageList.Width; Pic.Canvas.FillRect(Classes.Rect(0, 0, Pic.Width, Pic.Height)); with DrawInfo do ImageList.Draw(Pic.Canvas, 0, 0, ImageIndex); DestRect.Left := DrawInfo.PicLeft; DestRect.Top := DrawInfo.PicTop; DestRect.Right := DrawInfo.PicLeft + ScreenToPrinter(DrawInfo.ImageList.Width + 2, True); DestRect.Bottom := DrawInfo.PicTop + ScreenToPrinter(DrawInfo.ImageList.Height + 2, False); PrintBitmap(ACanvas, Classes.Rect(0, 0, Pic.Width, Pic.Height), DestRect, Pic); end; finally Pic.Free; end; end; procedure TJvTFDaysPrinter.DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer; const LabelStr: string; TickLength: Integer); var MinorRect, TxtRect: TRect; begin // do the background shading ACanvas.Brush.Color := FancyRowHdrAttr.Color; ACanvas.FillRect(ARect); MinorRect := ARect; MinorRect.Left := MinorRect.Right - GetMinorTickLength(ACanvas); with ACanvas do begin // draw the right border line Pen.Color := FancyRowHdrAttr.TickColor; MoveTo(ARect.Right - 1, ARect.Top); LineTo(ARect.Right - 1, ARect.Bottom); // now draw the tick MoveTo(ARect.Right - 1, ARect.Bottom - 1); LineTo(ARect.Right - 1 - TickLength, ARect.Bottom - 1); end; // set up a 2 pel margin on the right and bottom sides TxtRect := ARect; TxtRect.Right := TxtRect.Right - ScreenToPrinter(2, true); TxtRect.Bottom := TxtRect.Bottom - ScreenToPrinter(2, true); // now draw the LabelStr right aligned ACanvas.Font.Assign(FancyRowHdrAttr.MinorFont); ACanvas.Brush.Style := bsClear; DrawText(ACanvas.Handle, PChar(LabelStr), -1, TxtRect, DT_SINGLELINE or DT_RIGHT or DT_NOPREFIX or DT_VCENTER); if Assigned(FOnDrawMinorRowHdr) then FOnDrawMinorRowHdr(Self, ACanvas, ARect, RowNum, False); end; procedure TJvTFDaysPrinter.DrawRowHdr(ACanvas: TCanvas; Index: Integer; PageInfo: TJvTFDaysPageInfo); var ARect: TRect; Txt: string; begin ARect.Left := 0; if PageInfo.ShowColHdr then //group Top := ColHdrHeight ARect.Top := CalcGroupColHdrsHeight else ARect.Top := 0; ARect.Top := ARect.Top + (Index - PageInfo.StartRow) * PageInfo.RowHeight; ARect.Right := RowHdrWidth; ARect.Bottom := ARect.Top + PageInfo.RowHeight; Txt := FormatDateTime(TimeFormat, RowToTime(Index)); ACanvas.Brush.Color := HdrAttr.Color; ACanvas.Font.Assign(HdrAttr.Font); DrawTxt(ACanvas, ARect, Txt, taCenter, vaCenter); DrawFrame(ACanvas, ARect, HdrAttr.Frame3D); if Assigned(FOnDrawRowHdr) then FOnDrawRowHdr(Self, ACanvas, ARect, Index, False); end; procedure TJvTFDaysPrinter.EnsureRow(RowNum: Integer); begin if RowNum >= RowCount then raise EJvTFPrinterError.CreateResFmt(@RsEInvalidRowd, [RowNum]); end; procedure TJvTFDaysPrinter.FilterPicDrawList(ARect: TRect; DrawList: TList; out PicsHeight, PicsWidth: Integer); var I, NextPicLeft, PicRight, PicBottom: Integer; DrawIt: Boolean; DrawInfo: TJvTFDrawPicInfo; begin PicsHeight := 0; PicsWidth := 0; if DrawList.Count = 0 then Exit; if Thresholds.PicsAllOrNone then begin DrawInfo := TJvTFDrawPicInfo(DrawList[DrawList.Count - 1]); PicRight := DrawInfo.PicLeft + ScreenToPrinter(DrawInfo.ImageList.Width, True); if PicRight >= ARect.Right then begin while DrawList.Count > 0 do begin TJvTFDrawPicInfo(DrawList[0]).Free; DrawList.Delete(0); end; end; end; PicsHeight := 0; NextPicLeft := ARect.Left; I := 0; while I < DrawList.Count do begin DrawInfo := TJvTFDrawPicInfo(DrawList[I]); with DrawInfo do begin PicRight := PicLeft + ScreenToPrinter(ImageList.Width + 2, True); PicBottom := PicTop + ScreenToPrinter(ImageList.Height + 2, False); DrawIt := True; if Thresholds.WholePicsOnly and (PicRight >= ARect.Right) or (PicBottom >= ARect.Bottom) then DrawIt := False; if DrawIt then begin //PicsHeight := Greater(PicsHeight, ImageList.Height + 2); PicsHeight := Greater(PicsHeight, PicBottom - PicTop + 2); PicLeft := NextPicLeft; //Inc(NextPicLeft, ImageList.Width + 2); Inc(NextPicLeft, PicRight - PicLeft + 2); // Increment I to move onto next pic in list Inc(I); end else // Remove pic from list begin // Remove pic from list DrawInfo.Free; DrawList.Delete(I); // DO NOT increment I - Since pic was removed from list // I will now point to next pic end; end; end; PicsWidth := NextPicLeft - ARect.Left; end; function TJvTFDaysPrinter.GetApptDispColor(Appt: TJvTFAppt): TColor; begin if Appt.Color = clDefault then Result := ApptAttr.Color else Result := Appt.Color; end; function TJvTFDaysPrinter.GetApptRect(Col: Integer; Appt: TJvTFAppt; PageInfo: TJvTFDaysPageInfo): TRect; var MapCol, MapColCount, Base, MakeUp, BaseWidth, MakeUpWidth: Integer; BaseCount, GridColWidth, ApptWidth, StartRow, EndRow: Integer; WorkLeft, WorkTop: Integer; begin if not Assigned(Appt) then begin Result := EmptyRect; Exit; end; CalcStartEndRows(Appt, Cols[Col].SchedDate, StartRow, EndRow); if (StartRow < 0) and (EndRow >= 0) then StartRow := 0; // if the above condition fails and the StartRow is STILL invalid then // let the 'Map col not found' catch the error. // Printer bug, fixed EndRow := Lesser(EndRow, PageInfo.EndRow); MapCol := Cols[Col].LocateMapCol(Appt, StartRow); if MapCol < 1 then begin raise EJvTFDaysError.CreateRes(@RsEMapColNotFoundForAppointment); end; MapColCount := Cols[Col].MapColCount(StartRow); if MapColCount < 1 then begin //Cols[Col].FMap.Dump('corrupt dump.txt'); !!! FOR DEBUGGING ONLY !!!! raise EJvTFPrinterError.CreateRes(@RsECorruptAppointmentMap); end; // Col guaranteed to be partially visible // Printer bug start, fixed WorkLeft := CellRect(Col, Greater(StartRow, PageInfo.StartRow), PageInfo).Left; if StartRow < PageInfo.StartRow then WorkTop := CellRect(Col, PageInfo.StartRow, PageInfo).Top - PageInfo.RowHeight * (PageInfo.StartRow - StartRow) else WorkTop := CellRect(Col, StartRow, PageInfo).Top; // Printer bug end, fixed GridColWidth := PageInfo.ColWidth; // The Base* and MakeUp* code that follows calc's the appt width and left // and takes into account a total width that isn't evenly divisible by // the map col count. if there is a discrepency then that discrepency // is divvied up amoung the cols working Result.Left to Result.Right. // // Example: Total width = 113, col count = 5 // col 1 = 23 // col 2 = 23 // col 3 = 23 // col 4 = 22 // col 5 = 22 // Total = 113 // // As opposed to: // width of all cols = Total div colcount = 22 // ==> Total = 22 * 5 = 110 [110 <> 113] Base := GridColWidth div MapColCount; MakeUp := GridColWidth mod MapColCount; MakeUpWidth := Lesser(MapCol - 1, MakeUp) * (Base + 1); BaseCount := MapCol - 1 - MakeUp; if BaseCount > 0 then BaseWidth := BaseCount * Base else BaseWidth := 0; ApptWidth := Base; if MapCol <= MakeUp then Inc(ApptWidth); // Printer bug, fixed Result.Left := WorkLeft + MakeUpWidth + BaseWidth; Result.Right := Result.Left + ApptWidth - ApptBuffer; // Printer bug, fixed Result.Top := WorkTop - 1; Result.Bottom := CellRect(Col, EndRow, PageInfo).Bottom; end; function TJvTFDaysPrinter.GetDataHeight(ShowColHdr: Boolean): Integer; begin Result := BodyHeight; if ShowColHdr then //group Dec(Result, ConvertMeasure(ColHdrHeight, Measure, pmPixels, False)); Dec(Result, ConvertMeasure(CalcGroupColHdrsHeight, Measure, pmPixels, False)); end; function TJvTFDaysPrinter.GetDataWidth(ShowRowHdr: Boolean): Integer; begin Result := BodyWidth; if ShowRowHdr then Dec(Result, ConvertMeasure(RowHdrWidth, Measure, pmPixels, True)); end; function TJvTFDaysPrinter.GetMajorTickLength: Integer; begin Result := RowHdrWidth; end; function TJvTFDaysPrinter.GetMinorLabel(RowNum: Integer; PageInfo: TJvTFDaysPageInfo): string; const Full24 = 'h:nn'; FullAP = 'h:nna/p'; MinOnly = 'nn'; var TimeFmt: string; LastFullRow, LastHourStart: Integer; LastHour: Word; begin if Granularity = 60 then TimeFmt := Full24 else if (RowNum = PageInfo.StartRow) and not RowStartsHour(RowNum) then TimeFmt := Full24 else begin LastFullRow := PageInfo.EndRow; LastHour := RowToHour(LastFullRow); LastHourStart := HourStartRow(LastHour); if ((RowNum = LastHourStart) and not RowStartsHour(RowNum)) or ((LastHourStart = PageInfo.StartRow) and (RowNum = PageInfo.StartRow)) then TimeFmt := Full24 else TimeFmt := MinOnly; end; if (TimeFmt = Full24) and not FancyRowHdrAttr.Hr2400 then TimeFmt := FullAP; Result := FormatDateTime(TimeFmt, RowToTime(RowNum)); end; function TJvTFDaysPrinter.GetMinorTickLength(ACanvas: TCanvas): Integer; var TempFont: TFont; begin TempFont := TFont.Create; try TempFont.Assign(ACanvas.Font); ACanvas.Font.Assign(FancyRowHdrAttr.MinorFont); Result := ACanvas.TextWidth('00') + ScreenToPrinter(6, true); // Result := ACanvas.TextWidth('22:22a'); ACanvas.Font.Assign(TempFont); finally TempFont.Free; end; end; function TJvTFDaysPrinter.HourEndRow(Hour: Word): Integer; begin Result := TimeToRow(EncodeTime(Hour, 59, 0, 0)); end; function TJvTFDaysPrinter.HourStartRow(Hour: Word): Integer; begin Result := TimeToRow(EncodeTime(Hour, 0, 0, 0)); end; procedure TJvTFDaysPrinter.Loaded; var I: Integer; begin inherited Loaded; for I := 0 to Cols.Count - 1 do Cols[I].Connect; end; procedure TJvTFDaysPrinter.Prepare; var I: Integer; begin NewDoc; try FApptsDrawn := 0; CalcPageInfo; if FPageInfoList.Count = 0 then raise EJvTFPrinterError.CreateRes(@RsEThereIsNoDataToPrint); for I := 0 to FPageInfoList.Count - 1 do NewPage; //Except on EJvTFPrinterError do except begin FreeDoc; raise; end; end; FApptsDrawn := 0; FinishDoc; end; function TJvTFDaysPrinter.RowCount: Integer; var Adjustment, H, M, S, MS: Word; WorkTime: TTime; begin WorkTime := GridEndTime; DecodeTime(WorkTime, H, M, S, MS); Adjustment := 0; if (H = 0) and (M = 0) then begin WorkTime := EncodeTime(23, 59, 59, 999); Adjustment := 1; end; //DecodeTime(GridEndTime - GridStartTime, H, M, S, MS); DecodeTime(WorkTime - GridStartTime, H, M, S, MS); Result := (H * 60 + M) div Granularity + Adjustment; end; function TJvTFDaysPrinter.RowEndsHour(RowNum: Integer): Boolean; var H, M, S, MS: Word; TempTime: TTime; begin EnsureRow(RowNum); TempTime := RowToTime(RowNum) + EncodeTime(0, Granularity - 1, 0, 0); DecodeTime(TempTime, H, M, S, MS); Result := M = 59; end; function TJvTFDaysPrinter.RowEndTime(RowNum: Integer): TTime; begin Result := RowToTime(RowNum) + Granularity * EncodeTime(0, 1, 0, 0) - EncodeTime(0, 0, 1, 0); end; function TJvTFDaysPrinter.RowStartsHour(RowNum: Integer): Boolean; var H, M, S, MS: Word; begin EnsureRow(RowNum); DecodeTime(RowToTime(RowNum), H, M, S, MS); Result := M = 0; end; function TJvTFDaysPrinter.RowToHour(RowNum: Integer): Word; var H, M, S, MS: Word; begin DecodeTime(RowToTime(RowNum), H, M, S, MS); Result := H; end; function TJvTFDaysPrinter.RowToTime(RowNum: Integer): TTime; var TotalMins: Integer; WorkHours, WorkMins: Word; H, M, S, MS: Word; Offset: Integer; begin DecodeTime(GridStartTime, H, M, S, MS); Offset := H * 60 + M; TotalMins := RowNum * Granularity + Offset; WorkHours := TotalMins div 60; WorkMins := TotalMins mod 60; if WorkHours < 24 then Result := EncodeTime(WorkHours, WorkMins, 0, 0) else Result := EncodeTime(23, 59, 59, 999); end; procedure TJvTFDaysPrinter.SetApptAttr(Value: TJvTFDaysApptAttr); begin SetPropertyCheck; FApptAttr.Assign(Value); end; procedure TJvTFDaysPrinter.SetApptBar(Value: TJvTFDaysApptBar); begin SetPropertyCheck; FApptBar.Assign(Value); end; procedure TJvTFDaysPrinter.SetApptBuffer(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; FApptBuffer := Value; end; procedure TJvTFDaysPrinter.SetColHdrHeight(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; FColHdrHeight := Value; end; procedure TJvTFDaysPrinter.SetColor(Value: TColor); begin SetPropertyCheck; FColor := Value; end; procedure TJvTFDaysPrinter.SetCols(Value: TJvTFDaysCols); begin FCols.Assign(Value); end; procedure TJvTFDaysPrinter.SetTFColTitleStyle(Value: TJvTFColTitleStyle); begin SetPropertyCheck; FColTitleStyle := Value; end; procedure TJvTFDaysPrinter.SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr); begin SetPropertyCheck; FFancyRowHdrAttr.Assign(Value); end; procedure TJvTFDaysPrinter.SetGranularity(Value: Integer); var MaxRowHeight, I: Integer; begin SetPropertyCheck; // Enforce minimum granularity of 1 min and max of 60 mins if Value < 1 then Value := 1 else if Value > 60 then Value := 60; // Ensure that granularity is evenly divisable by an hour while 60 mod Value <> 0 do Dec(Value); // Sum of row heights cannot exceed 32767 MaxRowHeight := 32767 div (60 div Value * 24); if RowHeight > MaxRowHeight then RowHeight := MaxRowHeight; if Value <> FGranularity then begin FGranularity := Value; if not (csLoading in ComponentState) then begin for I := 0 to Cols.Count - 1 do Cols[I].RefreshMap; end; end; end; procedure TJvTFDaysPrinter.SetGridLineColor(Value: TColor); begin SetPropertyCheck; FGridLineColor := Value; end; procedure TJvTFDaysPrinter.SetHdrAttr(Value: TJvTFDaysHdrAttr); begin SetPropertyCheck; FHdrAttr.Assign(Value); end; procedure TJvTFDaysPrinter.SetMeasure(Value: TJvTFPrinterMeasure); var I: Integer; begin try FConvertingProps := True; if Value <> Measure then begin // convert properties ApptAttr.FrameWidth := ConvertMeasure(ApptAttr.FrameWidth, Measure, Value, False); ApptBar.Width := ConvertMeasure(ApptBar.Width, Measure, Value, True); ApptBuffer := ConvertMeasure(ApptBuffer, Measure, Value, True); ColHdrHeight := ConvertMeasure(ColHdrHeight, Measure, Value, False); GroupHdrHeight := ConvertMeasure(GroupHdrHeight, Measure, Value, False); for I := 0 to Cols.Count - 1 do Cols[I].Width := ConvertMeasure(Cols[I].Width, Measure, Value, True); MinColWidth := ConvertMeasure(MinColWidth, Measure, Value, True); MinRowHeight := ConvertMeasure(MinRowHeight, Measure, Value, False); RowHdrWidth := ConvertMeasure(RowHdrWidth, Measure, Value, True); RowHeight := ConvertMeasure(RowHeight, Measure, Value, False); Thresholds.DetailHeight := ConvertMeasure(Thresholds.DetailHeight, Measure, Value, False); Thresholds.DetailWidth := ConvertMeasure(Thresholds.DetailWidth, Measure, Value, True); inherited SetMeasure(Value); end; finally FConvertingProps := False; end; end; procedure TJvTFDaysPrinter.SetMinColWidth(Value: Integer); var absMinColWidth: Integer; begin SetPropertyCheck; absMinColWidth := DEFAULT_MIN_COL_WIDTH; if Value < absMinColWidth then Value := absMinColWidth; FMinColWidth := Value; end; procedure TJvTFDaysPrinter.SetMinRowHeight(Value: Integer); begin SetPropertyCheck; if Value < 1 then Value := 1; FMinRowHeight := Value; end; procedure TJvTFDaysPrinter.SetPrimeTime(Value: TJvTFDaysPrimeTime); begin SetPropertyCheck; FPrimeTime.Assign(Value); end; procedure TJvTFDaysPrinter.SetProperties(aJvTFDays: TJvTFDays); begin ApptAttr := aJvTFDays.ApptAttr; ApptAttr.FrameWidth := ConvertMeasure(ScreenToPrinter(ApptAttr.FrameWidth, False), pmPixels, Measure, False); ApptBar := aJvTFDays.ApptBar; ApptBar.Width := ConvertMeasure(ScreenToPrinter(ApptBar.Width, True), pmPixels, Measure, True); ApptBuffer := ConvertMeasure(ScreenToPrinter(aJvTFDays.ApptBuffer, True), pmPixels, Measure, True); ColHdrHeight := ConvertMeasure(ScreenToPrinter(aJvTFDays.ColHdrHeight, False), pmPixels, Measure, False); Color := aJvTFDays.Color; ColTitleStyle := aJvTFDays.ColTitleStyle; DateFormat := aJvTFDays.DateFormat; FancyRowHdrAttr := aJvTFDays.FancyRowHdrAttr; FormattedDesc := agoFormattedDesc in aJvTFDays.Options; Granularity := aJvTFDays.Granularity; GridLineColor := aJvTFDays.GridLineColor; GroupHdrAttr := aJvTFDays.GroupHdrAttr; //GroupHdrHeight := aJvTFDays.GroupHdrHeight; GroupHdrHeight := ConvertMeasure(ScreenToPrinter(aJvTFDays.GroupHdrHeight, False), pmPixels, Measure, False); Grouping := aJvTFDays.Grouping; HdrAttr := aJvTFDays.HdrAttr; FixFont(FancyRowHdrAttr.MajorFont); FixFont(FancyRowHdrAttr.Minorfont); FixFont(GroupHdrAttr.Font); FixFont(HdrAttr.Font); MinColWidth := ConvertMeasure(ScreenToPrinter(aJvTFDays.MinColWidth, True), pmPixels, Measure, True); PrimeTime := aJvTFDays.PrimeTime; RowHdrType := aJvTFDays.RowHdrType; RowHdrWidth := ConvertMeasure(ScreenToPrinter(aJvTFDays.RowHdrWidth, True), pmPixels, Measure, True); RowHeight := ConvertMeasure(ScreenToPrinter(aJvTFDays.RowHeight, False), pmPixels, Measure, False); ShowPics := agoShowPics in aJvTFDays.Options; ShowText := agoShowText in aJvTFDays.Options; Thresholds := aJvTFDays.Thresholds; Thresholds.DetailHeight := ConvertMeasure(ScreenToPrinter(Thresholds.DetailHeight, False), pmPixels, Measure, False); Thresholds.DetailWidth := ConvertMeasure(ScreenToPrinter(Thresholds.DetailWidth, True), pmPixels, Measure, True); TimeFormat := aJvTFDays.TimeFormat; // Set the property fields directly to avoid validity check. Assume // settings from aJvTFDays are already validated. FGridStartTime := aJvTFDays.GridStartTime; FGridEndTime := aJvTFDays.GridEndTime; end; procedure TJvTFDaysPrinter.SetTFRowHdrType(Value: TJvTFRowHdrType); begin SetPropertyCheck; FRowHdrType := Value; end; procedure TJvTFDaysPrinter.SetRowHdrWidth(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; FRowHdrWidth := Value; end; procedure TJvTFDaysPrinter.SetRowHeight(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; FRowHeight := Value; end; procedure TJvTFDaysPrinter.SetShowPics(Value: Boolean); begin SetPropertyCheck; FShowPics := Value; end; procedure TJvTFDaysPrinter.SetShowText(Value: Boolean); begin SetPropertyCheck; FShowText := Value; end; procedure TJvTFDaysPrinter.SetThresholds(Value: TJvTFDaysThresholds); begin SetPropertyCheck; FThresholds.Assign(Value); end; function TJvTFDaysPrinter.TimeToRow(ATime: TTime): Integer; var TotalMins: Integer; WorkHours, WorkMins, WorkSecs, WorkMSecs: Word; H, M, S, MS: Word; Offset: Integer; begin DecodeTime(ATime, WorkHours, WorkMins, WorkSecs, WorkMSecs); // Convert the given time to minutes DecodeTime(GridStartTime, H, M, S, MS); Offset := H * 60 + M; TotalMins := WorkHours * 60 + WorkMins - Offset; // Find the row number by dividing the time in minutes by the granularity Result := TotalMins div Granularity; if (TotalMins < 0) and (TotalMins mod Granularity <> 0) then Dec(Result); end; function TJvTFDaysPrinter.GetPageLayout: TJvTFDaysPrinterPageLayout; begin Result := TJvTFDaysPrinterPageLayout(inherited PageLayout); end; procedure TJvTFDaysPrinter.SetPageLayout(Value: TJvTFDaysPrinterPageLayout); begin inherited PageLayout := Value; end; procedure TJvTFDaysPrinter.CreateDoc; var I: Integer; begin inherited CreateDoc; FApptCount := 0; for I := 0 to Cols.Count - 1 do Inc(FApptCount, Cols[I].Schedule.ApptCount); end; function TJvTFDaysPrinter.GetApptCount: Integer; var I: Integer; begin if State = spsNoDoc then begin Result := 0; for I := 0 to Cols.Count - 1 do Inc(Result, Cols[I].Schedule.ApptCount); end else Result := FApptCount; end; function TJvTFDaysPrinter.GetPageInfo(PageNum: Integer): TJvTFDaysPageInfo; begin if not FValidPageInfo then raise EJvTFPrinterError.CreateRes(@RsENoPageInfoExists); Result := TJvTFDaysPageInfo(FPageInfoList.Objects[PageNum - 1]); end; procedure TJvTFDaysPrinter.FreeDoc; begin inherited FreeDoc; // Do not call ClearPageInfo if component is being destroyed. This must be // done in TJvTFDaysPrinter.Destroy. TJvTFPrinter.Destroy calls FreeDoc // and since TJvTFDaysPrinter.Destroy frees FPageInfo a NASTY AV happens. if not (csDestroying in ComponentState) then ClearPageInfo; end; procedure TJvTFDaysPrinter.SetFormattedDesc(Value: Boolean); begin SetPropertyCheck; FFormattedDesc := Value; end; procedure TJvTFDaysPrinter.SetGroupHdrAttr(Value: TJvTFDaysHdrAttr); begin SetPropertyCheck; FGroupHdrAttr.Assign(Value); end; procedure TJvTFDaysPrinter.SetGroupHdrHeight(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; FGroupHdrHeight := Value; end; procedure TJvTFDaysPrinter.SetGrouping(Value: TJvTFDaysGrouping); begin SetPropertyCheck; FGrouping := Value; Cols.UpdateTitles; end; procedure TJvTFDaysPrinter.DrawColGroupHdr(ACanvas: TCanvas; Index: Integer; PageInfo: TJvTFDaysPageInfo; IsGroupHdr: Boolean); var ARect, TxtRect, CalcRect: TRect; Txt: string; Flags: UINT; TxtHt, TxtRectHt: Integer; UseAttr: TJvTFDaysHdrAttr; begin if IsGroupHdr then begin ARect := VirtualGroupHdrRect(Index, PageInfo); Txt := Cols[Index].GroupTitle; UseAttr := GroupHdrAttr; end else begin ARect := CellRect(Index, -1, PageInfo); Txt := Cols[Index].Title; UseAttr := HdrAttr; end; ACanvas.Brush.Color := UseAttr.Color; ACanvas.Font.Assign(UseAttr.Font); Flags := DT_NOPREFIX or DT_CENTER; case ColTitleStyle of ctsSingleClip: Flags := Flags or DT_SINGLELINE or DT_VCENTER; ctsSingleEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER; ctsMultiClip: Flags := Flags or DT_WORDBREAK; ctsMultiEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or DT_EDITCONTROL; ctsHide: Flags := Flags or DT_SINGLELINE or DT_VCENTER; end; ACanvas.FillRect(ARect); TxtRect := ARect; InflateRect(TxtRect, -2, -2); CalcRect := TxtRect; if (ColTitleStyle = ctsMultiClip) or (ColTitleStyle = ctsMultiEllipsis) then begin TxtHt := DrawText(ACanvas.Handle, PChar(Txt), -1, CalcRect, Flags or DT_CALCRECT); if TxtHt < RectHeight(TxtRect) then begin // we need to vertically center the text TxtRectHt := RectHeight(TxtRect); TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2; TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom); end; end else if ColTitleStyle = ctsHide then begin DrawText(ACanvas.Handle, PChar(Txt), -1, CalcRect, Flags or DT_CALCRECT); if RectWidth(CalcRect) > RectWidth(TxtRect) then Txt := ''; end; DrawText(ACanvas.Handle, PChar(Txt), -1, TxtRect, Flags); DrawFrame(ACanvas, ARect, HdrAttr.Frame3D); if IsGroupHdr then begin if Assigned(FOnDrawGroupHdr) then FOnDrawGroupHdr(Self, ACanvas, ARect, Index, False); end else if Assigned(FOnDrawColHdr) then FOnDrawColHdr(Self, ACanvas, ARect, Index, False); end; procedure TJvTFDaysPrinter.DrawGroupHdrs(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo); var CurrGroup: string; I: Integer; begin if CalcGroupHdrHeight > 0 then begin CurrGroup := Cols[PageInfo.StartCol].GroupTitle; DrawColGroupHdr(ACanvas, PageInfo.StartCol, PageInfo, True); for I := PageInfo.StartCol + 1 to PageInfo.EndCol do if Cols[I].GroupTitle <> CurrGroup then begin CurrGroup := Cols[I].GroupTitle; DrawColGroupHdr(ACanvas, I, PageInfo, True); end; end; end; function TJvTFDaysPrinter.CalcGroupColHdrsHeight: Integer; begin Result := CalcGroupHdrHeight + ColHdrHeight; end; function TJvTFDaysPrinter.CalcGroupHdrHeight: Integer; begin if Grouping = grNone then Result := 0 else Result := GroupHdrHeight; end; function TJvTFDaysPrinter.VirtualGroupHdrRect(Col: Integer; APageInfo: TJvTFDaysPageInfo): TRect; var I, GroupWidth: Integer; GroupStartCol: Integer = 0; // to silence the compiler GroupEndCol: Integer = 0; // dto. begin Result.Top := 0; Result.Bottom := CalcGroupHdrHeight; GetGroupStartEndCols(Col, GroupStartCol, GroupEndCol); GroupWidth := 0; for I := GroupStartCol to GroupEndCol do Inc(GroupWidth, APageInfo.ColWidth); Result.Left := RowHdrWidth; // At most, only one of the following For loops will execute // depending on whether Col is to the left or to the right of LeftCol //For I := LeftCol - 1 downto GroupStartCol do for I := APageInfo.StartCol - 1 downto GroupStartCol do Dec(Result.Left, APageInfo.ColWidth); //For I := LeftCol to GroupStartCol - 1 do for I := APageInfo.StartCol to GroupStartCol - 1 do Inc(Result.Left, APageInfo.ColWidth); Result.Right := Result.Left + GroupWidth; end; procedure TJvTFDaysPrinter.GetGroupStartEndCols(Col: Integer; var StartCol, EndCol: Integer); var I: Integer; begin // find group start col I := Col; while (I >= 0) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do begin StartCol := I; Dec(I); end; // find group end col I := Col; while (I < Cols.Count) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do begin EndCol := I; Inc(I); end; end; procedure TJvTFDaysPrinter.PrintDirect; begin DirectPrint := True; try try Prepare; finally FreeDoc; end; finally DirectPrint := False; end; end; procedure TJvTFDaysPrinter.GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo; Appt: TJvTFAppt); begin DrawInfo.Color := GetApptDispColor(Appt); DrawInfo.FrameColor := ApptAttr.FrameColor; DrawInfo.FrameWidth := ApptAttr.FrameWidth; DrawInfo.Font := ApptAttr.Font; FixFont(DrawInfo.Font); DrawInfo.Visible := True; if Assigned(FOnGetApptDrawInfo) then FOnGetApptDrawInfo(Self, Appt, DrawInfo); end; procedure TJvTFDaysPrinter.SetGridEndTime(Value: TTime); var I: Integer; WorkEnd: TTime; H, M, S, MS: Word; begin WorkEnd := Value; DecodeTime(WorkEnd, H, M, S, MS); if (H = 0) and (M = 0) then WorkEnd := EncodeTime(23, 59, 59, 999); if not (csLoading in ComponentState) and (WorkEnd <= GridStartTime) then raise EJvTFDaysError.CreateRes(@RsEGridEndTimeCannotBePriorToGridStart); FGridEndTime := Value; if not (csLoading in ComponentState) then for I := 0 to Cols.Count - 1 do Cols[I].RefreshMap; end; procedure TJvTFDaysPrinter.SetGridStartTime(Value: TTime); var I: Integer; WorkEnd: TTime; H, M, S, MS: Word; begin WorkEnd := GridEndTime; DecodeTime(WorkEnd, H, M, S, MS); if (H = 0) and (M = 0) then WorkEnd := EncodeTime(23, 59, 59, 999); if not (csLoading in ComponentState) and (Value >= WorkEnd) then raise EJvTFDaysError.CreateRes(@RsEGridStartTimeCannotBeAfterGridEndTi); FGridStartTime := Value; if not (csLoading in ComponentState) then for I := 0 to Cols.Count - 1 do Cols[I].RefreshMap; end; //=== { TJvTFDaysPrinterPageLayout } ========================================= procedure TJvTFDaysPrinterPageLayout.Assign(Source: TPersistent); begin inherited Assign(Source); if Source is TJvTFDaysPrinterPageLayout then begin FColsPerPage := TJvTFDaysPrinterPageLayout(Source).ColsPerPage; FRowsPerPage := TJvTFDaysPrinterPageLayout(Source).RowsPerPage; FAlwaysShowColHdr := TJvTFDaysPrinterPageLayout(Source).AlwaysShowColHdr; FAlwaysShowRowHdr := TJvTFDaysPrinterPageLayout(Source).AlwaysShowRowHdr; // Don't call Change. Ancestor will call it. end; end; procedure TJvTFDaysPrinterPageLayout.SetAlwaysShowColHdr(Value: Boolean); begin SetPropertyCheck; if Value <> FAlwaysShowColHdr then begin FAlwaysShowColHdr := Value; Change; end; end; procedure TJvTFDaysPrinterPageLayout.SetAlwaysShowRowHdr(Value: Boolean); begin SetPropertyCheck; if Value <> FAlwaysShowRowHdr then begin FAlwaysShowRowHdr := Value; Change; end; end; procedure TJvTFDaysPrinterPageLayout.SetColsPerPage(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; if Value <> FColsPerPage then begin FColsPerPage := Value; Change; end; end; procedure TJvTFDaysPrinterPageLayout.SetRowsPerPage(Value: Integer); begin SetPropertyCheck; if Value < 0 then Value := 0; if Value <> FRowsPerPage then begin FRowsPerPage := Value; Change; end; end; //=== { TJvTFCompNamesList } ================================================= procedure TJvTFCompNamesList.Move(CurIndex, NewIndex: Integer); begin inherited Move(CurIndex, NewIndex); if Assigned(FOnMove) then FOnMove(Self, CurIndex, NewIndex); end; {$IFDEF Jv_TIMEBLOCKS} // ok //=== { TJvTFDaysTimeBlock } ================================================= constructor TJvTFDaysTimeBlock.Create(ACollection: TCollection); begin inherited Create(ACollection); FLength := 1; FName := 'Block' + IntToStr(Index); FTitle := Name; FAllowAppts := True; end; procedure TJvTFDaysTimeBlock.Assign(Source: TPersistent); begin if Source is TJvTFDaysTimeBlock then begin FLength := TJvTFDaysTimeBlock(Source).Length; FTitle := TJvTFDaysTimeBlock(Source).Title; FAllowAppts := TJvTFDaysTimeBlock(Source).AllowAppts; Change; end else inherited Assign(Source); end; procedure TJvTFDaysTimeBlock.Change; begin if Assigned(BlockCollection) and Assigned(BlockCollection.DaysControl) then BlockCollection.DaysControl.Invalidate; end; function TJvTFDaysTimeBlock.GetBlockCollection: TJvTFDaysTimeBlocks; begin Result := TJvTFDaysTimeBlocks(Collection); end; function TJvTFDaysTimeBlock.GetDisplayName: string; begin Result := Name; if Result = '' then Result := inherited GetDisplayName; end; function TJvTFDaysTimeBlock.GetGridLength: Integer; var Days: TJvTFDays; begin Days := BlockCollection.DaysControl; Result := Length * (Days.TimeBlockProps.BlockGran div Days.Granularity); end; procedure TJvTFDaysTimeBlock.SetAllowAppts(Value: Boolean); begin FAllowAppts := Value; end; procedure TJvTFDaysTimeBlock.SetLength(Value: Integer); begin if Value < 1 then Value := 1; if Value <> FLength then begin FLength := Value; Change; end; end; procedure TJvTFDaysTimeBlock.SetName(const Value: string); begin if Value = '' then raise EJvTFDaysError.CreateRes(@RsEATimeBlockNameCannotBeNull); if Value <> FName then if not Assigned(BlockCollection.FindBlock(Value)) then begin if Title = Name then Title := Value; FName := Value; Change; end else raise EJvTFDaysError.CreateResFmt(@RsEAnotherTimeBlockWithTheName, [Value]); end; procedure TJvTFDaysTimeBlock.SetTitle(const Value: string); begin if Value <> FTitle then begin FTitle := Value; Change; end; end; //=== { TJvTFDaysTimeBlocks } ================================================ constructor TJvTFDaysTimeBlocks.Create(ADaysControl: TJvTFDays); begin inherited Create(TJvTFDaysTimeBlock); FDaysControl := ADaysControl; end; function TJvTFDaysTimeBlocks.Add: TJvTFDaysTimeBlock; begin Result := TJvTFDaysTimeBlock(inherited Add); end; procedure TJvTFDaysTimeBlocks.Assign(Source: TPersistent); var I: Integer; begin if Source is TJvTFDaysTimeBlocks then begin BeginUpdate; try Clear; for I := 0 to TJvTFDaysTimeBlocks(Source).Count - 1 do Add.Assign(TJvTFDaysTimeBlocks(Source).Items[I]); finally EndUpdate; end; end else inherited Assign(Source); end; function TJvTFDaysTimeBlocks.BlockByName(const BlockName: string): TJvTFDaysTimeBlock; begin Result := FindBlock(BlockName); if not Assigned(Result) then raise EJvTFDaysError.CreateResFmt(@RsEATimeBlockWithTheNamesDoesNotExist, [BlockName]); end; function TJvTFDaysTimeBlocks.FindBlock(const BlockName: string): TJvTFDaysTimeBlock; var I: Integer; begin Result := nil; I := 0; while (I < Count) and not Assigned(Result) do begin if Items[I].Name = BlockName then Result := Items[I]; Inc(I); end; end; function TJvTFDaysTimeBlocks.GetItem(Index: Integer): TJvTFDaysTimeBlock; begin Result := TJvTFDaysTimeBlock(inherited GetItem(Index)); end; function TJvTFDaysTimeBlocks.GetOwner: TPersistent; begin Result := DaysControl; end; procedure TJvTFDaysTimeBlocks.SetItem(Index: Integer; Value: TJvTFDaysTimeBlock); begin inherited SetItem(Index, Value); end; //=== { TJvTFDaysBlockProps } ================================================ constructor TJvTFDaysBlockProps.Create(ADaysControl: TJvTFDays); begin inherited Create; FBlockGran := 60; FDaysControl := ADaysControl; FBlockHdrWidth := DEFAULT_BLOCK_HDR_WIDTH; // will be scaled by FDaysControl FBlockHdrAttr := TJvTFDaysHdrAttr.Create(DaysControl); FSelBlockHdrAttr := TJvTFDaysHdrAttr.Create(DaysControl); FOffTimeColor := clGray; FDataDivColor := clBlack; FSnapMove := True; FDrawOffTime := True; with FSelBlockHdrAttr do begin Color := clBtnFace; Font.Color := clBlack; FrameColor := clBlack; end; end; destructor TJvTFDaysBlockProps.Destroy; begin FBlockHdrAttr.Free; FSelBlockHdrAttr.Free; inherited Destroy; end; procedure TJvTFDaysBlockProps.Assign(Source: TPersistent); begin if Source is TJvTFDaysBlockProps then begin FBlockGran := TJvTFDaysBlockProps(Source).BlockGran; FDayStart := TJvTFDaysBlockProps(Source).DayStart; FBlockHdrWidth := TJvTFDaysBlockProps(Source).BlockHdrWidth; FBlockHdrAttr.Assign(TJvTFDaysBlockProps(Source).BlockHdrAttr); FSelBlockHdrAttr.Assign(TJvTFDaysBlockProps(Source).SelBlockHdrAttr); FOffTimeColor := TJvTFDaysBlockProps(Source).OffTimeColor; FDataDivColor := TJvTFDaysBlockProps(Source).DataDivColor; FSnapMove := TJvTFDaysBlockProps(Source).SnapMove; FDrawOffTime := TJvTFDaysBlockProps(Source).DrawOffTime; Change; end else inherited Assign(Source); end; procedure TJvTFDaysBlockProps.AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin if IsStoredBlockHdrWidth then FBlockHdrWidth := round(FBlockHdrWidth * AXProportion); end; end; procedure TJvTFDaysBlockProps.Change; begin if Assigned(DaysControl) then DaysControl.Invalidate; end; function TJvTFDaysBlockProps.IsStoredBlockHdrWidth: Boolean; begin if Assigned(FDaysControl) then Result := FBlockHdrWidth <> FDaysControl.Scale96ToFont(DEFAULT_BLOCK_HDR_WIDTH) else Result := true; end; procedure TJvTFDaysBlockProps.SetBlockGran(Value: Integer); begin if csLoading in DaysControl.ComponentState then begin FBlockGran := Value; Exit; end; // Enforce minimum granularity of 1 min and max of 60 mins if Value < 1 then Value := 1 else if Value > 60 then Value := 60; // Ensure that granularity is evenly divisible by an hour //while 60 mod Value <> 0 do //Dec(Value); Value := Value - 60 mod Value; if Value <> FBlockGran then begin DaysControl.EnsureBlockRules(DaysControl.Granularity, Value, DayStart); FBlockGran := Value; Change; end; end; procedure TJvTFDaysBlockProps.SetBlockHdrAttr(Value: TJvTFDaysHdrAttr); begin FBlockHdrAttr.Assign(Value); DaysControl.Invalidate; end; procedure TJvTFDaysBlockProps.SetBlockHdrWidth(Value: Integer); begin if Value <> FBlockHdrWidth then begin FBlockHdrWidth := Value; Change; end; end; procedure TJvTFDaysBlockProps.SetDataDivColor(Value: TColor); begin if Value <> FDataDivColor then begin FDataDivColor := Value; Change; end; end; procedure TJvTFDaysBlockProps.SetDayStart(Value: TTime); begin if Value <> FDayStart then begin DaysControl.EnsureBlockRules(DaysControl.Granularity, BlockGran, Value); FDayStart := Value; Change; end; end; procedure TJvTFDaysBlockProps.SetDrawOffTime(Value: Boolean); begin if Value <> FDrawOffTime then begin FDrawOffTime := Value; Change; end; end; procedure TJvTFDaysBlockProps.SetOffTimeColor(Value: TColor); begin if Value <> FOffTimeColor then begin FOffTimeColor := Value; Change; end; end; procedure TJvTFDaysBlockProps.SetSelBlockHdrAttr(Value: TJvTFDaysHdrAttr); begin FSelBlockHdrAttr.Assign(Value); DaysControl.Invalidate; end; {$ENDIF Jv_TIMEBLOCKS} //=== { TJvTFDaysApptDrawInfo } ============================================== constructor TJvTFDaysApptDrawInfo.Create; begin inherited Create; FFont := TFont.Create; end; destructor TJvTFDaysApptDrawInfo.Destroy; begin FFont.Free; inherited Destroy; end; procedure TJvTFDaysApptDrawInfo.SetColor(Value: TColor); begin FColor := Value; end; procedure TJvTFDaysApptDrawInfo.SetFont(Value: TFont); begin FFont.Assign(Value); end; procedure TJvTFDaysApptDrawInfo.SetFrameColor(Value: TColor); begin FFrameColor := Value; end; procedure TJvTFDaysApptDrawInfo.SetFrameWidth(const Value: Integer); begin FFrameWidth := Value; end; procedure TJvTFDaysApptDrawInfo.SetVisible(Value: Boolean); begin FVisible := Value; end; end.