tvplanit: Initial commit of an inifile datastore (working only partially at the moment). Add a demo project.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4845 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-27 22:43:15 +00:00
parent 7ec6f3104d
commit 723aa23ea5
17 changed files with 1207 additions and 19 deletions

View File

@ -112,24 +112,48 @@ object MainForm: TMainForm
RowHeadAttributes.MinuteFont.Height = -12
RowHeadAttributes.Color = clBtnFace
IconAttributes.AlarmBitmap.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000000000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00300130000031
00333310009090001333330097F0F7900333380970FFF07908333099FF0FFFF9
90333090FFF0FF0090333099FFF0FFF99033380970F0FF790833330097F0F790
0333000009999900000307780000008778030777703030777803308770803077
8033338003303300833333333300033333333333333333333333
76020000424D760200000000000036000000280000000C0000000C0000000100
20000000000040020000C30E0000C30E00000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
00C6000000C6FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00000000C6000000FF000000FF000000C6FFFFFF00FFFF
FF00FFFFFF00FFFFFF000000008D000000C6000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000C60000008DFFFFFF000000
008D000000E2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
00E20000008DFFFFFF00FFFFFF0000000055000000AAFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000AA00000055FFFFFF00FFFFFF000000
0055000000AAFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
00AA00000055FFFFFF00FFFFFF000000001C000000FFFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000FF0000001CFFFFFF00FFFFFF00FFFF
FF00000000FF0000001CFFFFFF00FFFFFF00FFFFFF00FFFFFF000000001C0000
00FFFFFFFF00FFFFFF00FFFFFF00FFFFFF000000008D0000008DFFFFFF00FFFF
FF00FFFFFF00FFFFFF000000008D0000008DFFFFFF00FFFFFF00FFFFFF00FFFF
FF000000001C000000E200000055FFFFFF00FFFFFF0000000055000000E20000
001CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000001C000000E20000
00E2000000C6000000E20000001CFFFFFF00FFFFFF00FFFFFF00
}
IconAttributes.RecurringBitmap.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
04000000000080000000C40E0000C40E00001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00888888888888
8888888888888888888888888888888888888888888888888888888888888888
8888888078888888888888708888800000888808888888000088880888888880
0088880888888808008888708888708880888887000078888888888888888888
8888888888888888888888888888888888888888888888888888
76020000424D760200000000000036000000280000000C0000000C0000000100
20000000000040020000C30E0000C30E00000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF000000005500000038FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000C60000001C000000AA000000FF0000
00C6000000AA000000FF000000AA0000001CFFFFFF00FFFFFF00FFFFFF000000
00FF000000E20000008DFFFFFF00FFFFFF00FFFFFF00FFFFFF000000008D0000
00E20000001CFFFFFF00FFFFFF00000000FF000000C0000000AAFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF000000008D000000AAFFFFFF00FFFFFF000000
00FF000000FF000000FF000000C6FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00000000FFFFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000AA00000038000000550000
00C6FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
0000FFFFFF00FFFFFF00FFFFFF00000000FFFFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00000000C6000000FF000000FF000000FFFFFFFF00FFFFFF000000
00AA0000008DFFFFFF00FFFFFF00FFFFFF000000000000000000000000EC0000
00DD000000FFFFFFFF00FFFFFF000000001C000000E20000008DFFFFFF00FFFF
FF0000000000000000000000008D000000E2000000FFFFFFFF00FFFFFF00FFFF
FF000000001C000000AA000000FF000000C6000000AA000000FF000000AA0000
001C000000C6FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
005500000038FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
ShowResourceName = True
LineColor = clGray

View File

@ -0,0 +1,81 @@
<?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="2">
<Item1>
<PackageName Value="laz_visualplanit"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</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,20 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, laz_visualplanit;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,303 @@
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 = VpIniDatastore1
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 = VpIniDatastore1
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 = VpIniDatastore1
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 = VpIniDatastore1
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 = VpIniDatastore1
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 = VpIniDatastore1
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 = VpIniDatastore1
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 = VpIniDatastore1
Options = []
Placement.Position = mpCenter
Placement.Top = 10
Placement.Left = 10
Placement.Height = 250
Placement.Width = 400
left = 136
top = 335
end
object VpIniDatastore1: TVpIniDatastore
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
Connected = True
FileName = 'data.ini'
left = 140
top = 200
end
end

View File

@ -0,0 +1,89 @@
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, VpIniDs;
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;
VpContactButtonBar1: TVpContactButtonBar;
VpContactGrid1: TVpContactGrid;
VpControlLink1: TVpControlLink;
VpDayView1: TVpDayView;
VpIniDatastore1: TVpIniDatastore;
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;
datastore: TVpCustomDatastore;
begin
datastore := VpControlLink1.Datastore;
if datastore.Resources.Count > 0 then
begin
lastRes := datastore.Resources.Items[datastore.Resources.Count-1];
datastore.ResourceID := lastRes.ResourceID;
end;
end;
end.

View File

@ -516,6 +516,10 @@ msgstr "Gestern"
msgid "Hours"
msgstr "Stunden"
#: vpsr.rsinifilestructure
msgid "Incorrect structure of ini file."
msgstr ""
#: vpsr.rsintervallbl
msgid "Interval (days):"
msgstr "Intervall (Tage):"
@ -1373,3 +1377,4 @@ msgstr "Unbekannte Achsen-Spezifikation: %s"
#: vpsr.sxmldecnotatbeg
msgid "The XML declaration must appear before the first element"
msgstr "Die XML-Deklaration muss vor dem ersten Element erscheinen."

View File

@ -506,6 +506,10 @@ msgstr ""
msgid "Hours"
msgstr ""
#: vpsr.rsinifilestructure
msgid "Incorrect structure of ini file."
msgstr ""
#: vpsr.rsintervallbl
msgid "Interval (days):"
msgstr ""

View File

@ -516,6 +516,10 @@ msgstr "Вчера"
msgid "Hours"
msgstr "Часы"
#: vpsr.rsinifilestructure
msgid "Incorrect structure of ini file."
msgstr ""
#: vpsr.rsintervallbl
msgid "Interval (days):"
msgstr "Интервал (дни):"

View File

@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
Contributor(s): "/>
<Version Major="1" Release="4"/>
<Files Count="71">
<Files Count="72">
<Item1>
<Filename Value="../source/vpalarmdlg.lfm"/>
<Type Value="LFM"/>
@ -318,6 +318,10 @@ Contributor(s): "/>
<Filename Value="../source/vpcalendarpainter.pas"/>
<UnitName Value="VpCalendarPainter"/>
</Item71>
<Item72>
<Filename Value="../source/vpinids.pas"/>
<UnitName Value="VpIniDs"/>
</Item72>
</Files>
<i18n>
<EnableI18N Value="True"/>

View File

@ -81,7 +81,7 @@ type
constructor Create(Owner: TObject);
destructor Destroy; override;
function AddResource(ResID: Int64): TVpResource;
function FindResourceByName (AName : string) : TVpResource;
function FindResourceByName(AName : string) : TVpResource;
function GetResource(ID: Integer): TVpResource;
procedure ClearResources;
procedure RemoveResource(Resource: TVpResource);
@ -634,7 +634,7 @@ var
begin
Result := nil;
AName := LowerCase (AName);
AName := LowerCase(AName);
for i := 0 to Count - 1 do
if LowerCase (Items[i].Description) = AName then begin
Result := Items[i];

View File

@ -0,0 +1,633 @@
{ Visual PlanIt datastore using an ini file }
{$I vp.inc}
unit VpIniDs;
interface
uses
SysUtils, Classes,
VpData, VpBaseDS;
type
TVpIniDatastore = class(TVpCustomDatastore)
private
FFilename: String;
FFormatSettings: TFormatSettings;
procedure SetFilename(const AValue: String);
protected
function ContactToStr(AContact: TVpContact): String;
function EventToStr(AEvent: TVpEvent): String;
function ResourceToStr(AResource: TVpResource): String;
function TaskToStr(ATask: TVpTask): String;
procedure StrToContact(AString: String; AContact: TVpContact);
procedure StrToEvent(AString: String; AEvent: TVpEvent);
procedure StrToResource(AString: String; AResource: TVpResource);
procedure StrToTask(AString: String; ATask: TVpTask);
procedure SetConnected(const AValue: Boolean); override;
procedure Split(const AString: String; AList: TStrings);
function UniqueID(AValue: Int64): Boolean;
procedure ReadFromIni;
procedure WriteToIni;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetNextID(TableName: string): Int64; override;
procedure LoadEvents; override;
procedure LoadContacts; override;
procedure LoadTasks; override;
procedure PostContacts; override;
procedure PostEvents; override;
procedure PostResources; override;
procedure PostTasks; override;
procedure SetResourceByName(Value: String); override;
published
property AutoConnect default false;
property Connected;
property FileName: String read FFileName write SetfileName;
end;
implementation
uses
typinfo, Strings, IniFiles,
VpMisc, VpSR;
const
StrTRUE = 'true';
StrFALSE = 'false';
procedure IniError(const AMsg: String);
begin
raise Exception.Create(AMsg);
end;
{ TVpIniDatastore }
constructor TVpIniDatastore.Create(AOwner: TComponent);
begin
inherited;
FFormatSettings := DefaultFormatSettings;
FFormatSettings.DecimalSeparator := '.';
FFormatSettings.ThousandSeparator := #0;
FFormatSettings.ShortDateFormat := 'yyyy/mm/dd';
FFormatSettings.LongTimeFormat := 'hh:nn:ss';
FFormatSettings.DateSeparator := '/';
FFormatSettings.TimeSeparator := ':';
end;
destructor TVpIniDatastore.Destroy;
begin
SetConnected(false);
inherited;
end;
function TVpIniDatastore.ContactToStr(AContact: TVpContact): String;
begin
Result := '{' + // RecordID is stored in ini value name.
AContact.FirstName + '{|}' +
AContact.LastName + '{|}' +
FormatDateTime('ddddd', AContact.BirthDate, FFormatSettings) + '{|}' + // Short date format
FormatDateTime('ddddd', AContact.Anniversary, FFormatSettings) + '}|{' +
AContact.Title + '}|{' +
AContact.Company + '}|{' +
AContact.Job_Position + '}|{' +
AContact.EMail + '}|{' +
AContact.Address + '}|{' +
AContact.City + '}|{' +
AContact.State + '}|{' +
AContact.Zip + '}|{' +
AContact.Country + '}|{' +
EncodeLineEndings(AContact.Notes) + '}|{' +
AContact.Phone1 + '}|{' +
AContact.Phone2 + '}|{' +
AContact.Phone3 + '}|{' +
AContact.Phone4 + '}|{' +
AContact.Phone5 + '}|{' +
IntToStr(AContact.PhoneType1) + '}|{' +
IntToStr(AContact.PhoneType2) + '}|{' +
IntToStr(AContact.PhoneType3) + '}|{' +
IntToStr(AContact.PhoneType4) + '}|{' +
IntToStr(AContact.PhoneType5) + '}|{' +
IntToStr(AContact.Category) + '}|{' +
AContact.Custom1 + '}|{' +
AContact.Custom2 + '}|{' +
AContact.Custom3 + '}|{' +
AContact.Custom4 + '}|{' +
AContact.UserField0 + '}|{' +
AContact.UserField1 + '}|{' +
AContact.UserField2 + '}|{' +
AContact.UserField3 + '}|{' +
AContact.UserField4 + '}|{' +
AContact.UserField5 + '}|{' +
AContact.UserField6 + '}|{' +
AContact.UserField7 + '}|{' +
AContact.UserField8 + '}|{' +
AContact.UserField9 + '}';
end;
function TVpIniDatastore.EventToStr(AEvent: TVpEvent): String;
begin
Result := '{' + // RecordID is stored as ini value name
FormatDateTime('c', AEvent.StartTime, FFormatSettings) + '}|{' + // Short date + long time
FormatDateTime('c', AEvent.EndTime, FFormatSettings) +'}|{' +
AEvent.Description + '}|{' +
AEvent.Location + '}|{' +
EncodeLineEndings(AEvent.Notes) + '}|{' +
IntToStr(AEvent.Category) + '}|{' +
AEvent.DingPath + '}|{' +
BoolToStr(AEvent.AllDayEvent, strTRUE, strFALSE) + '}|{' +
BoolToStr(AEvent.AlarmSet, strTRUE, strFALSE) + '}|{' +
IntToStr(AEvent.AlarmAdvance) + '}|{' +
GetEnumName(TypeInfo(TVpAlarmAdvType), ord(AEvent.AlarmAdvanceType)) + '}|{' +
FormatDateTime('tt', AEvent.SnoozeTime, FFormatSettings) + '}|{' + // long time format
GetEnumName(TypeInfo(TVpRepeatType), ord(AEvent.RepeatCode)) + '}|{' +
FormatDateTime('ddddd', AEvent.RepeatRangeEnd, FFormatSettings) + '}|{' + // Short date format
IntToStr(AEvent.CustomInterval) + '}|{' +
AEvent.UserField0 + '}|{' +
AEvent.UserField1 + '}|{' +
AEvent.UserField2 + '}|{' +
AEvent.UserField3 + '}|{' +
AEvent.UserField4 + '}|{' +
AEvent.UserField5 + '}|{' +
AEvent.UserField6 + '}|{' +
AEvent.UserField7 + '}|{' +
AEvent.UserField8 + '}|{' +
AEvent.UserField9 + '}';
end;
function TVpIniDatastore.GetNextID(TableName: string): Int64;
begin
repeat
Result := Random($7FFFFFFF);
until UniqueID(Result);
end;
function TVpIniDatastore.UniqueID(AValue: Int64): Boolean;
var
i, j: Integer;
res: TVpResource;
begin
Result := false;
for i:=0 to Resources.Count-1 do begin
res := Resources.Items[i];
if res.ResourceID = AValue then
exit;
for j:=0 to res.Contacts.Count-1 do
if res.Contacts.GetContact(j).RecordID = AValue then
exit;
for j:=0 to res.Tasks.Count-1 do
if res.Tasks.GetTask(j).RecordID = AValue then
exit;
for j:=0 to res.Schedule.EventCount-1 do
if res.Schedule.GetEvent(j).RecordID = AValue then
exit;
end;
Result := true;
end;
function TVpIniDatastore.ResourceToStr(AResource: TVpResource): String;
begin
result := '{' +
AResource.Description + '}|{' +
EncodeLineEndings(AResource.Notes) + '}|{' +
BoolToStr(AResource.ResourceActive, strTRUE, strFALSE) + '}|{' +
AResource.UserField0 + '}|{' +
AResource.UserField1 + '}|{' +
AResource.UserField2 + '}|{' +
AResource.UserField3 + '}|{' +
AResource.UserField4 + '}|{' +
AResource.UserField5 + '}|{' +
AResource.UserField6 + '}|{' +
AResource.UserField7 + '}|{' +
AResource.UserField8 + '}|{' +
AResource.UserField9 + '}';
end;
procedure TVpIniDatastore.SetConnected(const AValue: Boolean);
begin
if AValue = Connected then
exit;
if AValue then
ReadFromIni
else
WriteToIni;
inherited SetConnected(AValue);
end;
procedure TVpIniDatastore.SetResourceByName(Value: string);
var
I: integer;
res : TVpResource;
begin
for I := 0 to pred(Resources.Count) do begin
res := Resources.Items[I];
if Res = nil then
Continue;
if res.Description = Value then begin
if ResourceID <> Res.ResourceID then begin
ResourceID := Res.ResourceID;
RefreshResource;
end;
Exit;
end;
end;
end;
procedure TVpIniDatastore.Split(const AString: String; AList: TStrings);
var
p: PChar;
pStart, pEnd: PChar;
procedure AddString;
var
s: String;
begin
SetLength(s, PtrInt(pEnd) - PtrInt(pStart));
StrLCopy(PChar(s), pStart, PtrInt(pEnd) - PtrInt(pStart));
AList.Add(s);
end;
begin
AList.Clear;
if AString = '' then
exit;
p := @AString[1];
if p^ <> '{' then
IniError(RSIniFileStructure);
inc(p);
pStart := p;
while true do begin
case p^ of
#0: break;
'}': begin
pEnd := p;
inc(p);
if p^ = #0 then begin
AddString;
exit;
end;
if p^ <> '|' then
IniError(RSIniFileStructure);
inc(p);
if p^ <> '{' then
IniError(RSIniFileStructure);
AddString;
inc(p);
pstart := p;
end;
else inc(p);
end;
end;
end;
function TVpIniDatastore.TaskToStr(ATask: TVpTask): String;
begin
Result := '{' + // RecordID is stored as ini value name.
BoolToStr(ATask.Complete, strTRUE, strFALSE) + '}|{' +
ATask.Description + '}|{' +
EncodeLineendings(ATask.Details) + '}|{' +
FormatDateTime('ddddd', ATask.CreatedOn, FFormatsettings) + '}|{' +
FormatDateTime('ddddd', ATask.CompletedOn, FFormatSettings) + '}|{' +
IntToStr(ATask.Priority) + '}|{' +
IntToStr(ATask.Category) + '}|{' +
FormatDateTime('ddddd', ATask.DueDate, FFormatSettings) + '}|{' +
ATask.UserField0 + '}|{' +
ATask.UserField1 + '}|{' +
ATask.UserField2 + '}|{' +
ATask.UserField3 + '}|{' +
ATask.UserField4 + '}|{' +
ATask.UserField5 + '}|{' +
ATask.UserField6 + '}|{' +
ATask.UserField7 + '}|{' +
ATask.UserField8 + '}|{' +
ATask.UserField9 + '}'
end;
procedure TVpIniDatastore.SetFileName(const AValue: String);
begin
FFileName := AValue;
if AutoConnect then ReadFromIni;
end;
procedure TVpIniDatastore.LoadContacts;
begin
// Nothing to do here...
end;
procedure TVpIniDatastore.LoadEvents;
begin
// Nothing to do here...
end;
procedure TVpIniDatastore.LoadTasks;
begin
// Nothing to do here...
end;
procedure TVpIniDatastore.PostContacts;
begin
// Nothing to do...
end;
procedure TVpIniDatastore.PostEvents;
begin
// Nothing to do ...
end;
procedure TVpIniDatastore.PostResources;
begin
// Nothing to do...
end;
procedure TVpIniDatastore.PostTasks;
begin
// Nothing to do...
end;
procedure TVpIniDatastore.StrToContact(AString: String; AContact: TVpContact);
var
L: TStrings;
begin
L := TStringList.Create;
try
Split(AString, L);
if L.Count <> 39 then
IniError(RSIniFileStructure);
AContact.FirstName := L[0];
AContact.LastName := L[1];
AContact.BirthDate := StrToDate(L[2], FFormatSettings);
AContact.Anniversary := StrToDate(L[3], FFormatSettings);
AContact.Title := L[4];
AContact.Company := L[5];
AContact.Job_Position := L[6];
AContact.EMail := L[7];
AContact.Address := L[8];
AContact.City := L[9];
AContact.State := L[10];
AContact.Zip := L[11];
AContact.Country := L[12];
AContact.Notes := DecodeLineEndings(L[13]);
AContact.Phone1 := L[14];
AContact.Phone2 := L[15];
AContact.Phone3 := L[16];
AContact.Phone4 := L[17];
AContact.Phone5 := L[18];
AContact.PhoneType1 := StrToInt(L[19]);
AContact.PhoneType2 := StrToInt(L[20]);
AContact.PhoneType3 := StrToInt(L[21]);
AContact.PhoneType4 := StrToInt(L[22]);
AContact.PhoneType5 := StrToInt(L[23]);
AContact.Category := StrToInt(L[24]);
AContact.Custom1 := L[25];
AContact.Custom2 := L[26];
AContact.Custom3 := L[27];
AContact.Custom4 := L[28];
AContact.UserField0 := L[29];
AContact.UserField1 := L[30];
AContact.UserField2 := L[31];
AContact.UserField3 := L[32];
AContact.UserField4 := L[33];
AContact.UserField5 := L[34];
AContact.UserField6 := L[35];
AContact.UserField7 := L[36];
AContact.UserField8 := L[37];
AContact.UserField9 := L[38];
finally
L.Free;
end;
end;
procedure TVpIniDatastore.StrToEvent(AString: String; AEvent: TVpEvent);
var
L: TStrings;
begin
L := TStringList.Create;
try
Split(AString, L);
if L.Count <> 25 then
IniError(RSIniFileStructure);
AEvent.StartTime := StrToDateTime(L[0], FFormatSettings);
AEvent.EndTime := StrToDateTime(L[1], FFormatSettings);
AEvent.Description := L[2];
AEvent.Location := L[3];
AEvent.Notes := DecodeLineEndings(L[4]);
AEvent.Category := StrToInt(L[5]);
AEvent.DingPath := L[6];
AEvent.AllDayEvent := StrToBool(L[7]);
AEvent.AlarmSet := StrToBool(L[8]);
AEvent.AlarmAdvance := StrToInt(L[9]);
AEvent.AlarmAdvanceType := TVpAlarmAdvType(GetEnumValue(TypeInfo(TVpAlarmAdvType), L[10]));
AEvent.SnoozeTime := StrToTime(L[11]);
AEvent.RepeatCode := TVpRepeatType(GetEnumValue(TypeInfo(TVpRepeatType), L[12]));
AEvent.RepeatRangeEnd := StrToDate(L[13], FFormatSettings);
AEvent.CustomInterval := StrToInt(L[14]);
AEvent.UserField0 := L[15];
AEvent.UserField1 := L[16];
AEvent.UserField2 := L[17];
AEvent.UserField3 := L[18];
AEvent.UserField4 := L[19];
AEvent.UserField5 := L[20];
AEvent.UserField6 := L[21];
AEvent.UserField7 := L[22];
AEvent.UserField8 := L[23];
AEvent.UserField9 := L[24];
finally
L.Free;
end;
end;
procedure TVpIniDatastore.StrToResource(AString: String; AResource: TVpResource);
var
L: TStrings;
begin
L := TStringList.Create;
try
Split(AString, L);
if L.Count <> 13 then
IniError(RSIniFileStructure);
AResource.Description := L[0];
AResource.Notes := DecodeLineEndings(L[1]);
AResource.ResourceActive := StrToBool(L[2]);
AResource.UserField0 := L[3];
AResource.UserField1 := L[4];
AResource.UserField2 := L[5];
AResource.UserField3 := L[6];
AResource.UserField4 := L[7];
AResource.UserField5 := L[8];
AResource.UserField6 := L[9];
AResource.UserField7 := L[10];
AResource.UserField8 := L[11];
AResource.UserField9 := L[12];
finally
L.Free;
end;
end;
procedure TVpIniDatastore.StrToTask(AString: String; ATask: TVpTask);
var
L: TStrings;
begin
L := TStringList.Create;
try
Split(AString, L);
if L.Count <> 18 then
IniError(RSIniFileStructure);
ATask.Complete := StrToBool(L[0]);
ATask.Description := L[1];
ATask.Details := DecodeLineEndings(L[2]);
ATask.CreatedOn := StrToDate(L[3], FFormatSettings);
ATask.CompletedOn := StrToDate(L[4], FFormatSettings);
ATask.Priority := StrToInt(L[5]);
ATask.Category := StrToInt(L[6]);
ATask.DueDate := StrtoDate(L[7], FFormatSettings);
ATask.UserField0 := L[8];
ATask.UserField1 := L[9];
ATask.UserField2 := L[10];
ATask.UserField3 := L[11];
ATask.UserField4 := L[12];
ATask.UserField5 := L[13];
ATask.UserField6 := L[14];
ATask.UserField7 := L[15];
ATask.UserField8 := L[16];
ATask.UserField9 := L[17];
finally
L.Free;
end;
end;
procedure TVpIniDatastore.ReadFromIni;
var
ini: TCustomIniFile;
ResList, L: TStrings;
res: TVpResource;
contact: TVpContact;
event: TVpEvent;
task: TVpTask;
i,j: Integer;
s: String;
key: String;
resID, id: Int64;
begin
if FFileName = '' then
exit;
ini := TMemIniFile.Create(FFileName);
ResList := TStringList.Create;
L := TStringList.Create;
try
Resources.ClearResources;
ini.ReadSection('Resources', ResList);
for i:=0 to ResList.Count-1 do begin
s := ini.ReadString('Resources', ResList[i], '');
if s = '' then
IniError(RSIniFileStructure);
resID := StrToInt(ResList[i]);
res := Resources.AddResource(resID);
StrToResource(s, res);
key := Format('ContactsOfResource%d', [resID]);
L.Clear;
ini.ReadSection(key, L);
for j:=0 to L.Count-1 do begin
id := StrToInt(L[j]);
contact := res.Contacts.AddContact(id);
s := ini.ReadString(key, L[j], '');
StrToContact(s, contact);
end;
end;
key := Format('EventsOfResource%d', [resID]);
L.Clear;
ini.ReadSection(key, L);
for j:=0 to L.Count-1 do begin
id := StrToInt(L[j]);
event := res.Schedule.AddEvent(id, 0, 1);
s := ini.ReadString(key, L[j], '');
StrToEvent(s, event);
end;
key := Format('TasksOfResource%d', [resID]);
L.Clear;
ini.ReadSection(key, L);
for j:=0 to L.Count-1 do begin
id := StrToInt(L[j]);
task := res.Tasks.AddTask(id);
s := ini.ReadString(key, L[j], '');
StrToTask(s, task);
end;
finally
ini.Free;
L.Free;
ResList.Free;
end;
end;
procedure TVpIniDatastore.WriteToIni;
var
ini: TMemIniFile;
i, j: Integer;
res: TVpResource;
contact: TVpContact;
event: TVpEvent;
task: TVpTask;
key: String;
begin
if FFileName = '' then
exit;
ini := TMemIniFile.Create(FFileName);
try
ini.Clear;
for i:=0 to Resources.Count-1 do begin
res := Resources.Items[i];
ini.WriteString('Resources', IntToStr(res.ResourceID), ResourceToStr(res));
end;
for i:=0 to Resources.Count-1 do begin
res := Resources.Items[i];
key := Format('ContactsOfResource%d', [res.ResourceID]);
for j:=0 to res.Contacts.Count-1 do begin
contact := res.Contacts.GetContact(i);
ini.WriteString(key, IntToStr(contact.RecordID), ContactToStr(contact));
end;
end;
for i:=0 to Resources.Count-1 do begin
res := Resources.Items[i];
key := Format('TasksOfResource%d', [res.ResourceID]);
for j:=0 to res.Tasks.Count-1 do begin
task := res.Tasks.GetTask(i);
ini.WriteString(key, IntToStr(task.RecordID), TaskToStr(task));
end;
end;
for i:=0 to Resources.Count-1 do begin
res := Resources.Items[i];
key := Format('EventsOfResource%d', [res.ResourceID]);
for j:=0 to res.Schedule.EventCount-1 do begin
event := res.Schedule.GetEvent(j);
ini.WriteString(key, IntToStr(event.RecordID), EventToStr(event));
end;
end;
finally
ini.Free;
end;
end;
end.

View File

@ -118,6 +118,9 @@ function GetLineDuration(Granularity: TVpGranularity): Double;
function GetLabelWidth(ALabel: TLabel): Integer;
function DecodeLineEndings(const AText: String): String;
function EncodeLineEndings(const AText: String): String;
implementation
@ -609,5 +612,14 @@ begin
Result := trunc(ADate - First - 3 + (DayOfWeek(First) + 1) mod 7) div 7 + 1;
end;
function DecodeLineEndings(const AText: String): String;
begin
Result := StringReplace(AText, LineEnding, '\n', [rfReplaceAll]);
end;
function EncodeLineEndings(const AText: String): String;
begin
Result := StringReplace(AText, '\n', LineEnding, [rfReplaceAll]);
end;
end.

View File

@ -145,6 +145,7 @@ uses
VpDateEdit, { DateEdit Component }
{$ENDIF}
{$IFDEF LCL}
VpIniDS, { IniFile datastore }
VpBufDS, { Datastore for TBufDataset }
// VpSdfDS { Datastore for TSdfDataset }
// VpDbfDS, { Datastore for dbase files }
@ -511,6 +512,7 @@ begin
TVpDateEdit, // Does not work in Lazarus
{$ENDIF}
{$IFDEF LCL}
TVpIniDatastore,
TVpBufDSDatastore,
//TVpSdfDatastore, // to do (maybe)...
//TVpDbfDatastore, // to do...

Binary file not shown.

View File

@ -1,3 +1,5 @@
{$I vp.inc}
unit VpSQLite3DS;
interface

View File

@ -414,3 +414,6 @@ resourcestring
RSBrowserError = 'Unable to start web browser. Make sure you have ' +
'it properly setup on your system.';
{ Ini storage }
RSIniFileStructure = 'Incorrect structure of ini file.';

View File

@ -1,3 +1,5 @@
{$I vp.inc}
unit VpZeosDs;
interface