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

tvplanit: Add GanttView demo. Set version number to 1.8.0 for next OPM release.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8681 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-01-15 23:25:52 +00:00
parent 73ca438b52
commit ba6395039f
10 changed files with 731 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
components/tvplanit/examples/gantt/data.ini Normal file
View File

@ -0,0 +1,15 @@
[General]
Version=v105
[Resources]
1178568021={Description:Gantt-Test}|{ResourceActive:true}
[Events of resource 1178568021]
1273124118={StartTime:2022/06/25 06:00:00}|{EndTime:2022/06/27 18:00:00}|{ResourceID:1178568021}|{Description:Phase 1}|{Category:1}|{AllDayEvent:false}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
909791748={StartTime:2022/07/06}|{EndTime:2022/07/08}|{ResourceID:1178568021}|{Description:Phase 1a}|{Category:0}|{AllDayEvent:true}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
1535857465={StartTime:2022/07/11 08:00:00}|{EndTime:2022/07/15 18:00:00}|{ResourceID:1178568021}|{Description:Phase 2}|{Category:0}|{AllDayEvent:false}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
1813046879={StartTime:2022/07/19 08:00:00}|{EndTime:2022/07/22 18:30:00}|{ResourceID:1178568021}|{Description:Phase 3}|{Category:2}|{AllDayEvent:false}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
1294424480={StartTime:2022/07/26 01:00:00}|{EndTime:2022/07/27 23:00:00}|{ResourceID:1178568021}|{Description:Phase 4}|{Category:0}|{AllDayEvent:false}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
1842424188={StartTime:2022/08/02 08:00:00}|{EndTime:2022/08/04 16:00:00}|{ResourceID:1178568021}|{Description:Phase 5}|{Category:1}|{AllDayEvent:true}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
1819459250={StartTime:2022/08/03}|{EndTime:2022/08/11}|{ResourceID:1178568021}|{Description:Phase 6}|{Category:0}|{AllDayEvent:true}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}
1339092840={StartTime:2022/08/10}|{EndTime:2022/08/16}|{ResourceID:1178568021}|{Description:Phase 7}|{Category:3}|{AllDayEvent:true}|{AlarmSet:false}|{AlarmAdvance:15}|{AlarmAdvanceType:atMinutes}|{RepeatCode:rtNone}|{CustomInterval:0}

87
components/tvplanit/examples/gantt/ganttview_demo.lpi Normal file
View File

@ -0,0 +1,87 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="ganttview_demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="Printer4Lazarus"/>
</Item>
<Item>
<PackageName Value="laz_visualplanit"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="ganttview_demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="ganttview_demo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);..\..\source\include"/>
<OtherUnitFiles Value="..\..\source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

25
components/tvplanit/examples/gantt/ganttview_demo.lpr Normal file
View File

@ -0,0 +1,25 @@
program ganttview_demo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, printer4lazarus, main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

357
components/tvplanit/examples/gantt/main.lfm Normal file
View File

@ -0,0 +1,357 @@
object MainForm: TMainForm
Left = 319
Height = 600
Top = 125
Width = 800
Caption = 'MainForm'
ClientHeight = 600
ClientWidth = 800
OnCreate = FormCreate
LCLVersion = '2.3.0.0'
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 306
Width = 800
Align = alTop
ResizeAnchor = akTop
end
object Panel1: TPanel
Left = 0
Height = 66
Top = 0
Width = 800
Align = alTop
BevelOuter = bvNone
ClientHeight = 66
ClientWidth = 800
TabOrder = 1
object Button1: TButton
Left = 10
Height = 25
Top = 10
Width = 77
AutoSize = True
Caption = 'All events'
OnClick = Button1Click
TabOrder = 0
end
object Button2: TButton
Left = 95
Height = 25
Top = 10
Width = 167
AutoSize = True
Caption = 'Week of selected date only'
OnClick = Button2Click
TabOrder = 1
end
object Button3: TButton
Left = 272
Height = 25
Top = 8
Width = 174
AutoSize = True
Caption = 'Month of selected date only'
OnClick = Button3Click
TabOrder = 2
end
object CheckBox1: TCheckBox
Left = 456
Height = 19
Top = 8
Width = 102
Caption = 'Show weekends'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 3
end
object CheckGroup1: TCheckGroup
Left = 581
Height = 50
Top = 10
Width = 185
AutoFill = True
Caption = 'Show headers'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3
ClientHeight = 30
ClientWidth = 181
Columns = 3
Items.Strings = (
'Month'
'Week'
'Day'
)
OnItemClick = CheckGroup1ItemClick
TabOrder = 4
Data = {
03000000020202
}
end
object CheckBox2: TCheckBox
Left = 456
Height = 19
Top = 24
Width = 32
Caption = '3D'
Checked = True
OnChange = CheckBox2Change
State = cbChecked
TabOrder = 5
end
object Button4: TButton
Left = 8
Height = 25
Top = 37
Width = 129
AutoSize = True
Caption = 'Edit Print Formats...'
OnClick = Button4Click
TabOrder = 6
end
object Button5: TButton
Left = 144
Height = 25
Top = 37
Width = 104
AutoSize = True
Caption = 'Print Preview...'
OnClick = Button5Click
TabOrder = 7
end
object Button6: TButton
Left = 256
Height = 25
Top = 37
Width = 51
AutoSize = True
Caption = 'Print'
OnClick = Button6Click
TabOrder = 8
end
object VpPrintFormatComboBox1: TVpPrintFormatComboBox
Left = 320
Height = 23
Top = 37
Width = 126
ControlLink = VpControlLink1
ItemHeight = 15
Sorted = True
TabOrder = 9
end
end
object Panel2: TPanel
Left = 0
Height = 240
Top = 66
Width = 800
Align = alTop
Caption = 'Panel2'
ClientHeight = 240
ClientWidth = 800
TabOrder = 2
object VpMonthView1: TVpMonthView
Left = 421
Height = 238
Top = 1
Width = 378
PopupMenu = VpMonthView1.default
DataStore = VpIniDatastore1
ControlLink = VpControlLink1
Align = alRight
TabOrder = 0
TodayAttributes.BorderPen.Color = clRed
TodayAttributes.BorderPen.Width = 3
end
object VpDayView1: TVpDayView
Left = 1
Height = 238
Top = 1
Width = 415
PopupMenu = VpDayView1.default
DataStore = VpIniDatastore1
ControlLink = VpControlLink1
Align = alClient
TabOrder = 1
TimeSlotColors.Active = clWhite
TimeSlotColors.ActiveRange.RangeBegin = h_00
TimeSlotColors.ActiveRange.RangeEnd = h_00
HeadAttributes.Font.Height = -13
RowHeadAttributes.HourFont.Height = -24
RowHeadAttributes.MinuteFont.Height = -12
NumDays = 2
end
object Splitter2: TSplitter
Left = 416
Height = 238
Top = 1
Width = 5
Align = alRight
ResizeAnchor = akRight
end
end
object VpControlLink1: TVpControlLink
DataStore = VpIniDatastore1
Printer.DayStart = h_08
Printer.DayEnd = h_05
Printer.Granularity = gr60Min
Printer.MarginUnits = imAbsolutePixel
Printer.PrintFormats = <
item
Version = 'v1.7.0'
DayInc = 0
DayIncUnits = duDay
Elements = <
item
Version = 'v1.7.0'
DayOffset = 0
DayOffsetUnits = duDay
ElementName = 'GanttView'
Height = 100
ItemType = itGanttView
Left = 0
Shape.Shape = ustRectangle
Top = 0
Width = 100
end>
FormatName = 'Gantt Portrait 0°'
end
item
Version = 'v1.7.0'
DayInc = 0
DayIncUnits = duDay
Elements = <
item
Version = 'v1.7.0'
DayOffset = 0
DayOffsetUnits = duDay
ElementName = 'GanttView rotated 270°'
Height = 100
ItemType = itGanttView
Left = 0
Rotation = ra270
Shape.Shape = ustRectangle
Top = 0
Width = 100
end>
FormatName = 'Gantt Landscape 270°'
end
item
Version = 'v1.7.0'
DayInc = 0
DayIncUnits = duDay
Elements = <
item
Version = 'v1.7.0'
DayOffset = 0
DayOffsetUnits = duDay
ElementName = 'GanttView rotated 90°'
Height = 100
ItemType = itGanttView
Left = 0
Rotation = ra90
Shape.Shape = ustRectangle
Top = 0
Width = 100
end>
FormatName = 'Gantt Landscape 90°'
end
item
Version = 'v1.7.0'
DayInc = 10
DayIncUnits = duDay
Elements = <
item
Version = 'v1.7.0'
DayOffset = 0
DayOffsetUnits = duDay
ElementName = 'GantView'
Height = 100
ItemType = itGanttView
Left = 0
Shape.Shape = ustRectangle
Top = 0
Width = 100
end>
FormatName = 'Gantt inc 10d'
end>
Left = 79
Top = 208
end
object VpIniDatastore1: TVpIniDatastore
CategoryColorMap.Category0.BackgroundColor = clSkyBlue
CategoryColorMap.Category0.Description = 'Category 0'
CategoryColorMap.Category0.UseForAllDayEvents = True
CategoryColorMap.Category1.BackgroundColor = 8421631
CategoryColorMap.Category1.Description = 'Category 1'
CategoryColorMap.Category1.UseForAllDayEvents = True
CategoryColorMap.Category2.BackgroundColor = clYellow
CategoryColorMap.Category2.Color = clOlive
CategoryColorMap.Category2.Description = 'Category 2'
CategoryColorMap.Category2.UseForAllDayEvents = True
CategoryColorMap.Category3.BackgroundColor = clLime
CategoryColorMap.Category3.Color = clGreen
CategoryColorMap.Category3.Description = 'Category 3'
CategoryColorMap.Category3.UseForAllDayEvents = True
CategoryColorMap.Category4.Description = 'Category 4'
CategoryColorMap.Category4.UseForAllDayEvents = True
CategoryColorMap.Category5.Description = 'Category 5'
CategoryColorMap.Category5.UseForAllDayEvents = True
CategoryColorMap.Category6.Description = 'Category 6'
CategoryColorMap.Category7.Description = 'Category 7'
CategoryColorMap.Category7.UseForAllDayEvents = True
CategoryColorMap.Category8.Description = 'Category 8'
CategoryColorMap.Category8.UseForAllDayEvents = True
CategoryColorMap.Category9.Description = 'Category 9'
CategoryColorMap.Category9.UseForAllDayEvents = True
HiddenCategories.BackgroundColor = clSilver
HiddenCategories.Color = clGray
OnDateChanged = VpIniDatastore1DateChanged
AutoConnect = True
FileName = 'data.ini'
Left = 79
Top = 144
end
object VpPrintFormatEditDialog1: TVpPrintFormatEditDialog
Version = 'v1.7.0'
DataStore = VpIniDatastore1
ControlLink = VpControlLink1
Options = []
Placement.Position = mpCenter
Placement.Top = 10
Placement.Left = 10
Placement.Height = 480
Placement.Width = 640
Left = 79
Top = 88
end
object VpPrintPreviewDialog1: TVpPrintPreviewDialog
Version = 'v1.7.0'
DataStore = VpIniDatastore1
ControlLink = VpControlLink1
EndDate = 44838.5281092593
MarginUnits = imAbsolutePixel
StartDate = 44831.5281092593
Options = []
Placement.Position = mpCenter
Placement.Top = 10
Placement.Left = 10
Placement.Height = 480
Placement.Width = 720
Left = 223
Top = 88
end
object PrintDialog1: TPrintDialog
Left = 223
Top = 144
end
end

199
components/tvplanit/examples/gantt/main.pas Normal file
View File

@ -0,0 +1,199 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Grids,
StdCtrls, PrintersDlgs, VpBaseDS, VpIniDs, VpMonthView, VpDayView,
VpGanttView, VpPrtFmt, VpPrtFmtDlg, VpPrtPrvDlg, VpPrtFmtCBox;
type
{ TMainForm }
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckGroup1: TCheckGroup;
Panel1: TPanel;
Panel2: TPanel;
PrintDialog1: TPrintDialog;
Splitter1: TSplitter;
Splitter2: TSplitter;
VpControlLink1: TVpControlLink;
VpDayView1: TVpDayView;
VpIniDatastore1: TVpIniDatastore;
VpMonthView1: TVpMonthView;
VpPrintFormatComboBox1: TVpPrintFormatComboBox;
VpPrintFormatEditDialog1: TVpPrintFormatEditDialog;
VpPrintPreviewDialog1: TVpPrintPreviewDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure CheckBox1Change(Sender: TObject);
procedure CheckBox2Change(Sender: TObject);
procedure CheckGroup1ItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
procedure VpIniDatastore1DateChanged(Sender: TObject; Date: TDateTime);
private
FGanttView: TVpGanttView;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
DateUtils, Printers,
VpBase;
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
begin
if VpIniDataStore1.Resources.Count > 0 then
VpIniDatastore1.Resource := VpIniDatastore1.Resources.Items[0];
FGanttView := TVpGanttView.Create(self);
FGanttView.Align := alClient;
FGanttView.Parent := self;
FGanttView.Datastore := VpIniDatastore1;
FGanttView.ControlLink := VpControlLink1;
FGanttView.ColHeaderAttributes.Visible := [gchMonth, gchWeek, gchDay];
Caption := FGanttView.Datastore.ClassName;
CheckGroup1.Checked[0] := gchMonth in FGanttView.ColHeaderAttributes.Visible;
CheckGroup1.Checked[1] := gchWeek in FGanttView.ColHeaderAttributes.Visible;
CheckGroup1.checked[2] := gchDay in FGanttView.ColHeaderAttributes.Visible;
end;
procedure TMainForm.VpIniDatastore1DateChanged(Sender: TObject; Date: TDateTime);
begin
if FGanttview = nil then
exit;
caption := Format('Current: %s (%.0f), First: %s (%.0f), Start: %s (%.0f), End: %s (%.0f), Last: %s (%.0f)', [
DateToStr(Date), Date,
DateToStr(FGanttView.FirstDate), FGanttview.FirstDate,
DateToStr(FGanttView.RealStartDate), FGanttview.RealStartDate,
DateToStr(FGanttView.RealEndDate), FGanttview.RealEndDate,
DateToStr(FGanttview.LastDate), FGanttView.LastDate
]);
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
FGanttView.SetDateLimits(0, 0);
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
FGanttView.SetDateLimits(StartOfTheWeek(VpMonthView1.Date), EndOfTheWeek(VpMonthView1.Date));
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
FGanttView.SetDateLimits(StartOfTheMonth(VpMonthView1.Date), EndOfTheMonth(VpMonthView1.Date));
end;
procedure TMainForm.Button4Click(Sender: TObject);
begin
VpPrintFormatEditDialog1.DrawingStyle := FGanttView.DrawingStyle;
VpPrintFormatEditDialog1.Execute;
end;
procedure TMainForm.Button5Click(Sender: TObject);
var
d1, d2: TDateTime;
fmt: TVpPrintFormatItem;
fmtidx: Integer;
begin
fmtidx := VpPrintPreviewDialog1.ControlLink.Printer.CurFormat;
fmt := VpPrintPreviewDialog1.ControlLink.Printer.PrintFormats.Items[fmtidx];
case fmtidx of
0, 1:
begin
d1 := FGanttView.FirstDate;
d2 := FGanttView.Lastdate;
end;
-1: begin
ShowMessage('Print format not defined.');
exit;
end;
end;
VpPrintPreviewDialog1.ControlLink := VpControlLink1;
VpPrintPreviewDialog1.Printer := Printer;
VpPrintPreviewDialog1.StartDate := d1;
VpPrintPreviewDialog1.EndDate := d2;
VpPrintPreviewDialog1.DrawingStyle := FGanttView.DrawingStyle;
if VpPrintPreviewDialog1.Execute then
if PrintDialog1.Execute then begin
Printer.BeginDoc;
try
d1 := VpPrintPreviewDialog1.StartDate;
d2 := VpPrintPreviewDialog1.EndDate;
VpPrintPreviewDialog1.ControlLink.Printer.Print(Printer, d1, d2);
finally
Printer.EndDoc;
end;
end;
end;
procedure TMainForm.Button6Click(Sender: TObject);
var
d1, d2: TDateTime;
begin
d1 := FGanttView.FirstDate;
d2 := FGanttView.LastDate;
if PrintDialog1.Execute then begin
Printer.BeginDoc;
VpControlLink1.Printer.Print(Printer, d1, d2);
Printer.EndDoc;
end;
end;
procedure TMainForm.CheckBox1Change(Sender: TObject);
begin
if checkbox1.Checked then
FGanttView.Options := FGanttView.Options + [gvoWeekends]
else
FGanttView.Options := FGanttView.Options - [gvoWeekends];
end;
procedure TMainForm.CheckBox2Change(Sender: TObject);
begin
if Checkbox2.Checked then
FGanttView.DrawingStyle := ds3D
else
FGanttView.DrawingStyle := dsFlat;
end;
procedure TMainForm.CheckGroup1ItemClick(Sender: TObject; Index: integer);
begin
if CheckGroup1.Checked[Index] then
FGanttView.ColHeaderAttributes.Visible := FGanttView.ColHeaderAttributes.Visible +
[TVpGanttColHeaderKind(Index)]
else
FGanttView.ColHeaderAttributes.Visible := FGanttView.ColHeaderAttributes.Visible -
[TVpGanttColHeaderKind(Index)]
end;
end.

44
components/tvplanit/examples/gantt/printformats.xml Normal file
View File

@ -0,0 +1,44 @@
<?xml version="1.0" encoding="UTF-8"?>
<VpPrintFormats
Version = "0.0.1">
<PrintFormat
Name="GanttView Portrait"
Description=""
DayIncrement="0"
Visble="True"
DayIncrementUnits="Day">
<Element
Name="GanttView"
Visible="True"
Rotation="0"
Item="GanttView"
Measurement="Percent"
Left="0"
Top="0"
Width="100"
Height="100"
DayOffset="0"
DayOffsetUnits="Day">
</Element>
</PrintFormat>
<PrintFormat
Name="GanttView Landscape"
Description=""
DayIncrement="0"
Visble="True"
DayIncrementUnits="Day">
<Element
Name="GanttView rotated"
Visible="True"
Rotation="270"
Item="GanttView"
Measurement="Percent"
Left="0"
Top="0"
Width="100"
Height="100"
DayOffset="0"
DayOffsetUnits="Day">
</Element>
</PrintFormat>
</VpPrintFormats>