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

tvplanit: Implement TVpGanttView.Options (show date, show weekends, show vertical/horizontal grid).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8428 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-30 21:00:26 +00:00
parent 9af978b9fb
commit b915c3008e
2 changed files with 97 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,6 +9,17 @@ uses
Classes, SysUtils, Graphics, Types, Controls, StdCtrls, Menus,
VpConst, VpMisc, VpBase, VpBaseDS, VpData;
type
TVpGanttViewOption = (
gvoActiveDate, gvoWeekends, gvoHorizGrid, gvoVertGrid
);
TVpGanttViewOptions = set of TVpGanttViewOption;
const
DEFAULT_GANTTVIEWOPTIONS = [
gvoActiveDate, gvoWeekends, gvoHorizGrid, gvoVertGrid
];
type
TVpGanttView = class;
@ -111,7 +122,7 @@ type
FDrawingStyle: TVpDrawingStyle;
FDefaultPopup: TPopupMenu;
FExternalPopup: TPopupMenu;
FShowActiveDate: Boolean;
FOptions: TVpGanttViewOptions;
FOnAddEvent: TVpOnAddNewEvent;
FOnDeletingEvent: TVpOnDeletingEvent;
@ -138,8 +149,8 @@ type
procedure SetFixedColWidth(AValue: Integer);
procedure SetLeftCol(AValue: Integer);
procedure SetLineColor(AValue: TColor);
procedure SetOptions(AValue: TVpGanttViewOptions);
procedure SetPopupMenu(AValue: TPopupMenu);
procedure SetShowActiveDate(AValue: Boolean);
procedure SetTextMargin(AValue: Integer);
procedure SetTopRow(AValue: Integer);
procedure SetWeekendColor(AValue: TColor);
@ -256,9 +267,9 @@ type
property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR;
property MonthFormat: String index 1 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property MonthFormat_short: String index 2 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property Options: TVpGanttViewOptions read FOptions write SetOptions default DEFAULT_GANTTVIEWOPTIONS;
property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes;
property ShowActiveDate: Boolean read FShowActiveDate write SetShowActiveDate default true;
property TextMargin: Integer read FTextMargin write SetTextMargin default 2;
property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR;
// inherited events
@ -392,7 +403,6 @@ begin
SetActiveDate(Now);
FStartDate := FActiveDate;
FShowActiveDate := true;
FColWidth := DEFAULT_COLWIDTH;
FFixedColWidth := 120;
@ -411,6 +421,8 @@ begin
FDrawingStyle := ds3d;
FScrollBars := ssBoth;
FOptions := DEFAULT_GANTTVIEWOPTIONS;
// Popup menu
FDefaultPopup := TPopupMenu.Create(Self);
FDefaultPopup.Name := 'default';
@ -1311,6 +1323,31 @@ begin
end;
end;
procedure TVpGanttView.SetHScrollPos;
var
scrollInfo: TScrollInfo;
begin
if not HandleAllocated then
Exit;
with scrollInfo do
begin
cbSize := SizeOf(scrollInfo);
fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
nMin := 0;
nMax := FColCount;
if FVisibleCols >= FColCount then
nPage := nMax
else
nPage := FVisibleCols;
if FLeftCol = pred(ColCount) - VisibleCols then
nPos := ColCount
else
nPos := FLeftCol;
nTrackPos := nPos;
end;
SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
end;
procedure TVpGanttView.SetLeftCol(AValue: Integer);
begin
if AValue <> FLeftCol then begin
@ -1339,36 +1376,11 @@ begin
end;
end;
procedure TVpGanttView.SetHScrollPos;
var
scrollInfo: TScrollInfo;
procedure TVpGanttView.SetOptions(AValue: TVpGanttViewOptions);
begin
if not HandleAllocated then
Exit;
with scrollInfo do
if FOptions <> AValue then
begin
cbSize := SizeOf(scrollInfo);
fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
nMin := 0;
nMax := FColCount;
if FVisibleCols >= FColCount then
nPage := nMax
else
nPage := FVisibleCols;
if FLeftCol = pred(ColCount) - VisibleCols then
nPos := ColCount
else
nPos := FLeftCol;
nTrackPos := nPos;
end;
SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
end;
procedure TVpGanttView.SetShowActiveDate(AValue: Boolean);
begin
if FShowActiveDate <> AValue then
begin
FShowActiveDate := AValue;
FOptions := AValue;
Invalidate;
end;
end;

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

@ -291,8 +291,9 @@ var
begin
with FGanttView do
begin
if StartDate = NO_DATE then
if (StartDate = NO_DATE) then
exit;
nEvents := NumEvents;
nDays := NumDays;
dx := LeftCol * ColWidth;
@ -311,25 +312,28 @@ begin
if y2 > RealBottom then
y2 := RealBottom;
RenderCanvas.Brush.Color := FGanttView.WeekendColor;
RenderCanvas.Brush.Style := bsSolid;
while j1 < nDays do
if (gvoWeekends in FGanttView.Options) then
begin
if j1 < nDays-1 then
j2 := j1 + 1
else
j2 := j1;
x2 := FGanttView.DayRecords[j2].Rect.Right - dx;
if x2 >= FGanttView.FixedColWidth then
begin
x1 := FGanttView.DayRecords[j1].Rect.Left - dx;
if x1 < FGanttView.FixedColWidth then
x1 := FGanttView.FixedColWidth;
RenderCanvas.FillRect(x1, y1, x2, y2);
end;
RenderCanvas.Brush.Color := FGanttView.WeekendColor;
RenderCanvas.Brush.Style := bsSolid;
inc(j1, 7);
while j1 < nDays do
begin
if j1 < nDays-1 then
j2 := j1 + 1
else
j2 := j1;
x2 := FGanttView.DayRecords[j2].Rect.Right - dx;
if x2 >= FGanttView.FixedColWidth then
begin
x1 := FGanttView.DayRecords[j1].Rect.Left - dx;
if x1 < FGanttView.FixedColWidth then
x1 := FGanttView.FixedColWidth;
RenderCanvas.FillRect(x1, y1, x2, y2);
end;
inc(j1, 7);
end;
end;
end;
@ -391,7 +395,7 @@ begin
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dy := FGanttView.TopRow * FGanttView.RowHeight;
// Horizontal lines
// Horizontal line terminating the col header block
x1 := RealLeft + FGanttView.FixedColWidth;
n := FGanttView.NumMonths;
if n > 0 then
@ -404,33 +408,40 @@ begin
if FGanttView.DrawingStyle = ds3D then dec(y0);
RenderCanvas.Line(x1, y0, x2, y0);
y0 := -dy;
if FGanttView.DrawingStyle = ds3D then dec(y0);
numEvents := FGanttView.NumEvents;
for i := 0 to numEvents - 1 do
// Horizontal lines
if (gvoHorizGrid in FGanttView.Options) then
begin
eventRec := FGanttView.EventRecords[i];
y1 := y0 + eventRec.EventRect.Bottom;
if y1 >= FGanttView.TotalColHeaderHeight then
RenderCanvas.Line(x1, y1, x2, y1);
y0 := -dy;
if FGanttView.DrawingStyle = ds3D then dec(y0);
numEvents := FGanttView.NumEvents;
for i := 0 to numEvents - 1 do
begin
eventRec := FGanttView.EventRecords[i];
y1 := y0 + eventRec.EventRect.Bottom;
if y1 >= FGanttView.TotalColHeaderHeight then
RenderCanvas.Line(x1, y1, x2, y1);
end;
end;
// Vertical lines
y1 := RealTop + FGanttView.TotalColHeaderHeight;
if numEvents > 0 then
if (gvoVertGrid in FGanttView.Options) then
begin
eventRec := FGanttView.EventRecords[numEvents-1];
y2 := eventRec.EventRect.Bottom - dy;
end else
y2 := RealBottom;
n := FGanttView.NumDays;
for i := 0 to n-1 do
begin
dayRec := FGanttView.DayRecords[i];
x1 := dayRec.Rect.Right - dx;
x2 := x1;
if x1 >= FGanttView.FixedColWidth then
RenderCanvas.Line(x1, y1, x2, y2);
y1 := RealTop + FGanttView.TotalColHeaderHeight;
if numEvents > 0 then
begin
eventRec := FGanttView.EventRecords[numEvents-1];
y2 := eventRec.EventRect.Bottom - dy;
end else
y2 := RealBottom;
n := FGanttView.NumDays;
for i := 0 to n-1 do
begin
dayRec := FGanttView.DayRecords[i];
x1 := dayRec.Rect.Right - dx;
x2 := x1;
if x1 >= FGanttView.FixedColWidth then
RenderCanvas.Line(x1, y1, x2, y2);
end;
end;
end;
@ -571,7 +582,7 @@ begin
DrawEvents;
{ Draw active day rectangle }
if FGanttView.ShowActiveDate then
if (gvoActiveDate in FGanttView.Options) then
DrawActiveDate;
{ Draw the borders }