You've already forked lazarus-ccr
tvplanit: Export events to ical files (still buggy).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8401 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -19,6 +19,8 @@ type
|
||||
private
|
||||
FCalendar: TVpICalendar;
|
||||
FChecked: Boolean;
|
||||
protected
|
||||
procedure SaveToStrings(const AList: TStrings); virtual;
|
||||
public
|
||||
constructor Create(ACalendar: TVpICalendar); virtual;
|
||||
function FindItem(AKey: String): TVpICalItem;
|
||||
@@ -39,13 +41,15 @@ type
|
||||
FTrigger: Double; // "AlarmAdvance"
|
||||
FAudio: Boolean;
|
||||
FAudioSrc: String;
|
||||
protected
|
||||
procedure SaveToStrings(const AList: TStrings); override;
|
||||
public
|
||||
procedure Analyze; override;
|
||||
property Duration: Double read FDuration;
|
||||
property RepeatCount: Integer read FRepeat;
|
||||
property Trigger: Double read FTrigger;
|
||||
property Audio: Boolean read FAudio;
|
||||
property AudioSrc: String read FAudioSrc;
|
||||
property Duration: Double read FDuration write FDuration;
|
||||
property RepeatCount: Integer read FRepeat write FRepeat;
|
||||
property Trigger: Double read FTrigger write FTrigger;
|
||||
property Audio: Boolean read FAudio write FAudio;
|
||||
property AudioSrc: String read FAudioSrc write FAudioSrc;
|
||||
end;
|
||||
|
||||
{ TVpICalEvent }
|
||||
@@ -72,26 +76,29 @@ type
|
||||
function GetCategoryCount: Integer;
|
||||
function GetEndTime(UTC: Boolean): TDateTime;
|
||||
function GetStartTime(UTC: Boolean): TDateTime;
|
||||
procedure SetEndTime(UTC: Boolean; const AValue: TDateTime);
|
||||
procedure SetStartTime(UTC: Boolean; const AValue: TDateTime);
|
||||
public
|
||||
constructor Create(ACalendar: TVpICalendar); override;
|
||||
destructor Destroy; override;
|
||||
procedure Analyze; override;
|
||||
function Categories: TStrings;
|
||||
function IsAllDayEvent: Boolean;
|
||||
procedure UseAlarm;
|
||||
property Summary: String read FSummary; // is "Description" of tvp
|
||||
property Description: String read FDescription; // is "Notes" of tvp
|
||||
property Location: String read FLocation;
|
||||
property StartTime[UTC: Boolean]: TDateTime read GetStartTime;
|
||||
property EndTime[UTC: Boolean]: TDateTime read GetEndTime;
|
||||
procedure SaveToStrings(const AList: TStrings); override;
|
||||
procedure UseAlarm(AEnable: Boolean);
|
||||
property Summary: String read FSummary write FSummary; // is "Description" of tvp
|
||||
property Description: String read FDescription write FDescription; // is "Notes" of tvp
|
||||
property Location: String read FLocation write FLocation;
|
||||
property StartTime[UTC: Boolean]: TDateTime read GetStartTime write SetStartTime;
|
||||
property EndTime[UTC: Boolean]: TDateTime read GetEndTime write SetEndTime;
|
||||
property Category[AIndex: Integer]: String read GetCategory;
|
||||
property CategoryCount: Integer read GetCategoryCount;
|
||||
property Alarm: TVpICalAlarm read FAlarm;
|
||||
property RecurrenceFrequency: String read FRecurrenceFreq;
|
||||
property RecurrenceInterval: Integer read FRecurrenceInterval;
|
||||
property RecurrenceEndDate: TDateTime read FRecurrenceEndDate;
|
||||
property RecurrenceCount: Integer read FRecurrenceCount;
|
||||
property RecurrenceByXXX: String read FRecurrenceByXXX;
|
||||
property RecurrenceFrequency: String read FRecurrenceFreq write FRecurrenceFreq;
|
||||
property RecurrenceInterval: Integer read FRecurrenceInterval write FRecurrenceInterval;
|
||||
property RecurrenceEndDate: TDateTime read FRecurrenceEndDate write FRecurrenceEndDate;
|
||||
property RecurrenceCount: Integer read FRecurrenceCount write FRecurrenceCount;
|
||||
property RecurrenceByXXX: String read FRecurrenceByXXX write FRecurrenceByXXX;
|
||||
property PickedCategory: Integer read FPickedCategory write FPickedCategory;
|
||||
end;
|
||||
|
||||
@@ -120,6 +127,7 @@ type
|
||||
destructor Destroy; override;
|
||||
procedure Analyze; override;
|
||||
function Categories: TStrings;
|
||||
procedure SaveToStrings(const AList: TStrings); override;
|
||||
property Summary: String read FSummary;
|
||||
property Comment: String read FComment;
|
||||
property StartTime[UTC: Boolean]: TDateTime read GetStartTime;
|
||||
@@ -143,6 +151,8 @@ type
|
||||
protected
|
||||
// Reading
|
||||
procedure LoadFromStrings(const AStrings: TStrings);
|
||||
// Writing
|
||||
procedure SaveToStrings(const AList: TStrings);
|
||||
// Time conversion
|
||||
function ConvertTime(ADateTime: TDateTime; ATimeZoneID: String; ToUTC: Boolean): TDateTime;
|
||||
function LocalTimeToUTC(ADateTime: TDateTime; ATimeZoneID: String): TDateTime;
|
||||
@@ -150,13 +160,17 @@ type
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Add(AEntry: TVpICalEntry);
|
||||
procedure Clear;
|
||||
procedure LoadFromFile(const AFileName: String);
|
||||
procedure LoadFromStream(const AStream: TStream);
|
||||
procedure SaveToFile(const AFileName: String);
|
||||
procedure SaveToStream(const AStream: TStream);
|
||||
property Count: Integer read GetCount;
|
||||
property EventCount: Integer read GetEventCount;
|
||||
property TodoCount: Integer read GetToDoCount;
|
||||
property Entry[AIndex: Integer]: TVpICalEntry read GetEntry; default;
|
||||
property Version: String read FVersion write FVersion;
|
||||
end;
|
||||
|
||||
|
||||
@@ -165,6 +179,9 @@ implementation
|
||||
uses
|
||||
VpConst, VpBase;
|
||||
|
||||
const
|
||||
TIME_FORMAT = 'yyyymmdd"T"hhnnss';
|
||||
TIME_FORMAT_UTC = TIME_FORMAT + '"Z"';
|
||||
|
||||
// Examples: 19970702T160000, or T123000, or 20120101
|
||||
function iCalDateTime(AText: String; out IsUTC: Boolean): TDateTime;
|
||||
@@ -208,6 +225,34 @@ begin
|
||||
IsUTC := AText[Length(AText)] = 'Z';
|
||||
end;
|
||||
|
||||
function IsInteger(d, Epsilon: Double): Boolean;
|
||||
begin
|
||||
Result := abs(d - round(d)) < Epsilon;
|
||||
end;
|
||||
|
||||
// Converts a duration (in day units) to a string according to ical specs
|
||||
function Duration2iCalStr(AValue: double): String;
|
||||
var
|
||||
isNeg: Boolean = false;
|
||||
begin
|
||||
if AValue < 0 then
|
||||
begin
|
||||
isNeg := true;
|
||||
AValue := -AValue;
|
||||
end;
|
||||
if IsInteger(AValue, 1.0 / SecondsInDay) then
|
||||
Result :=Format('P%dS', [round(AValue * SecondsInDay)])
|
||||
else if IsInteger(AValue, 1.0/MinutesInDay) then
|
||||
Result := Format('P%dM', [round(AValue * MinutesInDay)])
|
||||
else if IsInteger(AValue, 1.0/HoursInday) then
|
||||
Result := Format('P%dH', [round(AValue * HoursInDay)])
|
||||
else if IsInteger(AValue, 1.0) then
|
||||
Result := Format('P%dD', [round(AValue)])
|
||||
else
|
||||
Result := Format('P%D%s', [trunc(AValue), FormatDateTime('h"H"n"M"s"S"', AValue)]);
|
||||
if isNeg then Result := '-' + Result;
|
||||
end;
|
||||
|
||||
// Example: PT0H20M0S, or -PT15M, or -P2D
|
||||
function iCalDuration(AText: String): Double;
|
||||
var
|
||||
@@ -292,6 +337,9 @@ begin
|
||||
Result := TVpICalItem(inherited FindItem(AKey, ''));
|
||||
end;
|
||||
|
||||
procedure TVpICalEntry.SaveToStrings(const AList: TStrings);
|
||||
begin
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{ TVpICalAlarm }
|
||||
@@ -320,6 +368,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpICalAlarm.SaveToStrings(const AList: TStrings);
|
||||
begin
|
||||
AList.Add('BEGIN:VALARM');
|
||||
if Audio then
|
||||
AList.Add('ACTION:AUDIO');
|
||||
if AudioSrc <> '' then
|
||||
AList.Add('ATTACH;FMTTYPE=AUDIO:' + AudioSrc);
|
||||
if RepeatCount > 0 then
|
||||
AList.Add('REPEAT:' + IntToStr(RepeatCount));
|
||||
if Trigger <> 0 then
|
||||
AList.Add('TRIGGER;VALUE=DURATION:' + Duration2iCalStr(Trigger));
|
||||
if Duration <> 0 then
|
||||
AList.Add('DURATION;VALUE=DURATION:' + Duration2iCalStr(Duration));
|
||||
AList.Add('END:VALARM');
|
||||
end;
|
||||
|
||||
|
||||
{==============================================================================}
|
||||
{ TVpICalEvent }
|
||||
@@ -471,10 +535,80 @@ begin
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
procedure TVpICalEvent.UseAlarm;
|
||||
procedure TVpICalEvent.SaveToStrings(const AList: TStrings);
|
||||
var
|
||||
lKey: String = '';
|
||||
lValue: String = '';
|
||||
begin
|
||||
FAlarm.Free;
|
||||
FAlarm := TVpICalAlarm.Create(FCalendar);
|
||||
AList.Add('BEGIN:VEVENT');
|
||||
|
||||
if FSummary <> '' then
|
||||
AList.Add('SUMMARY:' + FSummary);
|
||||
if FDescription <> '' then
|
||||
AList.Add('DESCRIPTION:' + FDescription);
|
||||
if FLocation <> '' then
|
||||
AList.Add('LOCATION:' + FLocation);
|
||||
if FCategories.Count > 0 then
|
||||
AList.Add('CATEGORIES:' + FCategories.CommaText);
|
||||
|
||||
// todo: check time zones!
|
||||
if FStartTimeTZ <> '' then
|
||||
lKey := 'DTSTART;TZID=' + FStartTimeTZ + ':'
|
||||
else
|
||||
lKey := 'DTSTART:';
|
||||
AList.Add(lKey + FormatDateTime(TIME_FORMAT_UTC, StartTime[true]));
|
||||
if FEndTimeTZ <> '' then
|
||||
lKey := 'DTEND;TZID=' + FEndTimeTZ + ':'
|
||||
else
|
||||
lKey := 'DTEND:';
|
||||
AList.Add(lKey + FormatDateTime(TIME_FORMAT_UTC, EndTime[true]));
|
||||
|
||||
if RecurrenceFrequency <> '' then
|
||||
begin
|
||||
lKey := 'RRULE:';
|
||||
lValue := 'FREQ=' + RecurrenceFrequency;
|
||||
if RecurrenceInterval > 0 then
|
||||
lValue := lValue + ';INTERVAL=' + IntToStr(RecurrenceInterval);
|
||||
if RecurrenceEndDate <> 0 then
|
||||
lValue := lValue + ';UNTIL=' + FormatDateTime(TIME_FORMAT, RecurrenceEndDate);
|
||||
if RecurrenceCount > 0 then
|
||||
lValue := lValue + ';COUNT=' + IntToStr(RecurrenceCount);
|
||||
if RecurrenceByXXX <> '' then
|
||||
lValue := lValue + ';' + RecurrenceByXXX;
|
||||
AList.Add(lKey + lValue);
|
||||
end;
|
||||
|
||||
if Alarm <> nil then
|
||||
Alarm.SaveToStrings(AList);
|
||||
end;
|
||||
|
||||
procedure TVpICalEvent.SetEndTime(UTC: Boolean; const AValue: TDateTime);
|
||||
begin
|
||||
if AValue = NO_DATE then
|
||||
FEndTime := NO_DATE
|
||||
else
|
||||
if UTC then
|
||||
FEndTime := AValue
|
||||
else
|
||||
FEndTime := FCalendar.LocalTimeToUTC(AValue, FEndTimeTZ);
|
||||
end;
|
||||
|
||||
procedure TVpICalEvent.SetStartTime(UTC: Boolean; const AValue: TDateTime);
|
||||
begin
|
||||
if AValue = NO_DATE then
|
||||
FStartTime := NO_DATE
|
||||
else
|
||||
if UTC then
|
||||
FStartTime := AValue
|
||||
else
|
||||
FStartTime := FCalendar.LocalTimeToUTC(AValue, FStartTimeTZ);
|
||||
end;
|
||||
|
||||
procedure TVpICalEvent.UseAlarm(AEnable: Boolean);
|
||||
begin
|
||||
FreeAndNil(FAlarm);
|
||||
if AEnable then
|
||||
FAlarm := TVpICalAlarm.Create(FCalendar);
|
||||
end;
|
||||
|
||||
|
||||
@@ -589,6 +723,10 @@ begin
|
||||
Result := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
|
||||
end;
|
||||
|
||||
procedure TVpICalToDo.SaveToStrings(const AList: TStrings);
|
||||
begin
|
||||
// to do...
|
||||
end;
|
||||
|
||||
|
||||
{==============================================================================}
|
||||
@@ -598,15 +736,25 @@ end;
|
||||
constructor TVpICalendar.Create;
|
||||
begin
|
||||
inherited;
|
||||
FVersion := '2.0';
|
||||
SetLength(FEntries, 0);
|
||||
end;
|
||||
|
||||
destructor TVpICalendar.Destroy;
|
||||
begin
|
||||
SetLength(FEntries, 0);
|
||||
Clear;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TVpICalendar.Add(AEntry: TVpICalEntry);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
n := Length(FEntries);
|
||||
SetLength(FEntries, n+1);
|
||||
FEntries[n] := AEntry;
|
||||
end;
|
||||
|
||||
procedure TVpICalendar.Clear;
|
||||
var
|
||||
j: Integer;
|
||||
@@ -724,7 +872,7 @@ begin
|
||||
'VALARM':
|
||||
if currEntry is TVpICalEvent then begin
|
||||
oldEntry := currEntry;
|
||||
TVpICalEvent(currEntry).UseAlarm;
|
||||
TVpICalEvent(currEntry).UseAlarm(true);
|
||||
currEntry := TVpICalEvent(currEntry).Alarm;
|
||||
end;
|
||||
else
|
||||
@@ -756,6 +904,51 @@ begin
|
||||
SetLength(FEntries, n);
|
||||
end;
|
||||
|
||||
procedure TVpICalendar.SaveToFile(const AFileName: String);
|
||||
var
|
||||
L: TStrings;
|
||||
begin
|
||||
L := TStringList.Create;
|
||||
try
|
||||
SaveToStrings(L);
|
||||
L.SaveToFile(AFileName);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpICalendar.SaveToStream(const AStream: TStream);
|
||||
var
|
||||
L: TStrings;
|
||||
begin
|
||||
L := TStringList.Create;
|
||||
try
|
||||
SaveToStrings(L);
|
||||
L.SaveToStream(AStream);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpICalendar.SaveToStrings(const AList: TStrings);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
AList.Clear;
|
||||
AList.Add('BEGIN:VCALENDAR');
|
||||
if FVersion <> '' then
|
||||
AList.Add('VERSION:' + FVersion);
|
||||
|
||||
AList.Add('BEGIN:VTIMEZONE');
|
||||
// to do: complete here TIMEZONE section with DAYLIGHT and STANDARD sections
|
||||
AList.Add('END:VTIMEZONE');
|
||||
|
||||
for i := 0 to Count-1 do
|
||||
Entry[i].SaveToStrings(AList);
|
||||
|
||||
AList.Add('END:VCALENDAR');
|
||||
end;
|
||||
|
||||
function TVpICalendar.ConvertTime(ADateTime: TDateTime;
|
||||
ATimeZoneID: String; ToUTC: Boolean): TDateTime;
|
||||
var
|
||||
|
||||
Reference in New Issue
Block a user