diff --git a/components/tvplanit/examples/gantt/main.lfm b/components/tvplanit/examples/gantt/main.lfm index 0fa38d844..2f88d8adc 100644 --- a/components/tvplanit/examples/gantt/main.lfm +++ b/components/tvplanit/examples/gantt/main.lfm @@ -2,18 +2,18 @@ object MainForm: TMainForm Left = 319 Height = 600 Top = 125 - Width = 800 + Width = 865 Caption = 'MainForm' ClientHeight = 600 - ClientWidth = 800 + ClientWidth = 865 + LCLVersion = '3.99.0.0' OnCreate = FormCreate - LCLVersion = '2.3.0.0' object Splitter1: TSplitter Cursor = crVSplit Left = 0 Height = 5 Top = 240 - Width = 800 + Width = 865 Align = alTop ResizeAnchor = akTop end @@ -21,11 +21,11 @@ object MainForm: TMainForm Left = 0 Height = 66 Top = 534 - Width = 800 + Width = 865 Align = alBottom BevelOuter = bvNone ClientHeight = 66 - ClientWidth = 800 + ClientWidth = 865 TabOrder = 1 object Button1: TButton AnchorSideLeft.Control = Panel1 @@ -37,8 +37,8 @@ object MainForm: TMainForm AutoSize = True BorderSpacing.Around = 6 Caption = 'All events' - OnClick = Button1Click TabOrder = 0 + OnClick = Button1Click end object Button2: TButton AnchorSideLeft.Control = Button1 @@ -51,8 +51,8 @@ object MainForm: TMainForm AutoSize = True BorderSpacing.Around = 6 Caption = 'Week of selected date only' - OnClick = Button2Click TabOrder = 1 + OnClick = Button2Click end object Button3: TButton AnchorSideLeft.Control = Button2 @@ -65,8 +65,8 @@ object MainForm: TMainForm AutoSize = True BorderSpacing.Around = 6 Caption = 'Month of selected date only' - OnClick = Button3Click TabOrder = 2 + OnClick = Button3Click end object CheckBox1: TCheckBox AnchorSideLeft.Control = Button3 @@ -80,9 +80,9 @@ object MainForm: TMainForm BorderSpacing.Top = 6 Caption = 'Show weekends' Checked = True - OnChange = CheckBox1Change State = cbChecked TabOrder = 3 + OnChange = CheckBox1Change end object CheckGroup1: TCheckGroup AnchorSideTop.Control = Panel1 @@ -91,31 +91,34 @@ object MainForm: TMainForm Left = 581 Height = 54 Top = 6 - Width = 185 + Width = 241 Anchors = [akTop, akLeft, akBottom] AutoFill = True + AutoSize = True BorderSpacing.Around = 6 Caption = 'Show headers' ChildSizing.LeftRightSpacing = 6 ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 12 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 3 + ChildSizing.ControlsPerLine = 4 ClientHeight = 34 - ClientWidth = 181 - Columns = 3 + ClientWidth = 237 + Columns = 4 Items.Strings = ( 'Month' 'Week' 'Day' + 'Hours' ) - OnItemClick = CheckGroup1ItemClick TabOrder = 4 + OnItemClick = CheckGroup1ItemClick Data = { - 03000000020202 + 0400000002020202 } end object CheckBox2: TCheckBox @@ -129,9 +132,9 @@ object MainForm: TMainForm BorderSpacing.Top = 6 Caption = '3D' Checked = True - OnChange = CheckBox2Change State = cbChecked TabOrder = 5 + OnChange = CheckBox2Change end object Button4: TButton AnchorSideLeft.Control = Panel1 @@ -144,8 +147,8 @@ object MainForm: TMainForm AutoSize = True BorderSpacing.Around = 6 Caption = 'Edit Print Formats...' - OnClick = Button4Click TabOrder = 6 + OnClick = Button4Click end object Button5: TButton AnchorSideLeft.Control = Button4 @@ -159,8 +162,8 @@ object MainForm: TMainForm AutoSize = True BorderSpacing.Around = 6 Caption = 'Print Preview...' - OnClick = Button5Click TabOrder = 7 + OnClick = Button5Click end object Button6: TButton AnchorSideLeft.Control = Button5 @@ -174,8 +177,8 @@ object MainForm: TMainForm AutoSize = True BorderSpacing.Around = 6 Caption = 'Print' - OnClick = Button6Click TabOrder = 8 + OnClick = Button6Click end object VpPrintFormatComboBox1: TVpPrintFormatComboBox AnchorSideLeft.Control = Button6 @@ -197,14 +200,14 @@ object MainForm: TMainForm Left = 0 Height = 240 Top = 0 - Width = 800 + Width = 865 Align = alTop Caption = 'Panel2' ClientHeight = 240 - ClientWidth = 800 + ClientWidth = 865 TabOrder = 2 object VpMonthView1: TVpMonthView - Left = 421 + Left = 486 Height = 238 Top = 1 Width = 378 @@ -220,7 +223,7 @@ object MainForm: TMainForm Left = 1 Height = 238 Top = 1 - Width = 415 + Width = 480 PopupMenu = VpDayView1.default DataStore = VpIniDatastore1 ControlLink = VpControlLink1 @@ -235,7 +238,7 @@ object MainForm: TMainForm NumDays = 2 end object Splitter2: TSplitter - Left = 416 + Left = 481 Height = 238 Top = 1 Width = 5 @@ -251,12 +254,12 @@ object MainForm: TMainForm Printer.MarginUnits = imAbsolutePixel Printer.PrintFormats = < item - Version = 'v1.7.0' + Version = 'v1.8.0' DayInc = 0 DayIncUnits = duDay Elements = < item - Version = 'v1.7.0' + Version = 'v1.8.0' DayOffset = 0 DayOffsetUnits = duDay ElementName = 'GanttView' @@ -270,12 +273,12 @@ object MainForm: TMainForm FormatName = 'Gantt Portrait 0°' end item - Version = 'v1.7.0' + Version = 'v1.8.0' DayInc = 0 DayIncUnits = duDay Elements = < item - Version = 'v1.7.0' + Version = 'v1.8.0' DayOffset = 0 DayOffsetUnits = duDay ElementName = 'GanttView rotated 270°' @@ -290,12 +293,12 @@ object MainForm: TMainForm FormatName = 'Gantt Landscape 270°' end item - Version = 'v1.7.0' + Version = 'v1.8.0' DayInc = 0 DayIncUnits = duDay Elements = < item - Version = 'v1.7.0' + Version = 'v1.8.0' DayOffset = 0 DayOffsetUnits = duDay ElementName = 'GanttView rotated 90°' @@ -310,12 +313,12 @@ object MainForm: TMainForm FormatName = 'Gantt Landscape 90°' end item - Version = 'v1.7.0' + Version = 'v1.8.0' DayInc = 10 DayIncUnits = duDay Elements = < item - Version = 'v1.7.0' + Version = 'v1.8.0' DayOffset = 0 DayOffsetUnits = duDay ElementName = 'GantView' @@ -366,7 +369,7 @@ object MainForm: TMainForm Top = 296 end object VpPrintFormatEditDialog1: TVpPrintFormatEditDialog - Version = 'v1.7.0' + Version = 'v1.8.0' DataStore = VpIniDatastore1 ControlLink = VpControlLink1 Options = [] @@ -379,7 +382,7 @@ object MainForm: TMainForm Top = 56 end object VpPrintPreviewDialog1: TVpPrintPreviewDialog - Version = 'v1.7.0' + Version = 'v1.8.0' DataStore = VpIniDatastore1 ControlLink = VpControlLink1 EndDate = 44838.5281092593 diff --git a/components/tvplanit/examples/gantt/main.pas b/components/tvplanit/examples/gantt/main.pas index 1f6d6e38b..6a5981d9c 100644 --- a/components/tvplanit/examples/gantt/main.pas +++ b/components/tvplanit/examples/gantt/main.pas @@ -77,6 +77,8 @@ begin FGanttView.Datastore := VpIniDatastore1; FGanttView.ControlLink := VpControlLink1; FGanttView.ColHeaderAttributes.Visible := [gchMonth, gchWeek, gchDay]; +// FGanttView.StartHour := h_00; +// FGanttView.EndHour := h_23; Caption := FGanttView.Datastore.ClassName; CheckGroup1.Checked[0] := gchMonth in FGanttView.ColHeaderAttributes.Visible; diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index fdd26f343..04ffccd01 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/components/tvplanit/source/vpdayview.pas @@ -2405,12 +2405,12 @@ begin {$IFNDEF LCL} VK_TAB: if ssShift in Shift then - Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) + Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False)) else - Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); + Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True)); {$ENDIF} VK_F10: - if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + if (ssShift in Shift) and (not Assigned(PopupMenu)) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index a6cf8496d..99de29612 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -41,6 +41,8 @@ type procedure SetItem(AIndex: Integer; AItem: PVpGanttEventRec); protected procedure ClipDates(AEventRec: PVpGanttEventRec); + function FindFirstRecurrence(AEvent: TVpEvent; out AStart, AEnd: TDateTime): Boolean; + function FindNextRecurrence(AEvent: TVpEvent; var AStart, AEnd: TDateTime): Boolean; public constructor Create(AStartDate, AEndDate: TDateTime); destructor Destroy; override; @@ -51,6 +53,12 @@ type property Items[AIndex: Integer]: PVpGanttEventRec read GetItem write SetItem; default; end; + TVpGanttHourRec = record + Hour: Integer; + Date: TDateTime; + Rect: TRect; + end; + TVpGanttDayRec = record Date: TDateTime; Rect: TRect; @@ -92,16 +100,18 @@ type property EventFont: TVpFont read FEventFont write SetEventFont; end; - TVpGanttColHeaderKind = (gchMonth, gchWeek, gchDay); + TVpGanttColHeaderKind = (gchMonth, gchWeek, gchDay, gchHour); TVpGanttColHeaderKinds = set of TVpGanttColHeaderKind; TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes) private + FHourFont: TVpFont; FDayFont: TVpFont; FMonthFont: TVpFont; FWeekFont: TVpFont; FVisible: TVpGanttColHeaderKinds; procedure SetDayFont(AValue: TVpFont); + procedure SetHourfont(AValue: TVpFont); procedure SetMonthFont(AValue: TVpFont); procedure SetVisible(AValue: TVpGanttColHeaderKinds); procedure SetWeekFont(AValue: TVpFont); @@ -110,6 +120,7 @@ type destructor Destroy; override; published property DayFont: TVpFont read FDayFont write SetDayFont; + property HourFont: TVpFont read FHourFont write SetHourFont; property MonthFont: TVpFont read FMonthFont write SetMonthFont; property Visible: TVpGanttColHeaderKinds read FVisible write SetVisible default [gchMonth, gchDay]; property WeekFont: TVpFont read FWeekFont write SetWeekFont; @@ -148,6 +159,7 @@ type FMonthColHeaderHeight: Integer; FWeekColHeaderHeight: Integer; FDayColHeaderHeight: Integer; + FHourColHeaderHeight: Integer; FTotalColHeaderHeight: Integer; FTextMargin: Integer; @@ -160,7 +172,7 @@ type FRowHeaderAttributes: TVpGanttRowHeaderAttributes; FComponentHint: TTranslateString; - FDateFormat: array[0..2] of String; + FDateFormat: array[0..3] of String; FDrawingStyle: TVpDrawingStyle; FDefaultPopup: TPopupMenu; FExternalPopup: TPopupMenu; @@ -171,6 +183,9 @@ type FTimeFormat: TVpTimeFormat; FWeekStartsOn: TVpDayType; + FStartHour: TVpHours; + FEndHour: TVpHours; + FOnAddEvent: TVpOnAddNewEvent; FOnDeletingEvent: TVpOnDeletingEvent; FOnHoliday: TVpHolidayEvent; @@ -180,14 +195,18 @@ type function GetDateFormat(AIndex: Integer): String; function GetDayRec(AIndex: Integer): TVpGanttDayRec; function GetEventRec(AIndex: Integer): PVpGanttEventRec; + function GetHourRec(AIndex: Integer): TVpGanttHourRec; function GetMonthRec(AIndex: Integer): TVpGanttMonthRec; function GetNumDays: Integer; function GetNumEvents: Integer; + function GetNumHours: Integer; function GetNumMonths: Integer; function GetNumWeeks: Integer; function GetWeekRec(AIndex: Integer): TVpGanttWeekRec; function IsStoredColWidth: Boolean; function IsStoredDateFormat(AIndex: Integer): Boolean; + function IsStoredEndHour: Boolean; + function IsStoredStartHour: Boolean; procedure SetActiveCol(AValue: Integer); procedure SetActiveDate(AValue: TDateTime); procedure SetActiveEvent(AValue: TVpEvent); @@ -196,6 +215,7 @@ type procedure SetColWidth(AValue: Integer); procedure SetDateFormat(AIndex: Integer; AValue: String); procedure SetDrawingStyle(AValue: TVpDrawingStyle); + procedure SetEndHour(AValue: TVpHours); procedure SetFixedColWidth(AValue: Integer); procedure SetHolidayColor(AValue: TColor); procedure SetLeftCol(AValue: Integer); @@ -203,6 +223,7 @@ type procedure SetOptions(AValue: TVpGanttViewOptions); procedure SetPopupMenu(AValue: TPopupMenu); procedure SetSpecialDayMode(AValue: TVpGanttSpecialDayMode); + procedure SetStartHour(AValue: TVpHours); procedure SetTextMargin(AValue: Integer); procedure SetTopRow(AValue: Integer); procedure SetWeekendColor(AValue: TColor); @@ -211,13 +232,16 @@ type protected // Needed by the painter FEventRecords: TVpGanttEventList; + FHourRecords: array of TVpGanttHourRec; FDayRecords: array of TVpGanttDayRec; FWeekRecords: array of TVpGanttWeekRec; FMonthRecords: array of TVpGanttMonthRec; { internal methods } procedure CalcColHeaderHeight; + function CalcDaysWidth(ANumDays: Integer): Integer; procedure CalcRowHeight; + function ColToDateIndex(ACol: Integer): Integer; function GetColAtCoord(X: Integer): Integer; function GetDateOfCol(ACol: Integer): TDateTime; function GetDateTimeAtCoord(X: Integer): TDateTime; @@ -232,6 +256,7 @@ type procedure Populate; procedure PopulateDayRecords; procedure PopulateEventRecords; + procedure PopulateHourRecords; procedure PopulateMonthRecords; procedure PopulateWeekRecords; procedure ScrollDateIntoView(ADate: TDateTime); @@ -286,6 +311,8 @@ type function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String; procedure DeleteActiveEvent(Prompt: Boolean); function GetControlType: TVpItemType; override; + function HourMode: Boolean; + function HoursPerDay: Integer; procedure Init; function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; procedure LoadLanguage; @@ -330,16 +357,19 @@ type // Unscaled dimensions property RowHeight: Integer read FRowHeight; property DayColHeaderHeight: Integer read FDayColHeaderHeight; + property HourColHeaderHeight: Integer read FHourColHeaderHeight; property MonthColHeaderHeight: Integer read FMonthColHeaderHeight; property TotalColHeaderHeight: Integer read FTotalColHeaderHeight; property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec; property EventRecords[AIndex: Integer]: PVpGanttEventRec read GetEventRec; + property HourRecords[AIndex: Integer]: TVPGanttHourRec read GetHourRec; property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec; property WeekRecords[AIndex: Integer]: TVpGanttWeekRec read GetWeekRec; property NumDays: Integer read GetNumDays; property NumEvents: Integer read GetNumEvents; + property NumHours: Integer read GetNumHours; property NumMonths: Integer read GetNumMonths; property NumWeeks: Integer read GetNumWeeks; @@ -354,7 +384,9 @@ type property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth; 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 EndHour: TVpHours read FEndHour write SetEndHour stored IsStoredEndHour; property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120; property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint; property HolidayColor: TColor read FHolidayColor write SetHolidayColor default HOLIDAY_COLOR; @@ -365,6 +397,7 @@ type property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu; property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes; 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 TimeFormat: TVpTimeFormat read FTimeFormat write FTimeFormat default tf12Hour; property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR; @@ -389,7 +422,10 @@ const DEFAULT_DAYFORMAT = 'd'; DEFAULT_MONTHFORMAT = 'mmmm yyyy'; DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy'; + DEFAULT_DAYFORMAT_HOURMODE = 'dddddd'; // long date format 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. If the times are equal (within 1 seconds) then end times are compared. @@ -438,54 +474,12 @@ begin dt2 := AEvent.EndTime; end; - while (DatePart(dt2) >= FStartDate) or (DatePart(dt1) <= FEndDate) do - begin - eventRec := AddSingleEvent(AEvent); - eventRec^.StartTime := dt1; - eventRec^.EndTime := dt2; - ClipDates(eventRec); - - // 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; + if FindFirstRecurrence(AEvent, dt1, dt2) then + repeat + eventRec := AddSingleEvent(AEvent); + eventRec^.StartTime := dt1; + eventRec^.EndTime := dt2; + until not FindNextRecurrence(AEvent, dt1, dt2); end; function TVpGanttEventList.AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec; @@ -553,6 +547,129 @@ begin inherited; 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; begin Result := PVpGanttEventRec(inherited Items[AIndex]); @@ -622,6 +739,7 @@ end; constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView); begin inherited Create(AOwner); + FHourFont := TVpFont.Create(AOwner); FDayFont := TVpFont.Create(AOwner); FWeekFont := TVpFont.Create(AOwner); FMonthFont := TVpFont.Create(AOwner); @@ -630,6 +748,7 @@ end; destructor TVpGanttColHeaderAttributes.Destroy; begin + FHourFont.Free; FDayFont.Free; FWeekFont.Free; FMonthFont.Free; @@ -646,6 +765,16 @@ begin 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); begin if FMonthFont <> AValue then @@ -700,12 +829,16 @@ begin FWeekendColor := WEEKEND_COLOR; FHolidayColor := HOLIDAY_COLOR; + FStartHour := DEFAULT_START_HOUR; + FEndHour := DEFAULT_END_HOUR; + FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self); FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self); FDateFormat[0] := DEFAULT_DAYFORMAT; FDateFormat[1] := DEFAULT_MONTHFORMAT; FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT; + FDateFormat[3] := DEFAULT_DAYFORMAT_HOURMODE; FDrawingStyle := ds3d; FOptions := DEFAULT_GANTTVIEW_OPTIONS; FScrollBars := ssBoth; @@ -795,15 +928,18 @@ var h: Integer; begin h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont); - FMonthColHeaderHeight := h; // + 2 * FTextMargin; + FMonthColHeaderHeight := h; 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) s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28)); h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s); - FDayColHeaderHeight := h; // + FTextMargin; + FDayColHeaderHeight := h; + + h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.HourFont); + FHourColHeaderHeight := h; FTotalColHeaderHeight := 0; if (gchMonth in FColHeaderAttributes.Visible) then @@ -812,10 +948,19 @@ begin inc(FTotalColHeaderHeight, FWeekColHeaderHeight + FTextMargin); if (gchDay in FColHeaderAttributes.Visible) then inc(FTotalColHeaderHeight, FDayColHeaderHeight + FTextMargin); + if (gchHour in FColHeaderAttributes.Visible) then + inc(FTotalColHeaderHeight, FHourColHeaderHeight + FTextMargin); if FTotalColHeaderHeight > 0 then inc(FTotalColHeaderHeight, FTextMargin); end; +function TvpGanttView.CalcDaysWidth(ANumDays: Integer): Integer; +begin + Result := ANumDays * FColWidth; + if HourMode then + Result := Result * HoursPerDay; +end; + procedure TVpGanttView.CalcRowHeight; var h: Integer; @@ -852,6 +997,14 @@ begin Result := 0; 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); begin inherited CreateParams(AParams); @@ -993,7 +1146,7 @@ begin ScrollVertical(-emptyRows); VisibleCols := CalcVisibleCols(ClientWidth, FFixedColWidth, FColWidth); - emptyCols := VisibleCols - (Length(FDayRecords) - FLeftCol); + emptyCols := VisibleCols - (ColCount - FLeftCol); if emptyCols > 0 then ScrollHorizontal(-emptyCols); end; @@ -1018,27 +1171,27 @@ begin Result := itGanttView; end; +function TVpGanttView.GetDateFormat(AIndex: Integer): String; +begin + Result := FDateFormat[AIndex]; +end; + function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime; begin - Result := FRealStartDate + ACol; + Result := FRealStartDate + ColToDateIndex(ACol); end; function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime; var - days: double; + c: Integer; begin - days := (X - FixedColWidth) / FColWidth + FLeftCol; - if (days >= 0) and (days < NumDays) then - Result := FRealStartDate + days + c := GetColAtCoord(X); + if (c >= 0) and (c < ColCount) then + Result := GetDateOfCol(c) else Result := NO_DATE; end; -function TVpGanttView.GetDateFormat(AIndex: Integer): String; -begin - Result := FDateFormat[AIndex]; -end; - function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec; begin Result := FDayRecords[AIndex]; @@ -1051,9 +1204,11 @@ var dt: TDateTime; begin Result := nil; + dt := GetDateTimeAtCoord(X); - if (dt = -1) or (FRowHeight = 0) then + if (dt = NO_DATE) or (FRowHeight = 0) then exit; + idx := GetRowAtCoord(Y); if (idx >= 0) and (idx < NumEvents) then begin @@ -1073,26 +1228,39 @@ end; and when the latest event ends. } procedure TVpGanttView.GetEventDateRange(out AFirstDate, ALastDate: TDate); var - i: Integer; - event: TVpEvent; + i, j: Integer; + event: TVpEvent = nil; d: TDateTime; begin + AFirstDate := NO_DATE; + ALastDate := NO_DATE; 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 - AFirstDate := NO_DATE; - ALastDate := NO_DATE; - end else - begin - event := Datastore.Resource.Schedule.GetEvent(0); AFirstDate := DatePart(event.StartTime); ALastDate := -99999; - for i := 0 to Datastore.Resource.Schedule.EventCount-1 do + for j := i-1 to Datastore.Resource.Schedule.EventCount-1 do begin - event := Datastore.Resource.Schedule.GetEvent(i); - d := DatePart(event.EndTime); - if d > ALastDate then ALastDate := d; + event := Datastore.Resource.Schedule.GetEvent(j); + if event.RepeatCode = rtNone then + begin + d := DatePart(event.EndTime); + if d > ALastDate then ALastDate := d; + end; end; end; + + // To do: handle recurring events end; function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent; @@ -1105,6 +1273,11 @@ begin Result := FEventRecords[AIndex]; end; +function TVpGanttView.GetHourRec(AIndex: Integer): TVpGanttHourRec; +begin + Result := FHourRecords[AIndex]; +end; + function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec; begin Result := FMonthRecords[AIndex]; @@ -1132,6 +1305,13 @@ begin Result := 0; 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 last Gantt event. } function TVpGanttView.GetNumMonths: Integer; @@ -1267,6 +1447,16 @@ begin 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; begin CalcRowHeight; @@ -1274,14 +1464,19 @@ begin GetEventDateRange(FFirstDate, FLastDate); GetRealEventDateRange(FRealStartDate, FRealEndDate); - FColCount := GetNumDays; + if HourMode then + FColCount := GetNumHours + else + FColCount := GetNumDays; FRowCount := GetNumEvents; + PopulateHourRecords; PopulateDayRecords; PopulateWeekRecords; PopulateMonthRecords; PopulateEventRecords; end; + { 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 at or after it. } @@ -1324,23 +1519,34 @@ procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState); procedure ScrollRows(ADelta: Integer); 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 ScrollVertical(FActiveRow - FTopRow) else if FActiveRow >= FTopRow + FVisibleRows then ScrollVertical(FActiveRow - (FTopRow + FVisibleRows) + 1); + SetActiveRow(FActiveRow); end; var P: TPoint; + OneDay: Integer; + c: Integer; begin inherited; + + if HourMode then + OneDay := HoursPerDay + else + OneDay := 1; case Key of VK_LEFT: - ScrollCols(-1); + ScrollCols(-OneDay); VK_RIGHT: - ScrollCols(1); + ScrollCols(OneDay); VK_DOWN: ScrollRows(1); VK_UP: @@ -1371,29 +1577,34 @@ begin ActiveCol := ColCount-1; ActiveRow := RowCount-1; FLeftCol := ColCount - FVisibleCols; + if FLeftCol < 0 then FLeftCol := 0; FTopRow := RowCount - FVisibleRows; + if FTopRow < 0 then FTopRow := 0; end else ScrollCols(FVisibleCols); VK_NEXT: if Shift = [ssCtrl] then // ctrl + page down - begin - ActiveRow := RowCount - 1; - ScrollRows(MaxInt); - end else + ScrollRows(FRowCount) + else ScrollRows(FVisibleRows); // page down VK_PRIOR: if Shift = [ssCtrl] then // ctrl + page up - begin - ActiveRow := 0; - ScrollRows(-MaxInt); - end else + ScrollRows(-FRowCount) + else ScrollRows(-FVisibleRows); // page up VK_F10, VK_APPS: if (ssShift in Shift) then begin P := GetClientOrigin; - P.X := P.X + FDayRecords[FActiveCol].Rect.Right; - P.Y := P.Y + FDayRecords[FActiveCol].Rect.Top; + if HourMode then + 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); end; VK_RETURN: @@ -1420,9 +1631,20 @@ begin 0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT; 1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT; 2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT; + 3: Result := FDateFormat[3] <> DEFAULT_DAYFORMAT_HOURMODE; 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; var item: TMenuItem; @@ -1484,7 +1706,6 @@ begin HideHintWindow; end; - procedure TVpGanttView.MouseMove(Shift: TShiftState; X, Y: Integer); var event: TVpEvent; @@ -1540,10 +1761,13 @@ begin inc(y1, FMonthColHeaderHeight + FTextMargin); if (gchWeek in FColHeaderAttributes.Visible) then 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 begin - x2 := x1 + ColWidth; + x2 := x1 + CalcDaysWidth(1); FDayRecords[i].Rect := Rect(x1, y1, x2, y2); FDayRecords[i].Date := FRealStartDate + i; x1 := x2; @@ -1592,7 +1816,7 @@ begin xh1 := 0; xh2 := FixedColWidth; y1 := FTotalColHeaderHeight; - totalWidth := GetNumDays * ColWidth; + totalWidth := CalcDaysWidth(GetNumDays); for i := 0 to FEventRecords.Count-1 do begin eventRec := FEventRecords[i]; @@ -1623,6 +1847,36 @@ begin 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; var i, n: Integer; @@ -1660,7 +1914,7 @@ begin nDays := DaysInMonth(dm); if dm + nDays > FRealEndDate then nDays := trunc(FRealEndDate) - trunc(dm) + 1; - x2 := x1 + nDays * ColWidth; + x2 := x1 + CalcDaysWidth(nDays); FMonthRecords[i].Rect := Rect(x1, y1, x2, y2); FMonthRecords[i].Date := dm; dm := IncMonth(dm, 1); @@ -1670,7 +1924,7 @@ begin begin // Date interval is within the same month nDays := DayOf(FRealEndDate) - DayOf(FRealStartDate) + 1; - x2 := x1 + nDays * ColWidth; + x2 := x1 + CalcDaysWidth(nDays); FMonthRecords[0].Rect := Rect(x1, y1, x2, y2); FMonthRecords[0].Date := FRealStartDate; end; @@ -1711,7 +1965,7 @@ begin if dt2 > FRealEndDate then 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].Date := dt1; FWeekRecords[0].WeekNo := WeekOfTheYear(dt1); @@ -1721,7 +1975,7 @@ begin dt1 := dt2 + 1; dt2 := Min(dt1 + 6, FRealEndDate); 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].Date := dt1; FWeekRecords[i].WeekNo := WeekOfTheYear(dt1); @@ -1764,7 +2018,9 @@ procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer); begin inherited; DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI); + DoFixDesignFontPPI(ColHeaderAttributes.WeekFont, ADesignTimePPI); DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI); + DoFixDesignFontPPI(ColHeaderAttributes.HourFont, ADesignTimePPI); DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI); end; @@ -1773,7 +2029,9 @@ procedure TVpGanttView.ScaleFontsPPI(const AToPPI: Integer; begin inherited; DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion); + DoScaleFontPPI(ColHeaderAttributes.WeekFont, AToPPI, AProportion); DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion); + DoScaleFontPPI(ColHeaderAttributes.HourFont, AToPPI, AProportion); DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion); end; {$ELSEIF VP_LCL_SCALING = 1} @@ -1781,34 +2039,51 @@ procedure TVpGantView.ScaleFontsPPI(const AProportion: Double); begin inherited; DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion); + DoScaleFontPPI(ColHeaderAttributes.WeekFont, AProportion); DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion); + DoScaleFontPPI(ColHeaderAttributes.HourFont, AProportion); DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion); end; {$ENDIF} procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime); +var + nCols: Integer; begin if (FRealStartDate = 0) or (FRealStartDate = NO_DATE) then exit; + if HourMode then + nCols := GetNumHours + else + nCols := GetNumDays; + if ADate < FRealStartDate then begin FRealStartDate := DatePart(ADate); - FColCount := GetNumDays; + FColCount := nCols; SetLeftCol(-MaxInt); end else if ADate > FRealEndDate then begin FRealEndDate := DatePart(ADate); - FColCount := GetNumDays; + FColCount := nCols; SetLeftCol(FColCount - 1 - FVisibleCols); end else if ADate < FRealStartDate + FLeftCol then - SetLeftCol(trunc(ADate) - trunc(FRealStartDate)) - else + begin + if HourMode then + SetLeftCol((trunc(ADate) - trunc(FRealStartDate))*HoursPerDay) + else + SetLeftCol(trunc(ADate) - trunc(FRealStartDate)); + end else if ADate > FRealStartDate + FVisibleCols then - SetLeftCol(trunc(ADate) - FVisibleCols) - else + begin + if HourMode then + SetLeftCol(trunc(ADate*HoursPerDay) - FVisibleCols) + else + SetLeftCol(trunc(ADate) - FVisibleCols); + end else exit; Invalidate; end; @@ -1837,6 +2112,7 @@ var eventRect, dayRect: TRect; dt: TDateTime; event: TVpEvent; + c: Integer; begin if AValue <= 0 then FActiveCol := 0 @@ -1845,8 +2121,9 @@ begin else FActiveCol := AValue; - dt := DayRecords[FActiveCol].Date; - dayRect := DayRecords[FActiveCol].Rect; + c := ColToDateIndex(FActiveCol); + dt := DayRecords[c].Date; + dayRect := DayRecords[c].Rect; event := EventRecords[FActiveRow]^.Event; eventRect := EventRecords[FActiveRow]^.EventRect; @@ -1862,7 +2139,12 @@ begin end; procedure TVpGanttView.SetActiveDate(AValue: TDateTime); +var + days: Integer; begin + if FColHeaderAttributes = nil then // Needed for HourMode + exit; + if FActiveDate <> DatePart(AValue) then begin FActiveDate := DatePart(AValue); @@ -1870,7 +2152,11 @@ begin Populate; ScrollDateIntoView(FActiveDate); - FActiveCol := trunc(FActiveDate) - trunc(FRealStartDate); + days := trunc(FActiveDate) - trunc(FRealStartDate); + if HourMode then + FActiveCol := days * HoursPerDay + else + FActiveCol := days; Invalidate; @@ -1899,6 +2185,7 @@ var eventRect, dayRect: TRect; event: TVpEvent; dt: TDateTime; + c: Integer; begin if AValue < 0 then FActiveRow := 0 @@ -1909,8 +2196,9 @@ begin event := EventRecords[FActiveRow]^.Event; eventRect := EventRecords[FActiveRow]^.EventRect; - dt := DayRecords[FActiveCol].Date; - dayRect := DayRecords[FActiveCol].Rect; + c := ColToDateIndex(FActiveCol); + dt := DayRecords[c].Date; + dayRect := DayRecords[c].Rect; dayRect.Top := eventRect.Top; dayRect.Bottom := eventRect.Bottom; @@ -1957,6 +2245,15 @@ begin end; end; +procedure TVpGanttView.SetEndHour(AValue: TVpHours); +begin + if FEndHour <> AValue then + begin + FEndHour := AValue; + Invalidate; + end; +end; + procedure TVpGanttView.SetFixedColWidth(AValue: Integer); begin if FFixedColWidth <> AValue then @@ -2046,6 +2343,15 @@ begin end; end; +procedure TVpGanttView.SetStartHour(AValue: TVpHours); +begin + if FStartHour <> AValue then + begin + FStartHour := AValue; + Invalidate; + end; +end; + procedure TVpGanttView.SetTextMargin(AValue: Integer); begin if FTextMargin <> AValue then diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index ec247543f..5e32680fe 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -13,6 +13,7 @@ type private FGanttView: TVpGanttView; + FHourFont: TFont; FDayFont: TFont; FMonthFont: TFont; FWeekFont: TFont; @@ -43,6 +44,7 @@ type procedure DrawDayColHeaders; procedure DrawEvents; procedure DrawGrid; + procedure DrawHourColHeaders; procedure DrawMonthColHeaders; procedure DrawRowHeader; procedure DrawSpecialDays; @@ -87,6 +89,7 @@ var dx, dy: Integer; bs: TBrushStyle; pw: Integer; + c: Integer; begin with FGanttView do begin @@ -95,7 +98,10 @@ begin if (ActiveCol < 0) or (ActiveCol >= ColCount) then exit; - dayRec := DayRecords[ActiveCol]; + c := ActiveCol; + if HourMode then + c := c div HoursPerDay; + dayRec := DayRecords[c]; eventRec := EventRecords[ActiveRow]; dx := LeftCol * FScaledColWidth; @@ -184,6 +190,9 @@ begin // Draw the day column headers DrawDayColHeaders; + + // Draw the hour column headers + DrawHourColHeaders; end; procedure TVpGanttViewPainter.DrawDayColHeaders; @@ -191,8 +200,9 @@ var dayRec: TVpGanttDayRec; dx: Integer; strH, strLen: Integer; - str: String; + fmt, str: String; i, n: Integer; + yLineBottom: Integer; R, R1: TRect; P: TPoint; begin @@ -239,6 +249,10 @@ begin // No dividing line at last day of month because it already has been // drawn as the month divider. + if FGanttView.HourMode then + yLineBottom := FScaledTotalColHeaderHeight + else + yLineBottom := R.Bottom; if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) or ([gchWeek, gchDay] * FGanttView.ColHeaderAttributes.Visible = [gchWeek, gchDay]) then begin @@ -246,19 +260,23 @@ begin DrawBevelLine( RenderCanvas, TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)), - TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)), + TPSRotatePoint(Angle, RenderIn, Point(R.Right, yLineBottom)), BevelShadow, BevelHighlight ) else begin 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; // 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); 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); @@ -321,6 +339,7 @@ begin RenderCanvas.Pen.Color := cat.Color; RenderCanvas.Pen.Width := round(Scale); RenderCanvas.Brush.Color := cat.BackgroundColor; + //RenderCanvas.Brush.Style := bsSolid; TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; end; @@ -399,6 +418,84 @@ begin 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; var dx: Integer; @@ -710,6 +807,7 @@ begin RealLineColor := ColorToRGB(FGanttView.LineColor); end; + FHourFont := FGanttView.ColHeaderAttributes.HourFont; FDayFont := FGanttView.ColHeaderAttributes.DayFont; FMonthFont := FGanttView.ColHeaderAttributes.MonthFont; FWeekFont := FGanttView.ColHeaderAttributes.WeekFont;