pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

TvPlanIt: Extend GanttView by hour resolution

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8937 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-08 22:41:21 +00:00
parent d826f29a29
commit a41f9dbdcb
5 changed files with 561 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
components/tvplanit/examples/gantt/main.lfm
View File

@ -2,18 +2,18 @@ object MainForm: TMainForm
Left = 319 Left = 319
Height = 600 Height = 600
Top = 125 Top = 125
Width = 800 Width = 865
Caption = 'MainForm' Caption = 'MainForm'
ClientHeight = 600 ClientHeight = 600
ClientWidth = 800 ClientWidth = 865
LCLVersion = '3.99.0.0'
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '2.3.0.0'
object Splitter1: TSplitter object Splitter1: TSplitter
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 240 Top = 240
Width = 800 Width = 865
Align = alTop Align = alTop
ResizeAnchor = akTop ResizeAnchor = akTop
end end
@ -21,11 +21,11 @@ object MainForm: TMainForm
Left = 0 Left = 0
Height = 66 Height = 66
Top = 534 Top = 534
Width = 800 Width = 865
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 66 ClientHeight = 66
ClientWidth = 800 ClientWidth = 865
TabOrder = 1 TabOrder = 1
object Button1: TButton object Button1: TButton
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = Panel1
@ -37,8 +37,8 @@ object MainForm: TMainForm
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'All events' Caption = 'All events'
OnClick = Button1Click
TabOrder = 0 TabOrder = 0
OnClick = Button1Click
end end
object Button2: TButton object Button2: TButton
AnchorSideLeft.Control = Button1 AnchorSideLeft.Control = Button1
@ -51,8 +51,8 @@ object MainForm: TMainForm
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Week of selected date only' Caption = 'Week of selected date only'
OnClick = Button2Click
TabOrder = 1 TabOrder = 1
OnClick = Button2Click
end end
object Button3: TButton object Button3: TButton
AnchorSideLeft.Control = Button2 AnchorSideLeft.Control = Button2
@ -65,8 +65,8 @@ object MainForm: TMainForm
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Month of selected date only' Caption = 'Month of selected date only'
OnClick = Button3Click
TabOrder = 2 TabOrder = 2
OnClick = Button3Click
end end
object CheckBox1: TCheckBox object CheckBox1: TCheckBox
AnchorSideLeft.Control = Button3 AnchorSideLeft.Control = Button3
@ -80,9 +80,9 @@ object MainForm: TMainForm
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Show weekends' Caption = 'Show weekends'
Checked = True Checked = True
OnChange = CheckBox1Change
State = cbChecked State = cbChecked
TabOrder = 3 TabOrder = 3
OnChange = CheckBox1Change
end end
object CheckGroup1: TCheckGroup object CheckGroup1: TCheckGroup
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = Panel1
@ -91,31 +91,34 @@ object MainForm: TMainForm
Left = 581 Left = 581
Height = 54 Height = 54
Top = 6 Top = 6
Width = 185 Width = 241
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
AutoFill = True AutoFill = True
AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Show headers' Caption = 'Show headers'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6 ChildSizing.TopBottomSpacing = 6
ChildSizing.HorizontalSpacing = 12
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3 ChildSizing.ControlsPerLine = 4
ClientHeight = 34 ClientHeight = 34
ClientWidth = 181 ClientWidth = 237
Columns = 3 Columns = 4
Items.Strings = ( Items.Strings = (
'Month' 'Month'
'Week' 'Week'
'Day' 'Day'
'Hours'
) )
OnItemClick = CheckGroup1ItemClick
TabOrder = 4 TabOrder = 4
OnItemClick = CheckGroup1ItemClick
Data = { Data = {
03000000020202 0400000002020202
} }
end end
object CheckBox2: TCheckBox object CheckBox2: TCheckBox
@ -129,9 +132,9 @@ object MainForm: TMainForm
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = '3D' Caption = '3D'
Checked = True Checked = True
OnChange = CheckBox2Change
State = cbChecked State = cbChecked
TabOrder = 5 TabOrder = 5
OnChange = CheckBox2Change
end end
object Button4: TButton object Button4: TButton
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = Panel1
@ -144,8 +147,8 @@ object MainForm: TMainForm
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Edit Print Formats...' Caption = 'Edit Print Formats...'
OnClick = Button4Click
TabOrder = 6 TabOrder = 6
OnClick = Button4Click
end end
object Button5: TButton object Button5: TButton
AnchorSideLeft.Control = Button4 AnchorSideLeft.Control = Button4
@ -159,8 +162,8 @@ object MainForm: TMainForm
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Print Preview...' Caption = 'Print Preview...'
OnClick = Button5Click
TabOrder = 7 TabOrder = 7
OnClick = Button5Click
end end
object Button6: TButton object Button6: TButton
AnchorSideLeft.Control = Button5 AnchorSideLeft.Control = Button5
@ -174,8 +177,8 @@ object MainForm: TMainForm
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Print' Caption = 'Print'
OnClick = Button6Click
TabOrder = 8 TabOrder = 8
OnClick = Button6Click
end end
object VpPrintFormatComboBox1: TVpPrintFormatComboBox object VpPrintFormatComboBox1: TVpPrintFormatComboBox
AnchorSideLeft.Control = Button6 AnchorSideLeft.Control = Button6
@ -197,14 +200,14 @@ object MainForm: TMainForm
Left = 0 Left = 0
Height = 240 Height = 240
Top = 0 Top = 0
Width = 800 Width = 865
Align = alTop Align = alTop
Caption = 'Panel2' Caption = 'Panel2'
ClientHeight = 240 ClientHeight = 240
ClientWidth = 800 ClientWidth = 865
TabOrder = 2 TabOrder = 2
object VpMonthView1: TVpMonthView object VpMonthView1: TVpMonthView
Left = 421 Left = 486
Height = 238 Height = 238
Top = 1 Top = 1
Width = 378 Width = 378
@ -220,7 +223,7 @@ object MainForm: TMainForm
Left = 1 Left = 1
Height = 238 Height = 238
Top = 1 Top = 1
Width = 415 Width = 480
PopupMenu = VpDayView1.default PopupMenu = VpDayView1.default
DataStore = VpIniDatastore1 DataStore = VpIniDatastore1
ControlLink = VpControlLink1 ControlLink = VpControlLink1
@ -235,7 +238,7 @@ object MainForm: TMainForm
NumDays = 2 NumDays = 2
end end
object Splitter2: TSplitter object Splitter2: TSplitter
Left = 416 Left = 481
Height = 238 Height = 238
Top = 1 Top = 1
Width = 5 Width = 5
@ -251,12 +254,12 @@ object MainForm: TMainForm
Printer.MarginUnits = imAbsolutePixel Printer.MarginUnits = imAbsolutePixel
Printer.PrintFormats = < Printer.PrintFormats = <
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayInc = 0 DayInc = 0
DayIncUnits = duDay DayIncUnits = duDay
Elements = < Elements = <
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayOffset = 0 DayOffset = 0
DayOffsetUnits = duDay DayOffsetUnits = duDay
ElementName = 'GanttView' ElementName = 'GanttView'
@ -270,12 +273,12 @@ object MainForm: TMainForm
FormatName = 'Gantt Portrait 0°' FormatName = 'Gantt Portrait 0°'
end end
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayInc = 0 DayInc = 0
DayIncUnits = duDay DayIncUnits = duDay
Elements = < Elements = <
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayOffset = 0 DayOffset = 0
DayOffsetUnits = duDay DayOffsetUnits = duDay
ElementName = 'GanttView rotated 270°' ElementName = 'GanttView rotated 270°'
@ -290,12 +293,12 @@ object MainForm: TMainForm
FormatName = 'Gantt Landscape 270°' FormatName = 'Gantt Landscape 270°'
end end
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayInc = 0 DayInc = 0
DayIncUnits = duDay DayIncUnits = duDay
Elements = < Elements = <
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayOffset = 0 DayOffset = 0
DayOffsetUnits = duDay DayOffsetUnits = duDay
ElementName = 'GanttView rotated 90°' ElementName = 'GanttView rotated 90°'
@ -310,12 +313,12 @@ object MainForm: TMainForm
FormatName = 'Gantt Landscape 90°' FormatName = 'Gantt Landscape 90°'
end end
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayInc = 10 DayInc = 10
DayIncUnits = duDay DayIncUnits = duDay
Elements = < Elements = <
item item
Version = 'v1.7.0' Version = 'v1.8.0'
DayOffset = 0 DayOffset = 0
DayOffsetUnits = duDay DayOffsetUnits = duDay
ElementName = 'GantView' ElementName = 'GantView'
@ -366,7 +369,7 @@ object MainForm: TMainForm
Top = 296 Top = 296
end end
object VpPrintFormatEditDialog1: TVpPrintFormatEditDialog object VpPrintFormatEditDialog1: TVpPrintFormatEditDialog
Version = 'v1.7.0' Version = 'v1.8.0'
DataStore = VpIniDatastore1 DataStore = VpIniDatastore1
ControlLink = VpControlLink1 ControlLink = VpControlLink1
Options = [] Options = []
@ -379,7 +382,7 @@ object MainForm: TMainForm
Top = 56 Top = 56
end end
object VpPrintPreviewDialog1: TVpPrintPreviewDialog object VpPrintPreviewDialog1: TVpPrintPreviewDialog
Version = 'v1.7.0' Version = 'v1.8.0'
DataStore = VpIniDatastore1 DataStore = VpIniDatastore1
ControlLink = VpControlLink1 ControlLink = VpControlLink1
EndDate = 44838.5281092593 EndDate = 44838.5281092593

2
components/tvplanit/examples/gantt/main.pas
View File

@ -77,6 +77,8 @@ begin
FGanttView.Datastore := VpIniDatastore1; FGanttView.Datastore := VpIniDatastore1;
FGanttView.ControlLink := VpControlLink1; FGanttView.ControlLink := VpControlLink1;
FGanttView.ColHeaderAttributes.Visible := [gchMonth, gchWeek, gchDay]; FGanttView.ColHeaderAttributes.Visible := [gchMonth, gchWeek, gchDay];
// FGanttView.StartHour := h_00;
// FGanttView.EndHour := h_23;
Caption := FGanttView.Datastore.ClassName; Caption := FGanttView.Datastore.ClassName;
CheckGroup1.Checked[0] := gchMonth in FGanttView.ColHeaderAttributes.Visible; CheckGroup1.Checked[0] := gchMonth in FGanttView.ColHeaderAttributes.Visible;

6
components/tvplanit/source/vpdayview.pas
View File

@ -2405,12 +2405,12 @@ begin
{$IFNDEF LCL} {$IFNDEF LCL}
VK_TAB: VK_TAB:
if ssShift in Shift then if ssShift in Shift then
Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False))
else else
Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True));
{$ENDIF} {$ENDIF}
VK_F10: VK_F10:
if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin if (ssShift in Shift) and (not Assigned(PopupMenu)) then begin
PopupPoint := GetClientOrigin; PopupPoint := GetClientOrigin;
FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
end; end;

524
components/tvplanit/source/vpganttview.pas
View File

@ -41,6 +41,8 @@ type
procedure SetItem(AIndex: Integer; AItem: PVpGanttEventRec); procedure SetItem(AIndex: Integer; AItem: PVpGanttEventRec);
protected protected
procedure ClipDates(AEventRec: PVpGanttEventRec); procedure ClipDates(AEventRec: PVpGanttEventRec);
function FindFirstRecurrence(AEvent: TVpEvent; out AStart, AEnd: TDateTime): Boolean;
function FindNextRecurrence(AEvent: TVpEvent; var AStart, AEnd: TDateTime): Boolean;
public public
constructor Create(AStartDate, AEndDate: TDateTime); constructor Create(AStartDate, AEndDate: TDateTime);
destructor Destroy; override; destructor Destroy; override;
@ -51,6 +53,12 @@ type
property Items[AIndex: Integer]: PVpGanttEventRec read GetItem write SetItem; default; property Items[AIndex: Integer]: PVpGanttEventRec read GetItem write SetItem; default;
end; end;
TVpGanttHourRec = record
Hour: Integer;
Date: TDateTime;
Rect: TRect;
end;
TVpGanttDayRec = record TVpGanttDayRec = record
Date: TDateTime; Date: TDateTime;
Rect: TRect; Rect: TRect;
@ -92,16 +100,18 @@ type
property EventFont: TVpFont read FEventFont write SetEventFont; property EventFont: TVpFont read FEventFont write SetEventFont;
end; end;
TVpGanttColHeaderKind = (gchMonth, gchWeek, gchDay); TVpGanttColHeaderKind = (gchMonth, gchWeek, gchDay, gchHour);
TVpGanttColHeaderKinds = set of TVpGanttColHeaderKind; TVpGanttColHeaderKinds = set of TVpGanttColHeaderKind;
TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes) TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes)
private private
FHourFont: TVpFont;
FDayFont: TVpFont; FDayFont: TVpFont;
FMonthFont: TVpFont; FMonthFont: TVpFont;
FWeekFont: TVpFont; FWeekFont: TVpFont;
FVisible: TVpGanttColHeaderKinds; FVisible: TVpGanttColHeaderKinds;
procedure SetDayFont(AValue: TVpFont); procedure SetDayFont(AValue: TVpFont);
procedure SetHourfont(AValue: TVpFont);
procedure SetMonthFont(AValue: TVpFont); procedure SetMonthFont(AValue: TVpFont);
procedure SetVisible(AValue: TVpGanttColHeaderKinds); procedure SetVisible(AValue: TVpGanttColHeaderKinds);
procedure SetWeekFont(AValue: TVpFont); procedure SetWeekFont(AValue: TVpFont);
@ -110,6 +120,7 @@ type
destructor Destroy; override; destructor Destroy; override;
published published
property DayFont: TVpFont read FDayFont write SetDayFont; property DayFont: TVpFont read FDayFont write SetDayFont;
property HourFont: TVpFont read FHourFont write SetHourFont;
property MonthFont: TVpFont read FMonthFont write SetMonthFont; property MonthFont: TVpFont read FMonthFont write SetMonthFont;
property Visible: TVpGanttColHeaderKinds read FVisible write SetVisible default [gchMonth, gchDay]; property Visible: TVpGanttColHeaderKinds read FVisible write SetVisible default [gchMonth, gchDay];
property WeekFont: TVpFont read FWeekFont write SetWeekFont; property WeekFont: TVpFont read FWeekFont write SetWeekFont;
@ -148,6 +159,7 @@ type
FMonthColHeaderHeight: Integer; FMonthColHeaderHeight: Integer;
FWeekColHeaderHeight: Integer; FWeekColHeaderHeight: Integer;
FDayColHeaderHeight: Integer; FDayColHeaderHeight: Integer;
FHourColHeaderHeight: Integer;
FTotalColHeaderHeight: Integer; FTotalColHeaderHeight: Integer;
FTextMargin: Integer; FTextMargin: Integer;
@ -160,7 +172,7 @@ type
FRowHeaderAttributes: TVpGanttRowHeaderAttributes; FRowHeaderAttributes: TVpGanttRowHeaderAttributes;
FComponentHint: TTranslateString; FComponentHint: TTranslateString;
FDateFormat: array[0..2] of String; FDateFormat: array[0..3] of String;
FDrawingStyle: TVpDrawingStyle; FDrawingStyle: TVpDrawingStyle;
FDefaultPopup: TPopupMenu; FDefaultPopup: TPopupMenu;
FExternalPopup: TPopupMenu; FExternalPopup: TPopupMenu;
@ -171,6 +183,9 @@ type
FTimeFormat: TVpTimeFormat; FTimeFormat: TVpTimeFormat;
FWeekStartsOn: TVpDayType; FWeekStartsOn: TVpDayType;
FStartHour: TVpHours;
FEndHour: TVpHours;
FOnAddEvent: TVpOnAddNewEvent; FOnAddEvent: TVpOnAddNewEvent;
FOnDeletingEvent: TVpOnDeletingEvent; FOnDeletingEvent: TVpOnDeletingEvent;
FOnHoliday: TVpHolidayEvent; FOnHoliday: TVpHolidayEvent;
@ -180,14 +195,18 @@ type
function GetDateFormat(AIndex: Integer): String; function GetDateFormat(AIndex: Integer): String;
function GetDayRec(AIndex: Integer): TVpGanttDayRec; function GetDayRec(AIndex: Integer): TVpGanttDayRec;
function GetEventRec(AIndex: Integer): PVpGanttEventRec; function GetEventRec(AIndex: Integer): PVpGanttEventRec;
function GetHourRec(AIndex: Integer): TVpGanttHourRec;
function GetMonthRec(AIndex: Integer): TVpGanttMonthRec; function GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
function GetNumDays: Integer; function GetNumDays: Integer;
function GetNumEvents: Integer; function GetNumEvents: Integer;
function GetNumHours: Integer;
function GetNumMonths: Integer; function GetNumMonths: Integer;
function GetNumWeeks: Integer; function GetNumWeeks: Integer;
function GetWeekRec(AIndex: Integer): TVpGanttWeekRec; function GetWeekRec(AIndex: Integer): TVpGanttWeekRec;
function IsStoredColWidth: Boolean; function IsStoredColWidth: Boolean;
function IsStoredDateFormat(AIndex: Integer): Boolean; function IsStoredDateFormat(AIndex: Integer): Boolean;
function IsStoredEndHour: Boolean;
function IsStoredStartHour: Boolean;
procedure SetActiveCol(AValue: Integer); procedure SetActiveCol(AValue: Integer);
procedure SetActiveDate(AValue: TDateTime); procedure SetActiveDate(AValue: TDateTime);
procedure SetActiveEvent(AValue: TVpEvent); procedure SetActiveEvent(AValue: TVpEvent);
@ -196,6 +215,7 @@ type
procedure SetColWidth(AValue: Integer); procedure SetColWidth(AValue: Integer);
procedure SetDateFormat(AIndex: Integer; AValue: String); procedure SetDateFormat(AIndex: Integer; AValue: String);
procedure SetDrawingStyle(AValue: TVpDrawingStyle); procedure SetDrawingStyle(AValue: TVpDrawingStyle);
procedure SetEndHour(AValue: TVpHours);
procedure SetFixedColWidth(AValue: Integer); procedure SetFixedColWidth(AValue: Integer);
procedure SetHolidayColor(AValue: TColor); procedure SetHolidayColor(AValue: TColor);
procedure SetLeftCol(AValue: Integer); procedure SetLeftCol(AValue: Integer);
@ -203,6 +223,7 @@ type
procedure SetOptions(AValue: TVpGanttViewOptions); procedure SetOptions(AValue: TVpGanttViewOptions);
procedure SetPopupMenu(AValue: TPopupMenu); procedure SetPopupMenu(AValue: TPopupMenu);
procedure SetSpecialDayMode(AValue: TVpGanttSpecialDayMode); procedure SetSpecialDayMode(AValue: TVpGanttSpecialDayMode);
procedure SetStartHour(AValue: TVpHours);
procedure SetTextMargin(AValue: Integer); procedure SetTextMargin(AValue: Integer);
procedure SetTopRow(AValue: Integer); procedure SetTopRow(AValue: Integer);
procedure SetWeekendColor(AValue: TColor); procedure SetWeekendColor(AValue: TColor);
@ -211,13 +232,16 @@ type
protected protected
// Needed by the painter // Needed by the painter
FEventRecords: TVpGanttEventList; FEventRecords: TVpGanttEventList;
FHourRecords: array of TVpGanttHourRec;
FDayRecords: array of TVpGanttDayRec; FDayRecords: array of TVpGanttDayRec;
FWeekRecords: array of TVpGanttWeekRec; FWeekRecords: array of TVpGanttWeekRec;
FMonthRecords: array of TVpGanttMonthRec; FMonthRecords: array of TVpGanttMonthRec;
{ internal methods } { internal methods }
procedure CalcColHeaderHeight; procedure CalcColHeaderHeight;
function CalcDaysWidth(ANumDays: Integer): Integer;
procedure CalcRowHeight; procedure CalcRowHeight;
function ColToDateIndex(ACol: Integer): Integer;
function GetColAtCoord(X: Integer): Integer; function GetColAtCoord(X: Integer): Integer;
function GetDateOfCol(ACol: Integer): TDateTime; function GetDateOfCol(ACol: Integer): TDateTime;
function GetDateTimeAtCoord(X: Integer): TDateTime; function GetDateTimeAtCoord(X: Integer): TDateTime;
@ -232,6 +256,7 @@ type
procedure Populate; procedure Populate;
procedure PopulateDayRecords; procedure PopulateDayRecords;
procedure PopulateEventRecords; procedure PopulateEventRecords;
procedure PopulateHourRecords;
procedure PopulateMonthRecords; procedure PopulateMonthRecords;
procedure PopulateWeekRecords; procedure PopulateWeekRecords;
procedure ScrollDateIntoView(ADate: TDateTime); procedure ScrollDateIntoView(ADate: TDateTime);
@ -286,6 +311,8 @@ type
function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String; function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String;
procedure DeleteActiveEvent(Prompt: Boolean); procedure DeleteActiveEvent(Prompt: Boolean);
function GetControlType: TVpItemType; override; function GetControlType: TVpItemType; override;
function HourMode: Boolean;
function HoursPerDay: Integer;
procedure Init; procedure Init;
function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
procedure LoadLanguage; procedure LoadLanguage;
@ -330,16 +357,19 @@ type
// Unscaled dimensions // Unscaled dimensions
property RowHeight: Integer read FRowHeight; property RowHeight: Integer read FRowHeight;
property DayColHeaderHeight: Integer read FDayColHeaderHeight; property DayColHeaderHeight: Integer read FDayColHeaderHeight;
property HourColHeaderHeight: Integer read FHourColHeaderHeight;
property MonthColHeaderHeight: Integer read FMonthColHeaderHeight; property MonthColHeaderHeight: Integer read FMonthColHeaderHeight;
property TotalColHeaderHeight: Integer read FTotalColHeaderHeight; property TotalColHeaderHeight: Integer read FTotalColHeaderHeight;
property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec; property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec;
property EventRecords[AIndex: Integer]: PVpGanttEventRec read GetEventRec; property EventRecords[AIndex: Integer]: PVpGanttEventRec read GetEventRec;
property HourRecords[AIndex: Integer]: TVPGanttHourRec read GetHourRec;
property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec; property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec;
property WeekRecords[AIndex: Integer]: TVpGanttWeekRec read GetWeekRec; property WeekRecords[AIndex: Integer]: TVpGanttWeekRec read GetWeekRec;
property NumDays: Integer read GetNumDays; property NumDays: Integer read GetNumDays;
property NumEvents: Integer read GetNumEvents; property NumEvents: Integer read GetNumEvents;
property NumHours: Integer read GetNumHours;
property NumMonths: Integer read GetNumMonths; property NumMonths: Integer read GetNumMonths;
property NumWeeks: Integer read GetNumWeeks; property NumWeeks: Integer read GetNumWeeks;
@ -354,7 +384,9 @@ type
property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property Color: TColor read FColor write SetColor default DEFAULT_COLOR;
property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth; property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth;
property DayFormat: String index 0 read GetDateFormat write SetDateFormat stored IsStoredDateFormat; property DayFormat: String index 0 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property DayFormat_HourMode: String index 3 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
property EndHour: TVpHours read FEndHour write SetEndHour stored IsStoredEndHour;
property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120; property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120;
property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint; property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint;
property HolidayColor: TColor read FHolidayColor write SetHolidayColor default HOLIDAY_COLOR; property HolidayColor: TColor read FHolidayColor write SetHolidayColor default HOLIDAY_COLOR;
@ -365,6 +397,7 @@ type
property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu; property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes; property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes;
property SpecialDayMode: TVpGanttSpecialDayMode read FSpecialDayMode write SetSpecialDayMode default sdmColumn; property SpecialDayMode: TVpGanttSpecialDayMode read FSpecialDayMode write SetSpecialDayMode default sdmColumn;
property StartHour: TVpHours read FStartHour write SetStartHour stored IsStoredStartHour;
property TextMargin: Integer read FTextMargin write SetTextMargin default 2; property TextMargin: Integer read FTextMargin write SetTextMargin default 2;
property TimeFormat: TVpTimeFormat read FTimeFormat write FTimeFormat default tf12Hour; property TimeFormat: TVpTimeFormat read FTimeFormat write FTimeFormat default tf12Hour;
property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR; property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR;
@ -389,7 +422,10 @@ const
DEFAULT_DAYFORMAT = 'd'; DEFAULT_DAYFORMAT = 'd';
DEFAULT_MONTHFORMAT = 'mmmm yyyy'; DEFAULT_MONTHFORMAT = 'mmmm yyyy';
DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy'; DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy';
DEFAULT_DAYFORMAT_HOURMODE = 'dddddd'; // long date format
DEFAULT_COLWIDTH = 20; DEFAULT_COLWIDTH = 20;
DEFAULT_START_HOUR = h_07;
DEFAULT_END_HOUR = h_20;
{ Compare function for sorting event records: Compares the start times of two events. { Compare function for sorting event records: Compares the start times of two events.
If the times are equal (within 1 seconds) then end times are compared. If the times are equal (within 1 seconds) then end times are compared.
@ -438,54 +474,12 @@ begin
dt2 := AEvent.EndTime; dt2 := AEvent.EndTime;
end; end;
while (DatePart(dt2) >= FStartDate) or (DatePart(dt1) <= FEndDate) do if FindFirstRecurrence(AEvent, dt1, dt2) then
begin repeat
eventRec := AddSingleEvent(AEvent); eventRec := AddSingleEvent(AEvent);
eventRec^.StartTime := dt1; eventRec^.StartTime := dt1;
eventRec^.EndTime := dt2; eventRec^.EndTime := dt2;
ClipDates(eventRec); until not FindNextRecurrence(AEvent, dt1, dt2);
// Find date/times of next recurrance.
case AEvent.RepeatCode of
rtDaily:
begin
dt1 := dt1 + 1;
dt2 := dt2 + 1;
end;
rtWeekly:
begin
dt1 := dt1 + 7;
dt2 := dt2 + 7;
end;
rtMonthlyByDay:
begin
// wp: to do... What does it mean?
end;
rtMonthlyByDate:
begin
dt1 := IncMonth(dt1, 1);
dt2 := IncMonth(dt2, 1);
end;
rtYearlyByDay:
begin
// wp: to do... What does it mean?
end;
rtYearlyByDate:
begin
dt1 := IncYear(dt1, 1);
dt2 := IncYear(dt2, 1);
end;
rtCustom:
begin
dt1 := dt1 + AEvent.CustomInterval;
dt2 := dt2 + AEvent.CustomInterval;
end;
end;
if dt2 >= AEvent.RepeatRangeEnd then
break;
if dt1 > FEndDate then
break;
end;
end; end;
function TVpGanttEventList.AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec; function TVpGanttEventList.AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec;
@ -553,6 +547,129 @@ begin
inherited; inherited;
end; end;
// Find date/times of first recurrence of the specified event in the gantt view's
// date range.
function TVpGanttEventList.FindFirstRecurrence(AEvent: TVpEvent;
out AStart, AEnd: TDateTime): Boolean;
var
delta: Double;
d: TDateTime;
eventYear, eventMonth, eventDay: Word;
startYear, startMonth, startDay: Word;
begin
Result := false;
if AEvent.StartTime >= FEndDate then
exit;
if (AEvent.RepeatRangeEnd > 0) and (AEvent.RepeatRangeEnd <= FStartDate) then
exit;
if AEvent.StartTime >= FStartDate then
begin
AStart := AEvent.StartTime;
AEnd := AEvent.EndTime;
Result := true;
exit;
end;
DecodeDate(AEvent.StartTime, eventYear, eventMonth, eventDay);
DecodeDate(FStartDate, startYear, startMonth, startDay);
case AEvent.RepeatCode of
rtDaily:
AStart := DatePart(FStartDate) + TimePart(AEvent.StartTime);
rtWeekly:
begin
delta := AEvent.StartTime - StartOfTheWeek(AEvent.StartTime);
AStart := StartOfTheWeek(FStartDate) + delta;
end;
rtMonthlyByDay:
begin
delta := AEvent.StartTime - StartOfTheMonth(AEvent.StartTime);
AStart := StartOfTheMonth(FStartDate) + delta;
end;
rtMonthlyByDate:
AStart := EncodeDate(startYear, startMonth, eventDay);
rtYearlyByDay:
begin
delta := AEvent.StartTime - StartofTheYear(AEvent.StartTime);
AStart := StartOfTheYear(FStartDate) + delta;
end;
rtYearlyByDate:
if not TryEncodeDate(startYear, eventMonth, eventDay, AStart) then
AStart := EncodeDate(startYear, 2, 28);
rtCustom:
begin
AStart := trunc((FStartDate - DatePart(AEvent.StartTime)) / AEvent.CustomInterval) * AEvent.CustomInterval + TimePart(AEvent.StartTime);
if AStart < FStartdate then
AStart := AStart + AEvent.CustomInterval;
end;
end;
AEnd := AStart + (AEvent.EndTime - AEvent.StartTime);
if (AEvent.RepeatRangeEnd > 0) and (AEnd > AEvent.RepeatRangeEnd) then
exit;
if AStart > FEndDate + 1 then
exit;
Result := true;
end;
// Find date/times of next recurrence of the specified event.
function TVpGanttEventList.FindNextRecurrence(AEvent: TVpEvent;
var AStart, AEnd: TDateTime): Boolean;
var
delta: Double;
begin
Result := false;
if (AStart >= FEndDate) then
exit;
case AEvent.RepeatCode of
rtDaily:
begin
AStart := AStart + 1;
AEnd := AEnd + 1;
end;
rtWeekly:
begin
AStart := AStart + 7;
AEnd := AEnd + 7;
end;
rtMonthlyByDay:
begin
delta := DatePart(AStart) - StartOfTheMonth(AStart);
AStart := AStart + delta;
AEnd := AEnd + delta;
end;
rtMonthlyByDate:
begin
AStart := IncMonth(AStart, 1);
AEnd := IncMonth(AEnd, 1);
end;
rtYearlyByDay:
begin
delta := DatePart(AStart) - StartOfTheYear(AStart);
AStart := AStart + delta;
AEnd := AEnd + delta;
end;
rtYearlyByDate:
begin
AStart := IncYear(AStart, 1);
AEnd := IncYear(AEnd, 1);
end;
rtCustom:
begin
AStart := AStart + AEvent.CustomInterval;
AEnd := AEnd + AEvent.CustomInterval;
end;
end;
if (AEvent.RepeatRangeEnd > 0) and (AEnd > AEvent.RepeatRangeEnd) then
exit;
if AStart > FEndDate + 1 then
exit;
Result := true;
end;
function TVpGanttEventList.GetItem(AIndex: Integer): PVpGanttEventRec; function TVpGanttEventList.GetItem(AIndex: Integer): PVpGanttEventRec;
begin begin
Result := PVpGanttEventRec(inherited Items[AIndex]); Result := PVpGanttEventRec(inherited Items[AIndex]);
@ -622,6 +739,7 @@ end;
constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView); constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FHourFont := TVpFont.Create(AOwner);
FDayFont := TVpFont.Create(AOwner); FDayFont := TVpFont.Create(AOwner);
FWeekFont := TVpFont.Create(AOwner); FWeekFont := TVpFont.Create(AOwner);
FMonthFont := TVpFont.Create(AOwner); FMonthFont := TVpFont.Create(AOwner);
@ -630,6 +748,7 @@ end;
destructor TVpGanttColHeaderAttributes.Destroy; destructor TVpGanttColHeaderAttributes.Destroy;
begin begin
FHourFont.Free;
FDayFont.Free; FDayFont.Free;
FWeekFont.Free; FWeekFont.Free;
FMonthFont.Free; FMonthFont.Free;
@ -646,6 +765,16 @@ begin
end; end;
end; end;
procedure TVpGanttColHeaderAttributes.SetHourFont(AValue: TVpFont);
begin
if FHourFont <> AValue then
begin
FHourFont := AValue;
FHourFont.Owner := FGanttView;
UpdateGanttView;
end;
end;
procedure TVpGanttColHeaderAttributes.SetMonthFont(AValue: TVpFont); procedure TVpGanttColHeaderAttributes.SetMonthFont(AValue: TVpFont);
begin begin
if FMonthFont <> AValue then if FMonthFont <> AValue then
@ -700,12 +829,16 @@ begin
FWeekendColor := WEEKEND_COLOR; FWeekendColor := WEEKEND_COLOR;
FHolidayColor := HOLIDAY_COLOR; FHolidayColor := HOLIDAY_COLOR;
FStartHour := DEFAULT_START_HOUR;
FEndHour := DEFAULT_END_HOUR;
FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self); FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self);
FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self); FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self);
FDateFormat[0] := DEFAULT_DAYFORMAT; FDateFormat[0] := DEFAULT_DAYFORMAT;
FDateFormat[1] := DEFAULT_MONTHFORMAT; FDateFormat[1] := DEFAULT_MONTHFORMAT;
FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT; FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT;
FDateFormat[3] := DEFAULT_DAYFORMAT_HOURMODE;
FDrawingStyle := ds3d; FDrawingStyle := ds3d;
FOptions := DEFAULT_GANTTVIEW_OPTIONS; FOptions := DEFAULT_GANTTVIEW_OPTIONS;
FScrollBars := ssBoth; FScrollBars := ssBoth;
@ -795,15 +928,18 @@ var
h: Integer; h: Integer;
begin begin
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont); h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont);
FMonthColHeaderHeight := h; // + 2 * FTextMargin; FMonthColHeaderHeight := h;
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.WeekFont); h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.WeekFont);
FWeekColHeaderHeight := h; // + 2 * FTextMargin; FWeekColHeaderHeight := h;
// A typical date string to measure the text height (line breaks in DayFormat allowed) // A typical date string to measure the text height (line breaks in DayFormat allowed)
s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28)); s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28));
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s); h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s);
FDayColHeaderHeight := h; // + FTextMargin; FDayColHeaderHeight := h;
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.HourFont);
FHourColHeaderHeight := h;
FTotalColHeaderHeight := 0; FTotalColHeaderHeight := 0;
if (gchMonth in FColHeaderAttributes.Visible) then if (gchMonth in FColHeaderAttributes.Visible) then
@ -812,10 +948,19 @@ begin
inc(FTotalColHeaderHeight, FWeekColHeaderHeight + FTextMargin); inc(FTotalColHeaderHeight, FWeekColHeaderHeight + FTextMargin);
if (gchDay in FColHeaderAttributes.Visible) then if (gchDay in FColHeaderAttributes.Visible) then
inc(FTotalColHeaderHeight, FDayColHeaderHeight + FTextMargin); inc(FTotalColHeaderHeight, FDayColHeaderHeight + FTextMargin);
if (gchHour in FColHeaderAttributes.Visible) then
inc(FTotalColHeaderHeight, FHourColHeaderHeight + FTextMargin);
if FTotalColHeaderHeight > 0 then if FTotalColHeaderHeight > 0 then
inc(FTotalColHeaderHeight, FTextMargin); inc(FTotalColHeaderHeight, FTextMargin);
end; end;
function TvpGanttView.CalcDaysWidth(ANumDays: Integer): Integer;
begin
Result := ANumDays * FColWidth;
if HourMode then
Result := Result * HoursPerDay;
end;
procedure TVpGanttView.CalcRowHeight; procedure TVpGanttView.CalcRowHeight;
var var
h: Integer; h: Integer;
@ -852,6 +997,14 @@ begin
Result := 0; Result := 0;
end; end;
function TVpGanttView.ColToDateIndex(ACol: Integer): Integer;
begin
if HourMode then
Result := ACol div HoursPerDay
else
Result := ACol;
end;
procedure TVpGanttView.CreateParams(var AParams: TCreateParams); procedure TVpGanttView.CreateParams(var AParams: TCreateParams);
begin begin
inherited CreateParams(AParams); inherited CreateParams(AParams);
@ -993,7 +1146,7 @@ begin
ScrollVertical(-emptyRows); ScrollVertical(-emptyRows);
VisibleCols := CalcVisibleCols(ClientWidth, FFixedColWidth, FColWidth); VisibleCols := CalcVisibleCols(ClientWidth, FFixedColWidth, FColWidth);
emptyCols := VisibleCols - (Length(FDayRecords) - FLeftCol); emptyCols := VisibleCols - (ColCount - FLeftCol);
if emptyCols > 0 then if emptyCols > 0 then
ScrollHorizontal(-emptyCols); ScrollHorizontal(-emptyCols);
end; end;
@ -1018,27 +1171,27 @@ begin
Result := itGanttView; Result := itGanttView;
end; end;
function TVpGanttView.GetDateFormat(AIndex: Integer): String;
begin
Result := FDateFormat[AIndex];
end;
function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime; function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime;
begin begin
Result := FRealStartDate + ACol; Result := FRealStartDate + ColToDateIndex(ACol);
end; end;
function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime; function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime;
var var
days: double; c: Integer;
begin begin
days := (X - FixedColWidth) / FColWidth + FLeftCol; c := GetColAtCoord(X);
if (days >= 0) and (days < NumDays) then if (c >= 0) and (c < ColCount) then
Result := FRealStartDate + days Result := GetDateOfCol(c)
else else
Result := NO_DATE; Result := NO_DATE;
end; end;
function TVpGanttView.GetDateFormat(AIndex: Integer): String;
begin
Result := FDateFormat[AIndex];
end;
function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec; function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec;
begin begin
Result := FDayRecords[AIndex]; Result := FDayRecords[AIndex];
@ -1051,9 +1204,11 @@ var
dt: TDateTime; dt: TDateTime;
begin begin
Result := nil; Result := nil;
dt := GetDateTimeAtCoord(X); dt := GetDateTimeAtCoord(X);
if (dt = -1) or (FRowHeight = 0) then if (dt = NO_DATE) or (FRowHeight = 0) then
exit; exit;
idx := GetRowAtCoord(Y); idx := GetRowAtCoord(Y);
if (idx >= 0) and (idx < NumEvents) then if (idx >= 0) and (idx < NumEvents) then
begin begin
@ -1073,26 +1228,39 @@ end;
and when the latest event ends. } and when the latest event ends. }
procedure TVpGanttView.GetEventDateRange(out AFirstDate, ALastDate: TDate); procedure TVpGanttView.GetEventDateRange(out AFirstDate, ALastDate: TDate);
var var
i: Integer; i, j: Integer;
event: TVpEvent; event: TVpEvent = nil;
d: TDateTime; d: TDateTime;
begin begin
AFirstDate := NO_DATE;
ALastDate := NO_DATE;
if (Datastore = nil) or (Datastore.Resource = nil) or (Datastore.Resource.Schedule.EventCount = 0) then if (Datastore = nil) or (Datastore.Resource = nil) or (Datastore.Resource.Schedule.EventCount = 0) then
exit;
// Find first non-recurring event; recurring events will be accepted only
// between FStartDate and FEndDate.
i := 0;
repeat
event := Datastore.Resource.Schedule.GetEvent(i);
inc(i);
until (event.RepeatCode = rtNone) or (i = DataStore.Resource.Schedule.EventCount);
if event <> nil then
begin begin
AFirstDate := NO_DATE;
ALastDate := NO_DATE;
end else
begin
event := Datastore.Resource.Schedule.GetEvent(0);
AFirstDate := DatePart(event.StartTime); AFirstDate := DatePart(event.StartTime);
ALastDate := -99999; ALastDate := -99999;
for i := 0 to Datastore.Resource.Schedule.EventCount-1 do for j := i-1 to Datastore.Resource.Schedule.EventCount-1 do
begin begin
event := Datastore.Resource.Schedule.GetEvent(i); event := Datastore.Resource.Schedule.GetEvent(j);
d := DatePart(event.EndTime); if event.RepeatCode = rtNone then
if d > ALastDate then ALastDate := d; begin
d := DatePart(event.EndTime);
if d > ALastDate then ALastDate := d;
end;
end; end;
end; end;
// To do: handle recurring events
end; end;
function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent; function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent;
@ -1105,6 +1273,11 @@ begin
Result := FEventRecords[AIndex]; Result := FEventRecords[AIndex];
end; end;
function TVpGanttView.GetHourRec(AIndex: Integer): TVpGanttHourRec;
begin
Result := FHourRecords[AIndex];
end;
function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec; function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
begin begin
Result := FMonthRecords[AIndex]; Result := FMonthRecords[AIndex];
@ -1132,6 +1305,13 @@ begin
Result := 0; Result := 0;
end; end;
{ Determines the number of hours between the first and last Gantt event.
This is the number of hour columns in the view. }
function TVpGanttView.GetNumHours: Integer;
begin
Result := GetNumDays * HoursPerDay;
end;
{ Determines the number of months (complete or partial) between the first and { Determines the number of months (complete or partial) between the first and
last Gantt event. } last Gantt event. }
function TVpGanttView.GetNumMonths: Integer; function TVpGanttView.GetNumMonths: Integer;
@ -1267,6 +1447,16 @@ begin
end; end;
end; end;
function TVpGanttView.HourMode: Boolean;
begin
Result := (gchHour in FColHeaderAttributes.Visible);
end;
function TVpGanttView.HoursPerDay: Integer;
begin
Result := ord(FEndHour) - ord(FStartHour) + 1;
end;
procedure TVpGanttView.Init; procedure TVpGanttView.Init;
begin begin
CalcRowHeight; CalcRowHeight;
@ -1274,14 +1464,19 @@ begin
GetEventDateRange(FFirstDate, FLastDate); GetEventDateRange(FFirstDate, FLastDate);
GetRealEventDateRange(FRealStartDate, FRealEndDate); GetRealEventDateRange(FRealStartDate, FRealEndDate);
FColCount := GetNumDays; if HourMode then
FColCount := GetNumHours
else
FColCount := GetNumDays;
FRowCount := GetNumEvents; FRowCount := GetNumEvents;
PopulateHourRecords;
PopulateDayRecords; PopulateDayRecords;
PopulateWeekRecords; PopulateWeekRecords;
PopulateMonthRecords; PopulateMonthRecords;
PopulateEventRecords; PopulateEventRecords;
end; end;
{ Checks whether the specified date belongs to the specified event. { Checks whether the specified date belongs to the specified event.
The function returns true if the event begins before or at the date and ends The function returns true if the event begins before or at the date and ends
at or after it. } at or after it. }
@ -1324,23 +1519,34 @@ procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState);
procedure ScrollRows(ADelta: Integer); procedure ScrollRows(ADelta: Integer);
begin begin
SetActiveRow(FActiveRow + ADelta); FActiveRow := FActiveRow + ADelta;
if FActiveRow < 0 then FActiveRow := 0;
if FActiveRow >= RowCount then FActiveRow := RowCount-1;
// SetActiveRow(FActiveRow + ADelta);
if FActiveRow <= FTopRow then if FActiveRow <= FTopRow then
ScrollVertical(FActiveRow - FTopRow) ScrollVertical(FActiveRow - FTopRow)
else else
if FActiveRow >= FTopRow + FVisibleRows then if FActiveRow >= FTopRow + FVisibleRows then
ScrollVertical(FActiveRow - (FTopRow + FVisibleRows) + 1); ScrollVertical(FActiveRow - (FTopRow + FVisibleRows) + 1);
SetActiveRow(FActiveRow);
end; end;
var var
P: TPoint; P: TPoint;
OneDay: Integer;
c: Integer;
begin begin
inherited; inherited;
if HourMode then
OneDay := HoursPerDay
else
OneDay := 1;
case Key of case Key of
VK_LEFT: VK_LEFT:
ScrollCols(-1); ScrollCols(-OneDay);
VK_RIGHT: VK_RIGHT:
ScrollCols(1); ScrollCols(OneDay);
VK_DOWN: VK_DOWN:
ScrollRows(1); ScrollRows(1);
VK_UP: VK_UP:
@ -1371,29 +1577,34 @@ begin
ActiveCol := ColCount-1; ActiveCol := ColCount-1;
ActiveRow := RowCount-1; ActiveRow := RowCount-1;
FLeftCol := ColCount - FVisibleCols; FLeftCol := ColCount - FVisibleCols;
if FLeftCol < 0 then FLeftCol := 0;
FTopRow := RowCount - FVisibleRows; FTopRow := RowCount - FVisibleRows;
if FTopRow < 0 then FTopRow := 0;
end else end else
ScrollCols(FVisibleCols); ScrollCols(FVisibleCols);
VK_NEXT: VK_NEXT:
if Shift = [ssCtrl] then // ctrl + page down if Shift = [ssCtrl] then // ctrl + page down
begin ScrollRows(FRowCount)
ActiveRow := RowCount - 1; else
ScrollRows(MaxInt);
end else
ScrollRows(FVisibleRows); // page down ScrollRows(FVisibleRows); // page down
VK_PRIOR: VK_PRIOR:
if Shift = [ssCtrl] then // ctrl + page up if Shift = [ssCtrl] then // ctrl + page up
begin ScrollRows(-FRowCount)
ActiveRow := 0; else
ScrollRows(-MaxInt);
end else
ScrollRows(-FVisibleRows); // page up ScrollRows(-FVisibleRows); // page up
VK_F10, VK_APPS: VK_F10, VK_APPS:
if (ssShift in Shift) then if (ssShift in Shift) then
begin begin
P := GetClientOrigin; P := GetClientOrigin;
P.X := P.X + FDayRecords[FActiveCol].Rect.Right; if HourMode then
P.Y := P.Y + FDayRecords[FActiveCol].Rect.Top; begin
P.X := P.X + FHourRecords[FActiveCol].Rect.Right;
P.Y := P.Y + FHourRecords[FActiveCol].Rect.Top;
end else
begin
P.X := P.X + FDayRecords[FActiveCol].Rect.Right;
P.Y := P.Y + FDayRecords[FActiveCol].Rect.Top;
end;
PopupMenu.Popup(P.X + 10, P.Y + 10); PopupMenu.Popup(P.X + 10, P.Y + 10);
end; end;
VK_RETURN: VK_RETURN:
@ -1420,9 +1631,20 @@ begin
0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT; 0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT;
1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT; 1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT;
2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT; 2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT;
3: Result := FDateFormat[3] <> DEFAULT_DAYFORMAT_HOURMODE;
end; end;
end; end;
function TVpGanttView.IsStoredEndHour: Boolean;
begin
Result := FEndHour <> DEFAULT_END_HOUR;
end;
function TVpGanttView.IsStoredStartHour: Boolean;
begin
Result := FStartHour <> DEFAULT_START_HOUR;
end;
procedure TVpGanttView.LoadLanguage; procedure TVpGanttView.LoadLanguage;
var var
item: TMenuItem; item: TMenuItem;
@ -1484,7 +1706,6 @@ begin
HideHintWindow; HideHintWindow;
end; end;
procedure TVpGanttView.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TVpGanttView.MouseMove(Shift: TShiftState; X, Y: Integer);
var var
event: TVpEvent; event: TVpEvent;
@ -1540,10 +1761,13 @@ begin
inc(y1, FMonthColHeaderHeight + FTextMargin); inc(y1, FMonthColHeaderHeight + FTextMargin);
if (gchWeek in FColHeaderAttributes.Visible) then if (gchWeek in FColHeaderAttributes.Visible) then
inc(y1, FWeekColHeaderHeight + FTextMargin); inc(y1, FWeekColHeaderHeight + FTextMargin);
y2 := FTotalColHeaderHeight; if (gchHour in FColHeaderAttributes.Visible) then
y2 := y1 + FDayColHeaderHeight + FTextMargin
else
y2 := FTotalColHeaderHeight;
for i := 0 to High(FDayRecords) do for i := 0 to High(FDayRecords) do
begin begin
x2 := x1 + ColWidth; x2 := x1 + CalcDaysWidth(1);
FDayRecords[i].Rect := Rect(x1, y1, x2, y2); FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
FDayRecords[i].Date := FRealStartDate + i; FDayRecords[i].Date := FRealStartDate + i;
x1 := x2; x1 := x2;
@ -1592,7 +1816,7 @@ begin
xh1 := 0; xh1 := 0;
xh2 := FixedColWidth; xh2 := FixedColWidth;
y1 := FTotalColHeaderHeight; y1 := FTotalColHeaderHeight;
totalWidth := GetNumDays * ColWidth; totalWidth := CalcDaysWidth(GetNumDays);
for i := 0 to FEventRecords.Count-1 do for i := 0 to FEventRecords.Count-1 do
begin begin
eventRec := FEventRecords[i]; eventRec := FEventRecords[i];
@ -1623,6 +1847,36 @@ begin
end; end;
end; end;
// Populates the array of TVpGanttRec records containing the hours of each day
// cell and the *unscrolled* cell rectangle coordinates.
procedure TVpGanttView.PopulateHourRecords;
var
i: Integer;
x1, y1, x2, y2: Integer;
divRes: Integer = 0;
modRes: Integer = 0;
begin
SetLength(FHourRecords, GetNumHours);
x1 := FixedColWidth;
y1 := 0;
if (gchMonth in FColHeaderAttributes.Visible) then
inc(y1, FMonthColHeaderHeight + FTextMargin);
if (gchWeek in FColHeaderAttributes.Visible) then
inc(y1, FWeekColHeaderHeight + FTextMargin);
if (gchDay in FColHeaderAttributes.Visible) then
inc(y1, FDayColHeaderHeight + FTextMargin);
y2 := FTotalColHeaderHeight;
for i := 0 to High(FHourRecords) do
begin
x2 := x1 + ColWidth;
FHourRecords[i].Rect := Rect(x1, y1, x2, y2);
DivMod(i, HoursPerDay, divRes, modRes);
FHourRecords[i].Date := FRealStartDate + divRes;
FHourRecords[i].Hour := ord(FStartHour) + modRes;
x1 := x2;
end;
end;
procedure TVpGanttView.PopulateMonthRecords; procedure TVpGanttView.PopulateMonthRecords;
var var
i, n: Integer; i, n: Integer;
@ -1660,7 +1914,7 @@ begin
nDays := DaysInMonth(dm); nDays := DaysInMonth(dm);
if dm + nDays > FRealEndDate then if dm + nDays > FRealEndDate then
nDays := trunc(FRealEndDate) - trunc(dm) + 1; nDays := trunc(FRealEndDate) - trunc(dm) + 1;
x2 := x1 + nDays * ColWidth; x2 := x1 + CalcDaysWidth(nDays);
FMonthRecords[i].Rect := Rect(x1, y1, x2, y2); FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[i].Date := dm; FMonthRecords[i].Date := dm;
dm := IncMonth(dm, 1); dm := IncMonth(dm, 1);
@ -1670,7 +1924,7 @@ begin
begin begin
// Date interval is within the same month // Date interval is within the same month
nDays := DayOf(FRealEndDate) - DayOf(FRealStartDate) + 1; nDays := DayOf(FRealEndDate) - DayOf(FRealStartDate) + 1;
x2 := x1 + nDays * ColWidth; x2 := x1 + CalcDaysWidth(nDays);
FMonthRecords[0].Rect := Rect(x1, y1, x2, y2); FMonthRecords[0].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[0].Date := FRealStartDate; FMonthRecords[0].Date := FRealStartDate;
end; end;
@ -1711,7 +1965,7 @@ begin
if dt2 > FRealEndDate then if dt2 > FRealEndDate then
dt2 := FRealEndDate; dt2 := FRealEndDate;
x2 := x1 + (trunc(dt2) - trunc(dt1) + 1) * FColWidth; x2 := x1 + CalcDaysWidth(trunc(dt2) - trunc(dt1) + 1);
FWeekRecords[0].Rect := Rect(x1, y1, x2, y2); FWeekRecords[0].Rect := Rect(x1, y1, x2, y2);
FWeekRecords[0].Date := dt1; FWeekRecords[0].Date := dt1;
FWeekRecords[0].WeekNo := WeekOfTheYear(dt1); FWeekRecords[0].WeekNo := WeekOfTheYear(dt1);
@ -1721,7 +1975,7 @@ begin
dt1 := dt2 + 1; dt1 := dt2 + 1;
dt2 := Min(dt1 + 6, FRealEndDate); dt2 := Min(dt1 + 6, FRealEndDate);
x1 := x2; x1 := x2;
x2 := x1 + (trunc(dt2) - trunc(dt1) + 1) * FColWidth; x2 := x1 + CalcDaysWidth(trunc(dt2) - trunc(dt1) + 1);
FWeekRecords[i].Rect := Rect(x1, y1, x2, y2); FWeekRecords[i].Rect := Rect(x1, y1, x2, y2);
FWeekRecords[i].Date := dt1; FWeekRecords[i].Date := dt1;
FWeekRecords[i].WeekNo := WeekOfTheYear(dt1); FWeekRecords[i].WeekNo := WeekOfTheYear(dt1);
@ -1764,7 +2018,9 @@ procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin begin
inherited; inherited;
DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI); DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI);
DoFixDesignFontPPI(ColHeaderAttributes.WeekFont, ADesignTimePPI);
DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI); DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI);
DoFixDesignFontPPI(ColHeaderAttributes.HourFont, ADesignTimePPI);
DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI); DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI);
end; end;
@ -1773,7 +2029,9 @@ procedure TVpGanttView.ScaleFontsPPI(const AToPPI: Integer;
begin begin
inherited; inherited;
DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion); DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion);
DoScaleFontPPI(ColHeaderAttributes.WeekFont, AToPPI, AProportion);
DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion); DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion);
DoScaleFontPPI(ColHeaderAttributes.HourFont, AToPPI, AProportion);
DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion); DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion);
end; end;
{$ELSEIF VP_LCL_SCALING = 1} {$ELSEIF VP_LCL_SCALING = 1}
@ -1781,34 +2039,51 @@ procedure TVpGantView.ScaleFontsPPI(const AProportion: Double);
begin begin
inherited; inherited;
DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion); DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion);
DoScaleFontPPI(ColHeaderAttributes.WeekFont, AProportion);
DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion); DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion);
DoScaleFontPPI(ColHeaderAttributes.HourFont, AProportion);
DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion); DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion);
end; end;
{$ENDIF} {$ENDIF}
procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime); procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
var
nCols: Integer;
begin begin
if (FRealStartDate = 0) or (FRealStartDate = NO_DATE) then if (FRealStartDate = 0) or (FRealStartDate = NO_DATE) then
exit; exit;
if HourMode then
nCols := GetNumHours
else
nCols := GetNumDays;
if ADate < FRealStartDate then if ADate < FRealStartDate then
begin begin
FRealStartDate := DatePart(ADate); FRealStartDate := DatePart(ADate);
FColCount := GetNumDays; FColCount := nCols;
SetLeftCol(-MaxInt); SetLeftCol(-MaxInt);
end else end else
if ADate > FRealEndDate then if ADate > FRealEndDate then
begin begin
FRealEndDate := DatePart(ADate); FRealEndDate := DatePart(ADate);
FColCount := GetNumDays; FColCount := nCols;
SetLeftCol(FColCount - 1 - FVisibleCols); SetLeftCol(FColCount - 1 - FVisibleCols);
end else end else
if ADate < FRealStartDate + FLeftCol then if ADate < FRealStartDate + FLeftCol then
SetLeftCol(trunc(ADate) - trunc(FRealStartDate)) begin
else if HourMode then
SetLeftCol((trunc(ADate) - trunc(FRealStartDate))*HoursPerDay)
else
SetLeftCol(trunc(ADate) - trunc(FRealStartDate));
end else
if ADate > FRealStartDate + FVisibleCols then if ADate > FRealStartDate + FVisibleCols then
SetLeftCol(trunc(ADate) - FVisibleCols) begin
else if HourMode then
SetLeftCol(trunc(ADate*HoursPerDay) - FVisibleCols)
else
SetLeftCol(trunc(ADate) - FVisibleCols);
end else
exit; exit;
Invalidate; Invalidate;
end; end;
@ -1837,6 +2112,7 @@ var
eventRect, dayRect: TRect; eventRect, dayRect: TRect;
dt: TDateTime; dt: TDateTime;
event: TVpEvent; event: TVpEvent;
c: Integer;
begin begin
if AValue <= 0 then if AValue <= 0 then
FActiveCol := 0 FActiveCol := 0
@ -1845,8 +2121,9 @@ begin
else else
FActiveCol := AValue; FActiveCol := AValue;
dt := DayRecords[FActiveCol].Date; c := ColToDateIndex(FActiveCol);
dayRect := DayRecords[FActiveCol].Rect; dt := DayRecords[c].Date;
dayRect := DayRecords[c].Rect;
event := EventRecords[FActiveRow]^.Event; event := EventRecords[FActiveRow]^.Event;
eventRect := EventRecords[FActiveRow]^.EventRect; eventRect := EventRecords[FActiveRow]^.EventRect;
@ -1862,7 +2139,12 @@ begin
end; end;
procedure TVpGanttView.SetActiveDate(AValue: TDateTime); procedure TVpGanttView.SetActiveDate(AValue: TDateTime);
var
days: Integer;
begin begin
if FColHeaderAttributes = nil then // Needed for HourMode
exit;
if FActiveDate <> DatePart(AValue) then begin if FActiveDate <> DatePart(AValue) then begin
FActiveDate := DatePart(AValue); FActiveDate := DatePart(AValue);
@ -1870,7 +2152,11 @@ begin
Populate; Populate;
ScrollDateIntoView(FActiveDate); ScrollDateIntoView(FActiveDate);
FActiveCol := trunc(FActiveDate) - trunc(FRealStartDate); days := trunc(FActiveDate) - trunc(FRealStartDate);
if HourMode then
FActiveCol := days * HoursPerDay
else
FActiveCol := days;
Invalidate; Invalidate;
@ -1899,6 +2185,7 @@ var
eventRect, dayRect: TRect; eventRect, dayRect: TRect;
event: TVpEvent; event: TVpEvent;
dt: TDateTime; dt: TDateTime;
c: Integer;
begin begin
if AValue < 0 then if AValue < 0 then
FActiveRow := 0 FActiveRow := 0
@ -1909,8 +2196,9 @@ begin
event := EventRecords[FActiveRow]^.Event; event := EventRecords[FActiveRow]^.Event;
eventRect := EventRecords[FActiveRow]^.EventRect; eventRect := EventRecords[FActiveRow]^.EventRect;
dt := DayRecords[FActiveCol].Date; c := ColToDateIndex(FActiveCol);
dayRect := DayRecords[FActiveCol].Rect; dt := DayRecords[c].Date;
dayRect := DayRecords[c].Rect;
dayRect.Top := eventRect.Top; dayRect.Top := eventRect.Top;
dayRect.Bottom := eventRect.Bottom; dayRect.Bottom := eventRect.Bottom;
@ -1957,6 +2245,15 @@ begin
end; end;
end; end;
procedure TVpGanttView.SetEndHour(AValue: TVpHours);
begin
if FEndHour <> AValue then
begin
FEndHour := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetFixedColWidth(AValue: Integer); procedure TVpGanttView.SetFixedColWidth(AValue: Integer);
begin begin
if FFixedColWidth <> AValue then if FFixedColWidth <> AValue then
@ -2046,6 +2343,15 @@ begin
end; end;
end; end;
procedure TVpGanttView.SetStartHour(AValue: TVpHours);
begin
if FStartHour <> AValue then
begin
FStartHour := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetTextMargin(AValue: Integer); procedure TVpGanttView.SetTextMargin(AValue: Integer);
begin begin
if FTextMargin <> AValue then if FTextMargin <> AValue then

108
components/tvplanit/source/vpganttviewpainter.pas
View File

@ -13,6 +13,7 @@ type
private private
FGanttView: TVpGanttView; FGanttView: TVpGanttView;
FHourFont: TFont;
FDayFont: TFont; FDayFont: TFont;
FMonthFont: TFont; FMonthFont: TFont;
FWeekFont: TFont; FWeekFont: TFont;
@ -43,6 +44,7 @@ type
procedure DrawDayColHeaders; procedure DrawDayColHeaders;
procedure DrawEvents; procedure DrawEvents;
procedure DrawGrid; procedure DrawGrid;
procedure DrawHourColHeaders;
procedure DrawMonthColHeaders; procedure DrawMonthColHeaders;
procedure DrawRowHeader; procedure DrawRowHeader;
procedure DrawSpecialDays; procedure DrawSpecialDays;
@ -87,6 +89,7 @@ var
dx, dy: Integer; dx, dy: Integer;
bs: TBrushStyle; bs: TBrushStyle;
pw: Integer; pw: Integer;
c: Integer;
begin begin
with FGanttView do with FGanttView do
begin begin
@ -95,7 +98,10 @@ begin
if (ActiveCol < 0) or (ActiveCol >= ColCount) then if (ActiveCol < 0) or (ActiveCol >= ColCount) then
exit; exit;
dayRec := DayRecords[ActiveCol]; c := ActiveCol;
if HourMode then
c := c div HoursPerDay;
dayRec := DayRecords[c];
eventRec := EventRecords[ActiveRow]; eventRec := EventRecords[ActiveRow];
dx := LeftCol * FScaledColWidth; dx := LeftCol * FScaledColWidth;
@ -184,6 +190,9 @@ begin
// Draw the day column headers // Draw the day column headers
DrawDayColHeaders; DrawDayColHeaders;
// Draw the hour column headers
DrawHourColHeaders;
end; end;
procedure TVpGanttViewPainter.DrawDayColHeaders; procedure TVpGanttViewPainter.DrawDayColHeaders;
@ -191,8 +200,9 @@ var
dayRec: TVpGanttDayRec; dayRec: TVpGanttDayRec;
dx: Integer; dx: Integer;
strH, strLen: Integer; strH, strLen: Integer;
str: String; fmt, str: String;
i, n: Integer; i, n: Integer;
yLineBottom: Integer;
R, R1: TRect; R, R1: TRect;
P: TPoint; P: TPoint;
begin begin
@ -239,6 +249,10 @@ begin
// No dividing line at last day of month because it already has been // No dividing line at last day of month because it already has been
// drawn as the month divider. // drawn as the month divider.
if FGanttView.HourMode then
yLineBottom := FScaledTotalColHeaderHeight
else
yLineBottom := R.Bottom;
if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) or if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) or
([gchWeek, gchDay] * FGanttView.ColHeaderAttributes.Visible = [gchWeek, gchDay]) then ([gchWeek, gchDay] * FGanttView.ColHeaderAttributes.Visible = [gchWeek, gchDay]) then
begin begin
@ -246,19 +260,23 @@ begin
DrawBevelLine( DrawBevelLine(
RenderCanvas, RenderCanvas,
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)), TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)), TPSRotatePoint(Angle, RenderIn, Point(R.Right, yLineBottom)),
BevelShadow, BevelShadow,
BevelHighlight BevelHighlight
) )
else else
begin begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, yLineBottom);
end; end;
end; end;
// Paint day name // Paint day name
str := FormatDateTime(FGanttView.DayFormat, dayRec.Date); if FGanttView.HourMode then
fmt := FGanttView.Dayformat_HourMode
else
fmt := FGanttView.DayFormat;
str := FormatDateTime(fmt, dayRec.Date);
strLen := RenderCanvas.TextWidth(str); strLen := RenderCanvas.TextWidth(str);
P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2); P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
@ -321,6 +339,7 @@ begin
RenderCanvas.Pen.Color := cat.Color; RenderCanvas.Pen.Color := cat.Color;
RenderCanvas.Pen.Width := round(Scale); RenderCanvas.Pen.Width := round(Scale);
RenderCanvas.Brush.Color := cat.BackgroundColor; RenderCanvas.Brush.Color := cat.BackgroundColor;
//RenderCanvas.Brush.Style := bsSolid;
TPSRectangle(RenderCanvas, Angle, RenderIn, R); TPSRectangle(RenderCanvas, Angle, RenderIn, R);
end; end;
end; end;
@ -399,6 +418,84 @@ begin
end; end;
end; end;
procedure TVpGanttViewPainter.DrawHourColHeaders;
var
hourRec: TVpGanttHourRec;
dx: Integer;
strH, strLen: Integer;
str: String;
i, n: Integer;
R, R1: TRect;
P: TPoint;
begin
if not (gchHour in FGanttView.ColHeaderAttributes.Visible) then
exit;
// Offset due to scrolling
dx := FGanttView.LeftCol * FScaledColWidth;
// Draw hour captions (always centered) and dividing lines (always at right side).
RenderCanvas.Font.Assign(FHourFont);
strH := RenderCanvas.TextHeight('Tg');
n := FGanttView.NumHours;
for i := 0 to n - 1 do
begin
hourRec := FGanttView.HourRecords[i];
R := ScaleRect(hourRec.Rect);
OffsetRect(R, -dx, 0);
if R.Left < RealLeft + FScaledFixedColWidth then
Continue;
// In sdmHeader SpecialDayMode we must repaint the background of the
// day cells in the color of the special day (weekend/holiday)
if (FGanttView.SpecialDayMode = sdmHeader) then
begin
R1 := R;
if FGanttView.DrawingStyle = ds3D then
begin
inc(R1.Left, 2);
dec(R1.Bottom);
end else
inc(R1.Left);
if (gvoWeekends in FGanttView.Options) and IsWeekend(hourRec.Date) then
begin;
RenderCanvas.Brush.Color := FGanttView.Weekendcolor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
end else
if (gvoHolidays in FGanttView.Options) and FGanttView.IsHoliday(hourRec.Date, str) then
begin
RenderCanvas.Brush.Color := FGanttView.HolidayColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R1);
end;
end;
// No dividing line at last hour of day because it already has been
// drawn as the day divider.
if hourRec.Hour <> 23 then
begin
if FGanttView.DrawingStyle = ds3D then
DrawBevelLine(
RenderCanvas,
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)),
TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)),
BevelShadow,
BevelHighlight
)
else
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
end;
end;
// Paint hour value
str := IntToStr(hourRec.Hour);
strLen := RenderCanvas.TextWidth(str);
P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
end;
end;
procedure TVpGanttViewPainter.DrawMonthColHeaders; procedure TVpGanttViewPainter.DrawMonthColHeaders;
var var
dx: Integer; dx: Integer;
@ -710,6 +807,7 @@ begin
RealLineColor := ColorToRGB(FGanttView.LineColor); RealLineColor := ColorToRGB(FGanttView.LineColor);
end; end;
FHourFont := FGanttView.ColHeaderAttributes.HourFont;
FDayFont := FGanttView.ColHeaderAttributes.DayFont; FDayFont := FGanttView.ColHeaderAttributes.DayFont;
FMonthFont := FGanttView.ColHeaderAttributes.MonthFont; FMonthFont := FGanttView.ColHeaderAttributes.MonthFont;
FWeekFont := FGanttView.ColHeaderAttributes.WeekFont; FWeekFont := FGanttView.ColHeaderAttributes.WeekFont;