tvplanit: Example for TBufDataset datastore.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4773 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-06-19 11:44:35 +00:00
parent ea72a7a350
commit fe58e1530e
7 changed files with 508 additions and 3 deletions

View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="laz_visualplanit"/>
</Item1>
<Item2>
<PackageName Value="zcomponent"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, laz_visualplanit, zcomponent
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,302 @@
object Form1: TForm1
Left = 225
Height = 686
Top = 155
Width = 980
Caption = 'Form1'
ClientHeight = 686
ClientWidth = 980
OnCreate = FormCreate
LCLVersion = '1.7'
object Panel1: TPanel
Left = 0
Height = 34
Top = 0
Width = 980
Align = alTop
BevelOuter = bvNone
ClientHeight = 34
ClientWidth = 980
TabOrder = 0
object VpResourceCombo1: TVpResourceCombo
Left = 8
Height = 23
Top = 5
Width = 208
DataStore = VpBufDSDataStore1
Style = csDropDownList
end
object BtnNewRes: TButton
Left = 222
Height = 25
Top = 4
Width = 99
Caption = 'New resource'
OnClick = BtnNewResClick
TabOrder = 1
end
object BtnEditRes: TButton
Left = 328
Height = 25
Top = 4
Width = 96
Caption = 'Edit resource'
OnClick = BtnEditResClick
TabOrder = 2
end
end
object PageControl1: TPageControl
Left = 0
Height = 652
Top = 34
Width = 980
ActivePage = TabSheet1
Align = alClient
TabIndex = 0
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Events and tasks'
ClientHeight = 624
ClientWidth = 972
object VpDayView1: TVpDayView
Left = 0
Height = 624
Top = 0
Width = 301
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Align = alLeft
ReadOnly = False
TabStop = True
TabOrder = 0
AllDayEventAttributes.BackgroundColor = clBtnShadow
AllDayEventAttributes.EventBorderColor = cl3DDkShadow
AllDayEventAttributes.EventBackgroundColor = clBtnFace
ShowEventTimes = False
DrawingStyle = dsFlat
TimeSlotColors.Active = clWhite
TimeSlotColors.Inactive = 8454143
TimeSlotColors.Holiday = 16744703
TimeSlotColors.Weekday = clWhite
TimeSlotColors.Weekend = 16777088
TimeSlotColors.ActiveRange.RangeBegin = h_00
TimeSlotColors.ActiveRange.RangeEnd = h_00
HeadAttributes.Font.Height = -13
HeadAttributes.Color = clBtnFace
RowHeadAttributes.HourFont.Height = -24
RowHeadAttributes.MinuteFont.Height = -12
RowHeadAttributes.Color = clBtnFace
ShowResourceName = True
LineColor = clGray
GutterWidth = 7
DateLabelFormat = 'dddd, mmmm dd, yyyy'
Granularity = gr30Min
DefaultTopHour = h_07
TimeFormat = tf12Hour
end
object Panel2: TPanel
Left = 306
Height = 624
Top = 0
Width = 386
Align = alLeft
BevelOuter = bvNone
Caption = 'Panel2'
ClientHeight = 624
ClientWidth = 386
TabOrder = 1
object VpWeekView1: TVpWeekView
Left = 0
Height = 378
Top = 0
Width = 386
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
AllDayEventAttributes.BackgroundColor = clWindow
AllDayEventAttributes.EventBorderColor = clGray
AllDayEventAttributes.EventBackgroundColor = clBtnFace
DateLabelFormat = 'dddd, mmmm dd, yyyy'
DayHeadAttributes.Color = clBtnFace
DayHeadAttributes.DateFormat = 'dddd mmmm, dd'
DayHeadAttributes.Font.Height = -13
DayHeadAttributes.Font.Name = 'Tahoma'
DayHeadAttributes.Bordered = True
DrawingStyle = dsFlat
HeadAttributes.Color = clBtnFace
LineColor = clGray
TimeFormat = tf12Hour
ShowEventTime = True
WeekStartsOn = dtMonday
Align = alClient
TabStop = True
TabOrder = 0
end
object VpMonthView1: TVpMonthView
Left = 0
Height = 241
Top = 383
Width = 386
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Align = alBottom
TabStop = True
TabOrder = 1
KBNavigation = True
DateLabelFormat = 'mmmm yyyy'
DayHeadAttributes.Color = clBtnFace
DayHeadAttributes.Font.Height = -13
DayHeadAttributes.Font.Name = 'Tahoma'
DayNameStyle = dsShort
DrawingStyle = dsFlat
EventDayStyle = []
LineColor = clGray
TimeFormat = tf12Hour
OffDayColor = clSilver
SelectedDayColor = clRed
ShowEvents = True
ShowEventTime = False
WeekStartsOn = dtSunday
end
object Splitter2: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 378
Width = 386
Align = alBottom
ResizeAnchor = akBottom
end
end
object VpTaskList1: TVpTaskList
Left = 697
Height = 624
Top = 0
Width = 275
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Align = alClient
TabStop = True
TabOrder = 2
ReadOnly = False
DisplayOptions.CheckBGColor = clWindow
DisplayOptions.CheckColor = cl3DDkShadow
DisplayOptions.CheckStyle = csCheck
DisplayOptions.DueDateFormat = 'dd.MM.yyyy'
DisplayOptions.ShowCompletedTasks = False
DisplayOptions.ShowAll = False
DisplayOptions.ShowDueDate = True
DisplayOptions.OverdueColor = clRed
DisplayOptions.NormalColor = clBlack
DisplayOptions.CompletedColor = clGray
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
DrawingStyle = dsFlat
ShowResourceName = True
end
object Splitter1: TSplitter
Left = 692
Height = 624
Top = 0
Width = 5
end
object Splitter3: TSplitter
Left = 301
Height = 624
Top = 0
Width = 5
end
end
object TabSheet2: TTabSheet
Caption = 'Contacts'
ClientHeight = 594
ClientWidth = 928
object VpContactButtonBar1: TVpContactButtonBar
Left = 0
Height = 594
Top = 0
Width = 40
DrawingStyle = dsFlat
RadioStyle = False
Align = alLeft
end
object VpContactGrid1: TVpContactGrid
Left = 40
Height = 594
Top = 0
Width = 888
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Align = alClient
TabStop = True
TabOrder = 1
AllowInPlaceEditing = True
BarWidth = 3
BarColor = clSilver
ColumnWidth = 200
ContactHeadAttributes.Color = clSilver
ContactHeadAttributes.Bordered = True
DrawingStyle = dsFlat
end
end
end
object VpControlLink1: TVpControlLink
DataStore = VpBufDSDataStore1
Printer.BottomMargin = 0
Printer.DayStart = h_08
Printer.DayEnd = h_05
Printer.Granularity = gr30Min
Printer.LeftMargin = 0
Printer.MarginUnits = imAbsolutePixel
Printer.PrintFormats = <>
Printer.RightMargin = 0
Printer.TopMargin = 0
left = 136
top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.04'
DataStore = VpBufDSDataStore1
Options = []
Placement.Position = mpCenter
Placement.Top = 10
Placement.Left = 10
Placement.Height = 250
Placement.Width = 400
left = 136
top = 335
end
object VpBufDSDataStore1: TVpBufDSDataStore
CategoryColorMap.Category0.Color = clNavy
CategoryColorMap.Category0.Description = 'Category 0'
CategoryColorMap.Category1.Color = clRed
CategoryColorMap.Category1.Description = 'Category 1'
CategoryColorMap.Category2.Color = clYellow
CategoryColorMap.Category2.Description = 'Category 2'
CategoryColorMap.Category3.Color = clLime
CategoryColorMap.Category3.Description = 'Category 3'
CategoryColorMap.Category4.Color = clPurple
CategoryColorMap.Category4.Description = 'Category 4'
CategoryColorMap.Category5.Color = clTeal
CategoryColorMap.Category5.Description = 'Category 5'
CategoryColorMap.Category6.Color = clFuchsia
CategoryColorMap.Category6.Description = 'Category 6'
CategoryColorMap.Category7.Color = clOlive
CategoryColorMap.Category7.Description = 'Category 7'
CategoryColorMap.Category8.Color = clAqua
CategoryColorMap.Category8.Description = 'Category 8'
CategoryColorMap.Category9.Color = clMaroon
CategoryColorMap.Category9.Description = 'Category 9'
EnableEventTimer = True
PlayEventSounds = True
AutoConnect = True
AutoCreate = True
left = 136
top = 192
end
end

View File

@ -0,0 +1,97 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, VpBaseDS, VpDayView, VpWeekView, VpTaskList,
VpContactGrid, VpMonthView, VpResEditDlg, VpContactButtons, VpBufDS;
type
{ TForm1 }
TForm1 = class(TForm)
BtnNewRes: TButton;
BtnEditRes: TButton;
PageControl1: TPageControl;
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
Splitter2: TSplitter;
Splitter3: TSplitter;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
VpBufDSDataStore1: TVpBufDSDataStore;
VpContactButtonBar1: TVpContactButtonBar;
VpContactGrid1: TVpContactGrid;
VpControlLink1: TVpControlLink;
VpDayView1: TVpDayView;
VpMonthView1: TVpMonthView;
VpResourceCombo1: TVpResourceCombo;
VpResourceEditDialog1: TVpResourceEditDialog;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
LazFileUtils,
VpData;
{ TForm1 }
// Adds a new resource
procedure TForm1.BtnNewResClick(Sender: TObject);
begin
VpResourceEditDialog1.AddNewResource;
end;
// Edits the currently selected resource
procedure TForm1.BtnEditResClick(Sender: TObject);
begin
// Open the resource editor dialog, everything is done here.
VpResourceEditDialog1.Execute;
end;
// Load the last resource.
procedure TForm1.FormCreate(Sender: TObject);
var
lastRes: TVpResource;
begin
{ if you want to set the data directory at runtime, don't set AutoCreate and
AutoConnect to true, and use this code
VpBufDSDatastore1.Directory := 'some directory';
if not DirectoryExistsUTF8(VpBufDSDatastore1.Directory) then
CreateDir(VpBufDSDatastore1.Directory);
VpBufDSDatastore1.CreateTables;
VPBufDSDatastore1.Connected := true;
}
if VpBufDSDatastore1.Resources.Count > 0 then
begin
lastRes := VpBufDSDatastore1.Resources.Items[VpBufDSDatastore1.Resources.Count-1];
VpBufDSDatastore1.ResourceID := lastRes.ResourceID;
end;
end;
end.

View File

@ -50,6 +50,7 @@ type
published
property Directory: String read FDirectory write SetDirectory;
property AutoConnect;
property AutoCreate;
end;
@ -183,7 +184,7 @@ begin
{ Connecting or disconnecting? }
if Value then begin
CreateTables;
if AutoCreate then CreateTables;
OpenTables;
Load;
end;

View File

@ -47,7 +47,7 @@ type
// inherited
property AutoConnect;
property AutoCreate default true;
property AutoCreate;
property Connected;
end;

View File

@ -43,7 +43,7 @@ type
// inherited
property AutoConnect;
property AutoCreate default true;
property AutoCreate;
property Connected;
end;