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

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.