diff --git a/components/tvplanit/languages/vpsr.de.po b/components/tvplanit/languages/vpsr.de.po
index ef7b39a52..2310efef2 100644
--- a/components/tvplanit/languages/vpsr.de.po
+++ b/components/tvplanit/languages/vpsr.de.po
@@ -520,6 +520,10 @@ msgstr "Zuhause"
msgid "Hours"
msgstr "Stunden"
+#: vpsr.rsicalfilter
+msgid "iCalendar files (*.ical;*.ics)|*.ical;*.ics"
+msgstr ""
+
#: vpsr.rsinches
msgid "Inches"
msgstr "Zoll"
@@ -581,8 +585,12 @@ msgstr "M"
msgid "Load file..."
msgstr "Datei laden..."
+#: vpsr.rsloadicaltitle
+msgid "Import from iCal file(s)"
+msgstr ""
+
#: vpsr.rsloadvcardstitle
-msgid "Load vCard(s)"
+msgid "Import from vCard(s)"
msgstr ""
#: vpsr.rslocation
@@ -920,6 +928,10 @@ msgctxt "vpsr.rspopupaddevent"
msgid "Add event..."
msgstr "Ereignis hinzufügen..."
+#: vpsr.rspopupaddeventfromical
+msgid "Import from iCalendar file(s)..."
+msgstr ""
+
#: vpsr.rspopupchangedate
msgctxt "vpsr.rspopupchangedate"
msgid "Change date"
@@ -1128,6 +1140,10 @@ msgstr "Fehler: Kann nicht updaten"
msgid "Incorrect order of start and end times. Do you want to exchange them?"
msgstr "Falsche Reihenfolge der Start- und Ende-Zeit. Wollen Sie die beiden vertauschen?"
+#: vpsr.rsstartendtimesequal
+msgid "Start and end times cannot be equal."
+msgstr ""
+
#: vpsr.rsstarttimelbl
msgid "Start time:"
msgstr "Start-Zeit:"
diff --git a/components/tvplanit/languages/vpsr.fi.po b/components/tvplanit/languages/vpsr.fi.po
index a1a3d13e2..33d3ac42b 100644
--- a/components/tvplanit/languages/vpsr.fi.po
+++ b/components/tvplanit/languages/vpsr.fi.po
@@ -511,6 +511,10 @@ msgstr ""
msgid "Hours"
msgstr "Tunnit"
+#: vpsr.rsicalfilter
+msgid "iCalendar files (*.ical;*.ics)|*.ical;*.ics"
+msgstr ""
+
#: vpsr.rsinches
msgid "Inches"
msgstr ""
@@ -572,8 +576,12 @@ msgstr "M"
msgid "Load file..."
msgstr ""
+#: vpsr.rsloadicaltitle
+msgid "Import from iCal file(s)"
+msgstr ""
+
#: vpsr.rsloadvcardstitle
-msgid "Load vCard(s)"
+msgid "Import from vCard(s)"
msgstr ""
#: vpsr.rslocation
@@ -911,6 +919,10 @@ msgctxt "vpsr.rspopupaddevent"
msgid "Add event..."
msgstr ""
+#: vpsr.rspopupaddeventfromical
+msgid "Import from iCalendar file(s)..."
+msgstr ""
+
#: vpsr.rspopupchangedate
msgctxt "vpsr.rspopupchangedate"
msgid "Change date"
@@ -1117,6 +1129,10 @@ msgstr ""
msgid "Incorrect order of start and end times. Do you want to exchange them?"
msgstr ""
+#: vpsr.rsstartendtimesequal
+msgid "Start and end times cannot be equal."
+msgstr ""
+
#: vpsr.rsstarttimelbl
msgid "Start time:"
msgstr ""
diff --git a/components/tvplanit/languages/vpsr.fr.po b/components/tvplanit/languages/vpsr.fr.po
index 0a55f8526..979f1f1f1 100644
--- a/components/tvplanit/languages/vpsr.fr.po
+++ b/components/tvplanit/languages/vpsr.fr.po
@@ -526,6 +526,10 @@ msgstr "Maison"
msgid "Hours"
msgstr "Heures"
+#: vpsr.rsicalfilter
+msgid "iCalendar files (*.ical;*.ics)|*.ical;*.ics"
+msgstr ""
+
#: vpsr.rsinches
msgid "Inches"
msgstr ""
@@ -587,8 +591,12 @@ msgstr ""
msgid "Load file..."
msgstr ""
+#: vpsr.rsloadicaltitle
+msgid "Import from iCal file(s)"
+msgstr ""
+
#: vpsr.rsloadvcardstitle
-msgid "Load vCard(s)"
+msgid "Import from vCard(s)"
msgstr ""
#: vpsr.rslocation
@@ -926,6 +934,10 @@ msgctxt "vpsr.rspopupaddevent"
msgid "Add event..."
msgstr "Ajouter un événement..."
+#: vpsr.rspopupaddeventfromical
+msgid "Import from iCalendar file(s)..."
+msgstr ""
+
#: vpsr.rspopupchangedate
msgctxt "vpsr.rspopupchangedate"
msgid "Change date"
@@ -1134,6 +1146,10 @@ msgstr "Erreur: Modification à echoué"
msgid "Incorrect order of start and end times. Do you want to exchange them?"
msgstr "Ordre incorrect des heures de début et de fin. Voulez-vous les retourner?"
+#: vpsr.rsstartendtimesequal
+msgid "Start and end times cannot be equal."
+msgstr ""
+
#: vpsr.rsstarttimelbl
msgid "Start time:"
msgstr "Début"
diff --git a/components/tvplanit/languages/vpsr.nl.po b/components/tvplanit/languages/vpsr.nl.po
index 5d778aa9f..27f5100a0 100644
--- a/components/tvplanit/languages/vpsr.nl.po
+++ b/components/tvplanit/languages/vpsr.nl.po
@@ -520,6 +520,10 @@ msgstr "Thuis"
msgid "Hours"
msgstr "Uren"
+#: vpsr.rsicalfilter
+msgid "iCalendar files (*.ical;*.ics)|*.ical;*.ics"
+msgstr ""
+
#: vpsr.rsinches
msgid "Inches"
msgstr ""
@@ -581,8 +585,12 @@ msgstr "M"
msgid "Load file..."
msgstr ""
+#: vpsr.rsloadicaltitle
+msgid "Import from iCal file(s)"
+msgstr ""
+
#: vpsr.rsloadvcardstitle
-msgid "Load vCard(s)"
+msgid "Import from vCard(s)"
msgstr ""
#: vpsr.rslocation
@@ -920,6 +928,10 @@ msgctxt "vpsr.rspopupaddevent"
msgid "Add event..."
msgstr "Gebeurtenis toevoegen..."
+#: vpsr.rspopupaddeventfromical
+msgid "Import from iCalendar file(s)..."
+msgstr ""
+
#: vpsr.rspopupchangedate
msgctxt "vpsr.rspopupchangedate"
msgid "Change date"
@@ -1128,6 +1140,10 @@ msgstr "Fout: Updaten niet mogelijk "
msgid "Incorrect order of start and end times. Do you want to exchange them?"
msgstr "Incorrecte volgorde van start- en eindtijden. Wilt u ze verwisselen?"
+#: vpsr.rsstartendtimesequal
+msgid "Start and end times cannot be equal."
+msgstr ""
+
#: vpsr.rsstarttimelbl
msgid "Start time:"
msgstr "Starttijd:"
diff --git a/components/tvplanit/languages/vpsr.po b/components/tvplanit/languages/vpsr.po
index 0fa41917d..1ed76198b 100644
--- a/components/tvplanit/languages/vpsr.po
+++ b/components/tvplanit/languages/vpsr.po
@@ -510,6 +510,10 @@ msgstr ""
msgid "Hours"
msgstr ""
+#: vpsr.rsicalfilter
+msgid "iCalendar files (*.ical;*.ics)|*.ical;*.ics"
+msgstr ""
+
#: vpsr.rsinches
msgid "Inches"
msgstr ""
@@ -571,8 +575,12 @@ msgstr ""
msgid "Load file..."
msgstr ""
+#: vpsr.rsloadicaltitle
+msgid "Import from iCal file(s)"
+msgstr ""
+
#: vpsr.rsloadvcardstitle
-msgid "Load vCard(s)"
+msgid "Import from vCard(s)"
msgstr ""
#: vpsr.rslocation
@@ -910,6 +918,10 @@ msgctxt "vpsr.rspopupaddevent"
msgid "Add event..."
msgstr ""
+#: vpsr.rspopupaddeventfromical
+msgid "Import from iCalendar file(s)..."
+msgstr ""
+
#: vpsr.rspopupchangedate
msgctxt "vpsr.rspopupchangedate"
msgid "Change date"
@@ -1116,6 +1128,10 @@ msgstr ""
msgid "Incorrect order of start and end times. Do you want to exchange them?"
msgstr ""
+#: vpsr.rsstartendtimesequal
+msgid "Start and end times cannot be equal."
+msgstr ""
+
#: vpsr.rsstarttimelbl
msgid "Start time:"
msgstr ""
diff --git a/components/tvplanit/languages/vpsr.ru.po b/components/tvplanit/languages/vpsr.ru.po
index 7c43c2cc5..63fca18d8 100644
--- a/components/tvplanit/languages/vpsr.ru.po
+++ b/components/tvplanit/languages/vpsr.ru.po
@@ -520,6 +520,10 @@ msgstr "Домашний"
msgid "Hours"
msgstr "Часы"
+#: vpsr.rsicalfilter
+msgid "iCalendar files (*.ical;*.ics)|*.ical;*.ics"
+msgstr ""
+
#: vpsr.rsinches
msgid "Inches"
msgstr "Дюймы"
@@ -581,8 +585,12 @@ msgstr ""
msgid "Load file..."
msgstr "Загрузить файл..."
+#: vpsr.rsloadicaltitle
+msgid "Import from iCal file(s)"
+msgstr ""
+
#: vpsr.rsloadvcardstitle
-msgid "Load vCard(s)"
+msgid "Import from vCard(s)"
msgstr ""
#: vpsr.rslocation
@@ -920,6 +928,10 @@ msgctxt "vpsr.rspopupaddevent"
msgid "Add event..."
msgstr "Добавить событие..."
+#: vpsr.rspopupaddeventfromical
+msgid "Import from iCalendar file(s)..."
+msgstr ""
+
#: vpsr.rspopupchangedate
msgctxt "vpsr.rspopupchangedate"
msgid "Change date"
@@ -1126,6 +1138,10 @@ msgstr "Ошибка обновления"
msgid "Incorrect order of start and end times. Do you want to exchange them?"
msgstr ""
+#: vpsr.rsstartendtimesequal
+msgid "Start and end times cannot be equal."
+msgstr ""
+
#: vpsr.rsstarttimelbl
msgid "Start time:"
msgstr "Время начала:"
diff --git a/components/tvplanit/laz_visualplanit.lpk b/components/tvplanit/laz_visualplanit.lpk
index bcbc12e4e..ea56fc89b 100644
--- a/components/tvplanit/laz_visualplanit.lpk
+++ b/components/tvplanit/laz_visualplanit.lpk
@@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
Contributor(s): "/>
-
+
@@ -325,6 +325,10 @@ Contributor(s): "/>
+
+
+
+
diff --git a/components/tvplanit/source/include/vpsr.inc b/components/tvplanit/source/include/vpsr.inc
index ccc00a17d..850cd5854 100644
--- a/components/tvplanit/source/include/vpsr.inc
+++ b/components/tvplanit/source/include/vpsr.inc
@@ -165,7 +165,7 @@ resourcestring
RSContactPopupEdit = 'Edit contact...';
RSContactPopupDelete = 'Delete contact...';
RSConfirmDeleteContact = 'Delete contact %s?';
- RSLoadVCardsTitle = 'Load vCard(s)';
+ RSLoadVCardsTitle = 'Import from vCard(s)';
RSVCardFilter = 'vCard files (*.vcf)|*.vcf';
{Event Specific}
@@ -174,10 +174,13 @@ resourcestring
RSConfirmDeleteEvent = 'Delete event from schedule?';
RSStartEndTimeError = 'Incorrect order of start and end times. ' +
'Do you want to exchange them?';
+ RSStartEndTimesEqual = 'Start and end times cannot be equal.';
RSCannotEditOverlayedEvent= 'Cannot edit this overlayed event.';
+ RSLoadICalTitle = 'Import from iCal file(s)';
RSNoOverlayedEvents = 'none';
RSOverlayedEvent = 'overlayed';
RSOverlayed = 'Overlayed';
+ RSICalFilter = 'iCalendar files (*.ical;*.ics)|*.ical;*.ics';
{Task Specific}
RSConfirmDeleteTask = 'Delete this task from your list?';
@@ -189,6 +192,7 @@ resourcestring
{ Popup specific }
RSPopupAddEvent = 'Add event...';
+ RSPopupAddEventFromICal = 'Import from iCalendar file(s)...';
RSPopupEditEvent = 'Edit event...';
RSPopupDeleteEvent = '&Delete event...';
RSPopupChangeDate = 'Change date';
diff --git a/components/tvplanit/source/vpbasedatafiles.pas b/components/tvplanit/source/vpbasedatafiles.pas
index ebc3b2989..64a575df9 100644
--- a/components/tvplanit/source/vpbasedatafiles.pas
+++ b/components/tvplanit/source/vpbasedatafiles.pas
@@ -15,9 +15,9 @@ type
protected
FRaw: String;
FKey: String;
- FTags: TStrings;
+ FAttributes: TStrings;
FValue: String;
- procedure GetParts(AText: String; out AKey: String; out ATags: TStringArray;
+ procedure GetParts(AText: String; out AKey: String; out Attr: TStringArray;
out AValue: String);
function UnEscape(AValueText: String): String;
function UnquotePrintable(AValueText: String): String;
@@ -26,7 +26,7 @@ type
destructor Destroy; override;
procedure Analyze;
property Key: String read FKey;
- property Tags: TStrings read FTags;
+ property Attributes: TStrings read FAttributes;
property Value: String read FValue;
end;
@@ -35,7 +35,7 @@ type
TVpFileBlock = class
private
FItemClass: TVpFileItemClass;
- function GetValue(const AKey, ATags: String): String;
+ function GetValue(const AKey, Attributes: String): String;
protected
FItems: TObjectList;
public
@@ -43,8 +43,8 @@ type
destructor Destroy; override;
procedure Add(const AText: String);
procedure Analyze; virtual;
- function FindItem(AKey, ATags: String): TVpFileItem;
- property Value[AKey: String; const ATags: String]: String read GetValue;
+ function FindItem(AKey, Attributes: String): TVpFileItem;
+ property Value[AKey: String; const Attributes: String]: String read GetValue;
end;
const
@@ -71,25 +71,25 @@ end;
destructor TVpFileItem.Destroy;
begin
- FTags.Free;
+ FAttributes.Free;
inherited;
end;
procedure TVpFileItem.Analyze;
var
- tagarray: TStringArray;
+ attrArray: TStringArray;
i: Integer;
begin
- GetParts(FRaw, FKey, tagarray, FValue);
- FTags := TStringList.Create;
- for i:=Low(tagarray) to High(tagarray) do
- FTags.Add(tagarray[i]);
+ GetParts(FRaw, FKey, attrArray, FValue);
+ FAttributes := TStringList.Create;
+ for i:=Low(attrArray) to High(attrArray) do
+ FAttributes.Add(attrArray[i]);
end;
// Example
// ADR;TYPE=WORK,POSTAL,PARCEL:;;One Microsoft Way;Redmond;WA;98052-6399;USA
procedure TVpFileItem.GetParts(AText: String; out AKey: String;
- out ATags: TStringArray; out AValue: String);
+ out Attr: TStringArray; out AValue: String);
var
p: Integer;
keypart, valuepart: String;
@@ -107,17 +107,17 @@ begin
p := pos(KEY_DELIMITER, keypart);
if p = 0 then begin
AKey := keypart;
- SetLength(ATags, 0);
+ SetLength(Attr, 0);
end else begin
AKey := Copy(keypart, 1, p-1);
keypart := Copy(keypart, p+1, MaxInt);
if pos('TYPE=', keypart) = 1 then begin
keypart := copy(keypart, Length('TYPE='), MaxInt);
- ATags := Split(keypart, TYPE_DELIMITER); // Split at ','
+ Attr := Split(keypart, TYPE_DELIMITER); // Split at ','
end else
- ATags := Split(keypart, KEY_DELIMITER); // Split at ';'
- for i:=Low(ATags) to High(ATags) do
- if ATags[i] = 'QUOTED-PRINTABLE' then begin
+ Attr := Split(keypart, KEY_DELIMITER); // Split at ';'
+ for i:=Low(Attr) to High(Attr) do
+ if Attr[i] = 'QUOTED-PRINTABLE' then begin
QuotedPrintable := true;
break;
end;
@@ -256,34 +256,39 @@ begin
end;
end;
-{ Finds the item with the specified key and tags. Several tags can be combined
- by a semicolon. If a tag name begins with a '-' then it must NOT be present.
+{ Finds the item with the specified key and attributes.
+ Several attributes can be combined by a semicolon.
+ If an attribute name begins with a '-' then it must NOT be present.
The conditions are and-ed, i.e. all conditions must be met for the item to
be accepted. }
-function TVpFileBlock.FindItem(AKey, ATags: String): TVpFileItem;
+function TVpFileBlock.FindItem(AKey, Attributes: String): TVpFileItem;
var
i: Integer;
item: TVpFileItem;
- tagArr: TStringArray;
- tag, notTag: String;
+ attrArray: TStringArray;
+ attr, notAttr: String;
ok: Boolean;
begin
- tagArr := Split(ATags, ';');
+ attrArray := Split(Attributes, ';');
for i:=0 to FItems.Count-1 do begin
item := TVpFileItem(FItems[i]);
if (AKey = item.Key) then
begin
- ok := true; // No tags specified --> use first item found
- if Length(tagArr) > 0 then begin
- for tag in tagArr do begin
- if tag[1] = '-' then
- notTag := Copy(tag, 2, MaxInt);
- if item.Tags.IndexOf(tag) = -1 then begin // Tag not found --> reject
+ ok := true; // No attr specified --> use first item found
+ if Length(attrArray) > 0 then begin
+ for attr in attrArray do begin
+ if attr[1] = '-' then
+ notAttr := Copy(attr, 2, MaxInt)
+ else
+ notAttr := '';
+ if item.Attributes.IndexOf(attr) = -1 then begin
+ // required attribute not found --> reject
ok := false;
break;
end;
- if item.Tags.Indexof(notTag) <> -1 then begin // "NOT" tag found --> reject
+ if (notAttr <> '') and (item.Attributes.IndexOf(notAttr) <> -1) then begin
+ // forbidden attribute found --> reject
ok := false;
break;
end;
@@ -298,11 +303,11 @@ begin
Result := nil;
end;
-function TVpFileBlock.GetValue(const AKey, ATags: String): String;
+function TVpFileBlock.GetValue(const AKey, Attributes: String): String;
var
item: TVpFileItem;
begin
- item := FindItem(AKey, ATags);
+ item := FindItem(AKey, Attributes);
if item <> nil then
Result := item.Value
else
diff --git a/components/tvplanit/source/vpdata.pas b/components/tvplanit/source/vpdata.pas
index e0733f0e7..8e8e123ec 100644
--- a/components/tvplanit/source/vpdata.pas
+++ b/components/tvplanit/source/vpdata.pas
@@ -26,7 +26,9 @@
{* *}
{* ***** END LICENSE BLOCK ***** *}
-{$I vp.inc}
+{$MODE ObjFPC}{$H+}
+
+//{$I vp.inc}
unit VpData;
{ Data classes for Visual PlanIt's resources, events, tasks, contacts, etc... }
@@ -34,14 +36,9 @@ unit VpData;
interface
uses
- {$IFDEF LCL}
LCLProc, LCLType,
- {$ELSE}
- Windows,
- {$ENDIF}
SysUtils, Classes, Dialogs, Graphics,
- {$IFDEF VERSION6} Types, {$ENDIF}
- VpSR, VpVCard;
+ VpSR, VpVCard, VpICal;
type
TVpEventRec = packed record
@@ -307,6 +304,7 @@ type
function CanEdit: Boolean;
function GetResource: TVpResource;
function IsOverlayed: Boolean;
+ procedure LoadFromICalendar(AEntry: TVpICalEvent);
property Owner: TVpSchedule read FOwner;
property ResourceID: Integer read FResourceID write FResourceID;
property Loading : Boolean read FLoading write FLoading;
@@ -696,7 +694,7 @@ function CompareEventsByTimeOnly(Item1, Item2: Pointer): Integer;
implementation
uses
- Math,
+ Math, DateUtils,
VpException, VpConst, VpMisc;
const
@@ -913,7 +911,7 @@ var
begin
result := nil;
for I := 0 to pred(FResourceList.Count) do begin
- res := FResourceList.Items[I];
+ res := TVpResource(FResourceList.Items[I]);
if Res.ResourceID = ID then begin
result := Res;
Exit;
@@ -1263,6 +1261,111 @@ begin
end;
end;
+function IsInteger(d, Epsilon: Double): Boolean;
+begin
+ Result := abs(d - round(d)) < Epsilon;
+end;
+
+procedure TVpEvent.LoadFromICalendar(AEntry: TVpICalEvent);
+var
+ dt: Double;
+begin
+ if AEntry = nil then
+ exit;
+
+ { Standard event properties }
+ FDescription := AEntry.Summary;
+ FNotes := AEntry.Description;
+ FLocation := AEntry.Location;
+ // Start and end time already have been set --> Skip .
+
+ { All-day event }
+ FAllDayEvent := (frac(FStartTime) = 0) and (frac(FEndTime) = 0);
+
+ { Alarm properties }
+ if AEntry.Alarm <> nil then begin
+ FAlarmSet := true;
+ dt := abs(AEntry.Alarm.Trigger);
+ if IsInteger(dt, 1.0 / SecondsInDay) then begin
+ FAlarmAdvType := atDays;
+ FAlarmAdv := round(dt);
+ end else
+ if IsInteger(dt*HoursInDay, HoursInDay / SecondsInDay) then begin
+ FAlarmAdvType := atHours;
+ FAlarmAdv := round(dt * HoursInDay);
+ end else begin
+ FAlarmAdvType := atMinutes;
+ FAlarmAdv := round(dt * MinutesInDay);
+ end;
+ FDingPath := AEntry.Alarm.AudioSrc;
+ if not FileExists(FDingPath) then FDingPath := '';
+ end else
+ FAlarmSet := false;
+
+ { Recurrence }
+ FRepeatCode := rtNone;
+ FRepeatRangeEnd := 0;
+ case AEntry.RecurrenceFrequency of
+ 'YEARLY':
+ if AEntry.RecurrenceInterval = 0 then
+ FRepeatCode := rtYearlyByDate // or rtYearlyByDay ?
+ else begin
+ FRepeatCode := rtCustom;
+ FCustInterval := AEntry.RecurrenceInterval * 365; // * SecondsInDay;
+ end;
+ 'MONTHLY':
+ if AEntry.RecurrenceInterval = 0 then
+ FRepeatCode := rtMonthlyByDate // or rtMonthlyByDay ?
+ else begin
+ FRepeatCode := rtCustom;
+ FCustInterval := AEntry.RecurrenceInterval * 30; // * SecondsInDay;
+ end;
+ 'WEEKLY':
+ if AEntry.RecurrenceInterval = 0 then
+ FRepeatCode := rtWeekly
+ else begin
+ FRepeatCode := rtCustom;
+ FCustInterval := AEntry.RecurrenceInterval * 7; // * SecondsInDay;
+ end;
+ 'DAILY':
+ if AEntry.RecurrenceInterval = 0 then
+ FRepeatCode := rtDaily
+ else begin
+ FRepeatCode := rtCustom;
+ FCustInterval := AEntry.RecurrenceInterval; // * SecondsInDay;
+ end;
+ (*
+ 'HOURLY':
+ begin
+ FRepeatCode := rtCustom;
+ FCustInterval := AEntry.RecurrenceInterval * SecondsInHour;
+ end;
+ 'MINUTELY':
+ begin
+ FRepeatCode := rtCustom;
+ FCustInterval := AEntry.RecurrenceInterval * SecondsInMinute;
+ end;
+ *)
+ end;
+ if (AEntry.RecurrenceEndDate = 0) and (AEntry.RecurrenceCount > 0) then begin
+ FRepeatRangeEnd := trunc(FStartTime);
+ case FRepeatCode of
+ rtYearlyByDate:
+ FRepeatRangeEnd := IncYear(FRepeatRangeEnd, AEntry.RecurrenceCount);
+ rtMonthlyByDate:
+ FRepeatRangeEnd := IncMonth(FRepeatRangeEnd, AEntry.RecurrenceCount);
+ rtWeekly:
+ FRepeatRangeEnd := FRepeatRangeEnd + 7 * AEntry.RecurrenceCount;
+ rtDaily:
+ FRepeatRangeEnd := FRepeatRangeEnd + AEntry.RecurrenceCount;
+ end;
+ end else
+ FRepeatRangeEnd := AEntry.RecurrenceEndDate;
+
+ // There is also "CustomInterval" which may be extracted from the RecurrenceByXXXX data
+ // But this is very complex...
+end;
+
procedure TVpEvent.SetAlarmAdv(Value: Integer);
begin
if Value <> FAlarmAdv then begin
@@ -1451,93 +1554,22 @@ begin
FEventList.Sort(@CompareEvents);
end;
-(*
-procedure TVpSchedule.Sort;
-var
- i, j : integer;
- IndexOfMin : integer;
- Temp : pointer;
- CompResult : integer; {Comparison Result}
-begin
- { WARNING!! The DayView component is heavily dependent upon the events }
- { being properly sorted. If you change the way this procedure works, }
- { you WILL break the DayView component!!! }
-
- { for greater performance, we don't sort while doing batch updates. }
- if FBatchUpdate > 0 then exit;
-
- for i := 0 to pred(FEventList.Count) do begin
- IndexOfMin := i;
- for j := i to FEventList.Count - 1 do begin
-
- { compare start times of item[j] and item[i] }
- CompResult := Compare(TVpEvent(FEventList.List^[j]).StartTime,
- TVpEvent(FEventList.List^[IndexOfMin]).StartTime);
-
- { if the starttime of j is less than the starttime of i then flip 'em}
- if CompResult < 0 then
- IndexOfMin := j
-
- { if the start times match then sort by end time }
- else if CompResult = 0 then begin
-
- { if the endtime of j is less than the end time of i then flip 'em}
- if (Compare(TVpEvent(FEventList.List^[j]).EndTime,
- TVpEvent(FEventList.List^[IndexOfMin]).EndTime) < 0)
- then
- IndexOfMin := j;
- end;
- end;
-
- Temp := FEventList.List^[i];
- FEventList.List^[i] := FEventList.List^[IndexOfMin];
- FEventList.List^[IndexOfMin] := Temp;
- end;
-
- { Fix object embedded ItemIndexes }
- {
- for i := 0 to pred(FEventList.Count) do begin
- TVpEvent(FEventList.List^[i]).FItemIndex := i;
- end;
- }
-end;
-
-{ Used in the above sort procedure. Compares the start times of the two }
-{ passed in events. }
-function TVpSchedule.Compare(Time1, Time2: TDateTime): Integer;
-begin
- { Compares the value of the Item start dates }
-
- if Time1 < Time2 then
- result := -1
-
- else if Time1 = Time2 then
- result := 0
-
- else
- {Time2 is earlier than Time1}
- result := 1;
-end; *)
-
{Adds the event to the eventlist and returns a pointer to it, or nil on failure}
function TVpSchedule.AddEvent(RecordID: Integer; StartTime,
EndTime: TDateTime): TVpEvent;
begin
- Result := nil;
- if EndTime > StartTime then begin
- Result := TVpEvent.Create(Self);
- try
- Result.Loading := true;
- FEventList.Add(Result);
- Result.RecordID := RecordID;
- Result.StartTime := StartTime;
- Result.EndTime := EndTime;
- Result.Loading := false;
- Sort;
- except
- Result.free;
- raise EFailToCreateEvent.Create;
- end;
+ Result := TVpEvent.Create(Self);
+ try
+ Result.Loading := true;
+ FEventList.Add(Result);
+ Result.RecordID := RecordID;
+ Result.StartTime := StartTime;
+ Result.EndTime := EndTime;
+ Result.Loading := false;
+ Sort;
+ except
+ Result.Free;
+ raise EFailToCreateEvent.Create;
end;
end;
@@ -1590,7 +1622,7 @@ end;
function TVpSchedule.GetEvent(Index: Integer): TVpEvent;
begin
{ Returns an event on success or nil on failure }
- result := FEventList.Items[Index];
+ result := TVpEvent(FEventList[Index]);
end;
function TVpSchedule.RepeatsOn(Event: TVpEvent; Day: TDateTime): Boolean;
@@ -1600,22 +1632,30 @@ var
EventWkDay, EventDayCount: Word;
ThisWkDay, ThisDayCount: Word;
EventJulian, ThisJulian: Word;
+ DayInRepeatRange: Boolean;
begin
result := false;
- if (Event.RepeatCode <> rtNone) and (trunc(Event.RepeatRangeEnd + 1) > now) then
+ DayInRepeatRange := (Day > trunc(Event.StartTime)) and
+ ((Event.RepeatRangeEnd = 0) or (Day < trunc(Event.RepeatRangeEnd) + 1));
+
+ if (Event.RepeatCode <> rtNone) and
+ ((Event.RepeatRangeEnd = 0) or (trunc(Event.RepeatRangeEnd + 1) > now)) then
begin
case Event.RepeatCode of
rtDaily:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange then
+// if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
result := true;
rtWeekly:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange then
+// if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
result := (Trunc(Day) - Trunc(Event.StartTime)) mod 7 = 0;
rtMonthlyByDay:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange then
+ //if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
begin
// Get the year, month and day of the first event in the series
DecodeDate(Event.StartTime, EY, EM, ED);
@@ -1635,7 +1675,8 @@ begin
end;
rtMonthlyByDate:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange then
+// if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
begin
// Get the year, month and day of the first event in the series
DecodeDate(Event.StartTime, EY, EM, ED);
@@ -1646,7 +1687,8 @@ begin
end;
rtYearlyByDay:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange then
+// if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
begin
// Get the julian date of the first event in the series
EventJulian := GetJulianDate(Event.StartTime);
@@ -1657,7 +1699,8 @@ begin
end;
rtYearlyByDate:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange then
+// if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
begin
// Get the year, month and day of the first event in the series.
DecodeDate(Event.StartTime, EY, EM, ED);
@@ -1668,7 +1711,8 @@ begin
end;
rtCustom:
- if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
+ if DayInRepeatRange and (Event.CustomInterval > 0) then
+// if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then
begin
// If the number of elapsed days between the "Day" parameter and
// the event start time is evenly divisible by the event's custom
@@ -1743,8 +1787,6 @@ begin
if Event.AllDayEvent and
(DateInRange(Date, Event.StartTime, Event.EndTime, true) or RepeatsOn(Event, Date))
then
-// if (((trunc(Date) >= trunc(Event.StartTime)) and (trunc(Date) <= trunc(Event.EndTime))) or (RepeatsOn(Event,Date)))
-// and (Event.AllDayEvent) then
EventList.Add(Event);
end;
end;
@@ -2483,12 +2525,12 @@ end;
function TVpContacts.Last: TVpContact;
begin
- result := FContactsList.Items[FContactsList.Count - 1];
+ result := TVpContact(FContactsList[FContactsList.Count - 1]);
end;
function TVpContacts.First: TVpContact;
begin
- result := FContactsList.Items[0];
+ result := TVpContact(FContactsList[0]);
end;
procedure TVpContacts.DeleteContact(Contact: TVpContact);
@@ -2499,7 +2541,7 @@ end;
function TVpContacts.GetContact(Index: Integer): TVpContact;
begin
- result := FContactsList.Items[Index];
+ result := TVpContact(FContactsList[Index]);
end;
procedure TVpContacts.ClearContacts;
@@ -2537,7 +2579,7 @@ begin
if Copy(uppercase(TVpContact(FContactsList[I]).LastName), 1, SearchLength) = SearchStr
then begin
// We found a match, so return it and bail out
- Result := FContactsList[I];
+ Result := TVpContact(FContactsList[I]);
Exit;
end;
end else begin
@@ -2545,7 +2587,7 @@ begin
if Copy(TVpContact(FContactsList[I]).LastName, 1, SearchLength) = SearchStr
then begin
// We found a match, so return it and bail out
- Result := FContactsList[I];
+ Result := TVpContact(FContactsList[I]);
Exit;
end;
end;
@@ -2736,12 +2778,12 @@ end;
function TVpTasks.Last: TVpTask;
begin
- result := FTaskList.Last;
+ result := TVpTask(FTaskList.Last);
end;
function TVpTasks.First: TVpTask;
begin
- result := FTaskList.First;
+ result := TVpTask(FTaskList.First);
end;
function TVpTasks.CountByDay(Date: TDateTime): Integer;
@@ -2833,7 +2875,7 @@ end;
function TVpTasks.GetTask(Index: Integer): TVpTask;
begin
- result := FTaskList.Items[Index];
+ result := TVpTask(FTaskList[Index]);
end;
end.
diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas
index 5962b7a53..9dd2c92ae 100644
--- a/components/tvplanit/source/vpdayview.pas
+++ b/components/tvplanit/source/vpdayview.pas
@@ -367,6 +367,7 @@ type
procedure dvEditInPlace(Sender: TObject);
procedure dvHookUp;
procedure PopupAddEvent(Sender: TObject);
+ procedure PopupAddFromICalFile(Sender: TObject);
procedure PopupDeleteEvent(Sender: TObject);
procedure PopupEditEvent(Sender: TObject);
procedure PopupToday(Sender: TObject);
@@ -530,7 +531,7 @@ uses
DateUtils,
{$ENDIF}
SysUtils, StrUtils, Math, Dialogs,
- VpEvntEditDlg, VpDayViewPainter;
+ VpEvntEditDlg, VpDayViewPainter, VpICal;
(*****************************************************************************)
{ TVpTGInPlaceEdit }
@@ -1119,7 +1120,7 @@ begin
canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit;
FDefaultPopup.Items.Clear;
- if RSPopupAddEvent <> '' then begin
+ if RSPopupAddEvent <> '' then begin // Add
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupAddEvent;
NewItem.OnClick := PopupAddEvent;
@@ -1127,7 +1128,15 @@ begin
FDefaultPopup.Items.Add(NewItem);
end;
- if RSPopupEditEvent <> '' then begin
+ if RSPopupAddEventFromICal <> '' then begin
+ NewItem := TMenuItem.Create(Self);
+ NewItem.Caption := RSPopupAddEventFromICal; // Import from iCal
+ NewItem.OnClick := PopupAddFromICalFile;
+ NewItem.Tag := 0;
+ FDefaultPopup.Items.Add(NewItem);
+ end;
+
+ if RSPopupEditEvent <> '' then begin // Edit
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupEditEvent;
NewItem.Enabled := canEdit;
@@ -1136,7 +1145,7 @@ begin
FDefaultPopup.Items.Add(NewItem);
end;
- if RSPopupDeleteEvent <> '' then begin
+ if RSPopupDeleteEvent <> '' then begin // Delete
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupDeleteEvent;
NewItem.Enabled := canEdit;
@@ -1145,17 +1154,17 @@ begin
FDefaultPopup.Items.Add(NewItem);
end;
- NewItem := TMenuItem.Create(Self);
+ NewItem := TMenuItem.Create(Self); // ----
NewItem.Caption := '-';
FDefaultPopup.Items.Add(NewItem);
- if RSPopupChangeDate <> '' then begin
+ if RSPopupChangeDate <> '' then begin // Change date >
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPopupChangeDate;
NewItem.Tag := 0;
FDefaultPopup.Items.Add(NewItem);
- if RSToday <> '' then begin
+ if RSToday <> '' then begin // Today
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSToday;
NewSubItem.OnClick := PopupToday;
@@ -1163,11 +1172,11 @@ begin
NewItem.Add(NewSubItem);
end;
- NewSubItem := TMenuItem.Create(Self);
+ NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
- if RSYesterday <> '' then begin
+ if RSYesterday <> '' then begin // Yesterday
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSYesterday;
NewSubItem.OnClick := PopupYesterday;
@@ -1175,7 +1184,7 @@ begin
NewItem.Add(NewSubItem);
end;
- if RSTomorrow <> '' then begin
+ if RSTomorrow <> '' then begin // Tomorrow
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSTomorrow;
NewSubItem.OnClick := PopupTomorrow;
@@ -1183,11 +1192,11 @@ begin
NewItem.Add(NewSubItem);
end;
- NewSubItem := TMenuItem.Create(Self);
+ NewSubItem := TMenuItem.Create(Self); // --
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
- if RSNextDay <> '' then begin
+ if RSNextDay <> '' then begin // Next day
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextDay;
NewSubItem.OnClick := PopupNextDay;
@@ -1195,7 +1204,7 @@ begin
NewItem.Add(NewSubItem);
end;
- if RSPrevDay <> '' then begin
+ if RSPrevDay <> '' then begin // Prev day
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevDay;
NewSubItem.OnClick := PopupPrevDay;
@@ -1203,11 +1212,11 @@ begin
NewItem.Add(NewSubItem);
end;
- NewSubItem := TMenuItem.Create(Self);
+ NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
- if RSNextWeek <> '' then begin
+ if RSNextWeek <> '' then begin // Next week
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextWeek;
NewSubItem.OnClick := PopupNextWeek;
@@ -1215,7 +1224,7 @@ begin
NewItem.Add(NewSubItem);
end;
- if RSPrevWeek <> '' then begin
+ if RSPrevWeek <> '' then begin // Prev week
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevWeek;
NewSubItem.OnClick := PopupPrevWeek;
@@ -1223,11 +1232,11 @@ begin
NewItem.Add(NewSubItem);
end;
- NewSubItem := TMenuItem.Create(Self);
+ NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
- if RSNextMonth <> '' then begin
+ if RSNextMonth <> '' then begin // Next month
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextMonth;
NewSubItem.OnClick := PopupNextMonth;
@@ -1235,7 +1244,7 @@ begin
NewItem.Add(NewSubItem);
end;
- if RSPrevMonth <> '' then begin
+ if RSPrevMonth <> '' then begin // Prev Month
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevMonth;
NewSubItem.OnClick := PopupPrevMonth;
@@ -1243,11 +1252,11 @@ begin
NewItem.Add(NewSubItem);
end;
- NewSubItem := TMenuItem.Create(Self);
+ NewSubItem := TMenuItem.Create(Self); // ---
NewSubItem.Caption := '-';
NewItem.Add(NewSubItem);
- if RSNextYear <> '' then begin
+ if RSNextYear <> '' then begin // Next year
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSNextYear;
NewSubItem.OnClick := PopupNextYear;
@@ -1255,7 +1264,7 @@ begin
NewItem.Add(NewSubItem);
end;
- if RSPrevYear <> '' then begin
+ if RSPrevYear <> '' then begin // Prev year
NewSubItem := TMenuItem.Create(Self);
NewSubItem.Caption := RSPrevYear;
NewSubItem.OnClick := PopupPrevYear;
@@ -1274,13 +1283,9 @@ var
StartTime: TDateTime;
EndTime: TDateTime;
begin
- if ReadOnly then
- Exit;
- if not CheckCreateResource then
- Exit;
- if not Assigned (DataStore) then
- Exit;
- if not Assigned (DataStore.Resource) then
+ if ReadOnly or (not CheckCreateResource) or
+ (not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
+ then
Exit;
StartTime := trunc(FDisplayDate + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time;
@@ -1290,12 +1295,58 @@ begin
StartTime,
EndTime
);
-
Repaint;
+
{ edit this new event }
dvSpawnEventEditDialog(True);
end;
-{=====}
+
+procedure TVpDayView.PopupAddFromICalFile(Sender: TObject);
+var
+ dlg: TOpenDialog;
+ ical: TVpICalendar;
+ fn: String;
+ i: Integer;
+ id: Integer;
+ startTime, endTime: TDateTime;
+begin
+ dlg := TOpenDialog.Create(nil);
+ try
+ dlg.Title := RSLoadICalTitle;
+ dlg.Filter := RSICalFilter;
+ dlg.FileName := '';
+ dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist];
+ if dlg.Execute then begin
+ Screen.Cursor := crHourGlass;
+ Application.ProcessMessages;
+ ical := TVpICalendar.Create;
+ try
+ for fn in dlg.Files do begin
+ ical.LoadFromFile(fn);
+ for i := 0 to ical.Count-1 do begin
+ if not (ical[i] is TVpICalEvent) then
+ Continue;
+ startTime := TVpICalEvent(ical[i]).StartTime[false]; // use local times
+ endTime := TVpICalEvent(ical[i]).EndTime[false];
+ if (startTime = 0) and (endTime = 0) then
+ continue;
+ id := DataStore.GetNextID(EventsTableName);
+ FActiveEvent := Datastore.Resource.Schedule.AddEvent(id, starttime, endtime);
+ FActiveEvent.LoadFromICalendar(TVpICalEvent(ical[i]));
+ Datastore.PostEvents;
+ Datastore.NotifyDependents;
+ end;
+ end;
+ Invalidate;
+ finally
+ ical.Free;
+ Screen.Cursor := crDefault;
+ end;
+ end;
+ finally
+ dlg.Free;
+ end;
+end;
procedure TVpDayView.PopupDeleteEvent(Sender: TObject);
begin
diff --git a/components/tvplanit/source/vpevnteditdlg.pas b/components/tvplanit/source/vpevnteditdlg.pas
index cb168e4b2..d82da0048 100644
--- a/components/tvplanit/source/vpevnteditdlg.pas
+++ b/components/tvplanit/source/vpevnteditdlg.pas
@@ -286,6 +286,10 @@ begin
{$ENDIF}
end else
exit;
+ end else
+ if (tStart = tEnd) and not CbAllDay.Checked then begin
+ MessageDlg(RSStartEndTimesEqual, mtError, [mbOK], 0);
+ exit;
end;
ReturnCode := rtCommit;
@@ -608,13 +612,15 @@ end;
procedure TDlgEventEdit.RecurringTypeChange(Sender: TObject);
begin
- if (RecurringType.ItemIndex > 0) and (RepeatUntil.Date <= StartDate.Date) then
+ if (RecurringType.ItemIndex > 0) and
+ (RepeatUntil.Date > 0) and (RepeatUntil.Date <= StartDate.Date)
+ then
RepeatUntil.Date := StartDate.Date + 365;
RecurrenceEndsLbl.Enabled := (RecurringType.ItemIndex > 0);
RepeatUntil.Enabled := RecurrenceEndsLbl.Enabled;
- CustomInterval.Enabled := RecurringType.ItemIndex = 7;
+ CustomInterval.Enabled := RecurringType.ItemIndex = ord(rtCustom);
IntervalLbl.Enabled := CustomInterval.Enabled;
IntervalUpDown.Enabled := CustomInterval.Enabled;
if CustomInterval.Enabled then begin
diff --git a/components/tvplanit/source/vpical.pas b/components/tvplanit/source/vpical.pas
new file mode 100644
index 000000000..867e7b725
--- /dev/null
+++ b/components/tvplanit/source/vpical.pas
@@ -0,0 +1,558 @@
+unit VpICAL;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, VpBaseDataFiles;
+
+type
+ TVpICalendar = class;
+
+ TVpICalItem = class(TVpFileItem)
+ public
+ function GetAttribute(AName: String): string;
+ end;
+
+ TVpICalEntry = class(TVpFileBlock)
+ private
+ FCalendar: TVpICalendar;
+ public
+ constructor Create(ACalendar: TVpICalendar);
+ function FindItem(AKey: String): TVpICalItem;
+ end;
+
+ TVpICalTimeZoneInfo = class(TVpICalEntry)
+ public
+ TimeZoneID: String; // e.g. Europe/Berlin
+ TimeZoneName: String; // e.g. CEST
+ UTCOffset: Double; // add to UTC to get local time
+ end;
+
+ TVpICalAlarm = class(TVpICalEntry)
+ private
+ FDuration: Double; // "SnoozeTime"
+ FRepeat: Integer;
+ FTrigger: Double; // "AlarmAdvance"
+ FAudio: Boolean;
+ FAudioSrc: String;
+ 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;
+ end;
+
+ TVpICalEvent = class(TVpICalEntry)
+ private
+ FSummary: String; // --> Description
+ FDescription: String; // --> Notes
+ FLocation: String;
+ FStartTime: TDateTime;
+ FStartTimeTZ: String;
+ FEndTime: TDateTime;
+ FEndTimeTZ: String;
+ FDuration: double;
+ FRecurrenceFreq: String;
+ FRecurrenceInterval: Integer;
+ FRecurrenceEndDate: TDateTime;
+ FRecurrenceCount: Integer;
+ FRecurrenceByXXX: String;
+ FAlarm: TVpICalAlarm;
+ function GetEndTime(UTC: Boolean): TDateTime;
+ function GetStartTime(UTC: Boolean): TDateTime;
+ public
+ destructor Destroy; override;
+ procedure Analyze; override;
+ 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;
+ 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;
+ end;
+
+ TVpICalendar = class
+ private
+ FEntries: array of TVpICalEntry;
+ FVersion: String;
+ function GetCount: Integer;
+ function GetEntry(AIndex: Integer): TVpICalEntry;
+ protected
+ // Reading
+ procedure LoadFromStrings(const AStrings: TStrings);
+ // Time conversion
+ function ConvertTime(ADateTime: TDateTime; ATimeZoneID: String; ToUTC: Boolean): TDateTime;
+ function LocalTimeToUTC(ADateTime: TDateTime; ATimeZoneID: String): TDateTime;
+ function UTCToLocalTime(ADateTime: TDateTime; ATimeZoneID: String): TDateTime;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure LoadFromFile(const AFileName: String);
+ procedure LoadFromStream(const AStream: TStream);
+ property Count: Integer read GetCount;
+ property Entry[AIndex: Integer]: TVpICalEntry read GetEntry; default;
+ end;
+
+
+implementation
+
+uses
+ VpConst, VpBase;
+
+const
+ ITEMS_DELIMITER = ';';
+
+// Examples: 19970702T160000, or T123000, or 20120101
+function iCalDateTime(AText: String; out IsUTC: Boolean): TDateTime;
+type
+ TDateMask = packed record
+ year: array[1..4] of char;
+ month: array[1..2] of char;
+ day: array[1..2] of char;
+ end;
+ PDateMask = ^TDatemask;
+ TTimeMask = packed record
+ hour: array[1..2] of char;
+ minute: array[1..2] of char;
+ second: array[1..2] of char;
+ end;
+ PTimeMask = ^TTimeMask;
+var
+ shour, smin, ssec: String;
+ yr, mon, day, hr, min, sec: Integer;
+ p: Integer;
+ d: TDate = 0;
+ t: TTime = 0;
+begin
+ Result := 0;
+ if AText = '' then exit;
+
+ if AText = '' then
+ exit;
+
+ if (AText[1] <> 'T') and (Length(AText) >= 8) then begin
+ if TryStrToInt(Copy(AText, 1, 4), yr) and
+ TryStrToInt(Copy(AText, 5, 2), mon) and
+ TryStrToInt(Copy(AText, 7, 2), day)
+ then
+ if not TryEncodeDate(yr, mon, day, d) then exit;
+ end;
+
+ shour := '0';
+ smin := '0';
+ ssec := '0';
+ p := pos('T', AText);
+ if p > 0 then begin
+ if Length(AText) >= p + 2 then shour := Copy(AText, p+1, 2);
+ if Length(AText) >= p + 4 then smin := Copy(AText, p+3, 2);
+ if Length(AText) >= p + 6 then ssec := Copy(AText, p+5, 2);
+ end;
+ if TryStrToInt(shour, hr) and
+ TryStrToInt(smin, min) and
+ TryStrToInt(ssec, sec)
+ then
+ if not TryEncodeTime(hr, min, sec, 0, t) then exit;
+
+ Result := d + t;
+ IsUTC := AText[Length(AText)] = 'Z';
+end;
+
+// Example: PT0H20M0S, or -PT15M, or -P2D
+function iCalDuration(AText: String): Double;
+var
+ isNeg: Boolean = false;
+ inDate: Boolean = true;
+ p: PChar;
+ s: String;
+ n: Integer;
+begin
+ Result := 0;
+ if AText = '' then
+ exit;
+
+ p := @AText[1];
+ if p^ = '-' then begin
+ isNeg := true;
+ inc(p);
+ end;
+ if p^ <> 'P' then // 'P' = "period"
+ exit;
+
+ inc(p);
+ s := '';
+ while true do begin
+ case p^ of
+ #0 : break;
+ 'T': begin
+ inDate := false;
+ s := '';
+ end;
+ 'D': begin
+ Result := Result + StrToInt(s);
+ s := '';
+ end;
+ 'H': begin
+ Result := Result + StrToInt(s)/24;
+ s := '';
+ end;
+ 'M': begin
+ if inDate then
+ // don't know about months... ?!
+ else
+ Result := Result + StrToInt(s)/MinutesInDay;
+ ; // don't know about months... ?!
+ s := '';
+ end;
+ 'S': begin
+ Result := Result + StrToInt(s) / SecondsInDay;
+ s := '';
+ end;
+ '0'..'9': s := s + p^;
+ else raise EVpException.CreateFmt('Invalid character in DURATION string "%s"', [AText]);
+ end;
+ inc(p);
+ end;
+ if isNeg then Result := -Result;
+end;
+
+
+{==============================================================================}
+{ TVpICalItem }
+{==============================================================================}
+
+function TVpICalItem.GetAttribute(AName: String): String;
+begin
+ Result := FAttributes.Values[AName];
+end;
+
+
+{==============================================================================}
+{ TVpICalEntry }
+{==============================================================================}
+
+constructor TVpICalEntry.Create(ACalendar: TVpICalendar);
+begin
+ inherited Create(TVpICalItem);
+ FCalendar := ACalendar;
+end;
+
+function TVpICalEntry.FindItem(AKey: String): TVpICalItem;
+begin
+ Result := TVpICalItem(inherited FindItem(AKey, ''));
+end;
+
+
+{==============================================================================}
+{ TVpICalAlarm }
+{==============================================================================}
+procedure TVpICalAlarm.Analyze;
+var
+ i: Integer;
+ item: TVpICalItem;
+ s: String;
+ isUTC: Boolean;
+begin
+ inherited;
+ for i := 0 to FItems.Count-1 do begin
+ item := TVpICalItem(FItems[i]);
+ case item.Key of
+ 'TRIGGER':
+ FTrigger := ICalDuration(item.Value);
+ 'DURATION' :
+ FDuration := ICalDuration(item.Value);
+ 'REPEAT':
+ FRepeat := StrToInt(item.Value);
+ 'ACTION':
+ FAudio := Uppercase(item.Value) = 'AUDIO';
+ 'ATTACH':
+ if Lowercase(item.GetAttribute('FMTTYPE')) = 'audio' then
+ FAudioSrc := item.Value;
+ end;
+ end;
+end;
+
+
+{==============================================================================}
+{ TVpICalEvent }
+{==============================================================================}
+
+destructor TVpICalEvent.Destroy;
+begin
+ FAlarm.Free;
+ inherited;
+end;
+
+procedure TVpICalEvent.Analyze;
+var
+ i, j: Integer;
+ item: TVpICalItem;
+ L: TStrings;
+ s: String;
+ isUTC: Boolean;
+begin
+ inherited;
+
+ for i := 0 to FItems.Count-1 do begin
+ item := TVpICalItem(FItems[i]);
+ case item.Key of
+ 'SUMMARY':
+ FSummary := item.Value;
+ 'DTSTART':
+ begin
+ FStartTimeTZ := item.GetAttribute('TZID');
+ FStartTime := iCalDateTime(item.Value, isUTC);
+ if not isUTC then
+ FStartTime := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
+ end;
+ 'DTEND':
+ begin
+ FEndTimeTZ := item.GetAttribute('TZID');
+ FEndTime := iCalDateTime(item.Value, isUTC);
+ if not isUTC then
+ FEndTime := FCalendar.LocalTimeToUTC(FEndTime, FEndTimeTZ);
+ end;
+ 'DESCRIPTION':
+ FDescription := item.Value;
+ 'LOCATION':
+ FLocation := item.Value;
+ 'DURATION':
+ FDuration := ICalDuration(item.Value);
+ 'RRULE':
+ begin
+ L := TStringList.Create;
+ try
+ L.StrictDelimiter := true;
+ L.Delimiter := VALUE_DELIMITER; // ';'
+ L.DelimitedText := item.Value;
+ FRecurrenceFreq := L.Values['FREQ'];
+ FRecurrenceInterval := StrToIntDef(L.Values['INTERVAL'], 0);
+ FRecurrenceEndDate := iCalDateTime(L.Values['UNTIL'], isUTC);
+ FRecurrenceCount := StrToIntDef(L.Values['COUNT'], 0);
+ FRecurrenceByXXX := '';
+ for j:=0 to L.Count-1 do begin
+ s := L[j];
+ if pos('BY', s) = 1 then FRecurrenceByXXX := FRecurrenceByXXX + ';' + s;
+ end;
+ if FRecurrenceByXXX <> '' then
+ Delete(FRecurrenceByXXX, 1, 1);
+ finally
+ L.Free;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function TVpICalEvent.GetEndTime(UTC: Boolean): TDateTime;
+begin
+ if FEndTime <> 0 then
+ Result := FEndTime
+ else
+ Result := FStartTime + FDuration;
+ if not UTC then
+ Result := FCalendar.UTCToLocalTime(Result, FEndTimeTZ);
+end;
+
+function TVpICalEvent.GetStartTime(UTC: Boolean): TDateTime;
+begin
+ if UTC then
+ Result := FStartTime
+ else
+ Result := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
+end;
+
+procedure TVpICalEvent.UseAlarm;
+begin
+ FAlarm.Free;
+ FAlarm := TVpICalAlarm.Create(FCalendar);
+end;
+
+
+{==============================================================================}
+{ TVpICalendar }
+{==============================================================================}
+
+constructor TVpICalendar.Create;
+begin
+ inherited;
+ SetLength(FEntries, 0);
+end;
+
+destructor TVpICalendar.Destroy;
+begin
+ SetLength(FEntries, 0);
+ inherited;
+end;
+
+procedure TVpICalendar.Clear;
+var
+ j: Integer;
+begin
+ for j := Count-1 downto 0 do
+ FEntries[j].Free;
+ SetLength(FEntries, 0);
+end;
+
+function TVpICalendar.GetCount: Integer;
+begin
+ Result := Length(FEntries);
+end;
+
+function TVpICalendar.GetEntry(AIndex: Integer): TVpICalEntry;
+begin
+ Result := FEntries[AIndex];
+end;
+
+procedure TVpICalendar.LoadFromFile(const AFilename: String);
+var
+ L: TStrings;
+begin
+ L := TStringList.Create;
+ try
+ L.LoadFromFile(AFileName);
+ LoadFromStrings(L);
+ finally
+ L.Free;
+ end;
+end;
+
+procedure TVpICalendar.LoadFromStream(const AStream: TStream);
+var
+ L: TStrings;
+begin
+ L := TStringList.Create;
+ try
+ L.LoadFromStream(AStream);
+ LoadFromStrings(L);
+ finally
+ L.Free;
+ end;
+end;
+
+procedure TVpICalendar.LoadFromStrings(const AStrings: TStrings);
+const
+ BLOCK_SIZE = 100;
+var
+ p: Integer;
+ itemName: String;
+ itemValue: String;
+ i, n: Integer;
+ s: String;
+ currEntry: TVpICalEntry = nil;
+ oldEntry: TVpICalEntry = nil;
+begin
+ // Clear item list
+ Clear;
+ n := 0;
+ SetLength(FEntries, BLOCK_SIZE);
+ for i:=0 to AStrings.Count-1 do begin
+ s := AStrings[i];
+ if s = '' then
+ continue;
+ p := pos(':', s);
+ if p = 0 then
+ continue;
+ itemName := Uppercase(copy(s, 1, p-1));
+ itemValue := Uppercase(copy(s, p+1, MaxInt));
+ case ItemName of
+ 'BEGIN':
+ begin
+ FEntries[n] := nil;
+ case itemValue of
+ 'VTIMEZONE':
+ begin
+ currEntry := TVpICalTimeZoneInfo.Create(self);
+ FEntries[n] := currEntry;
+ end;
+ 'VEVENT':
+ begin
+ currEntry := TVpICalEvent.Create(self);
+ FEntries[n] := currEntry;
+ end;
+ 'VFREEBUSY':
+ currEntry := nil;
+ 'VTODO':
+ currEntry := nil;
+ 'VJOURNAL':
+ currEntry := nil;
+ 'VALARM':
+ if currEntry is TVpICalEvent then begin
+ oldEntry := currEntry;
+ TVpICalEvent(currEntry).UseAlarm;
+ currEntry := TVpICalEvent(currEntry).Alarm;
+ end;
+ else
+ Continue;
+ end;
+ if FEntries[n] <> nil then begin
+ inc(n);
+ if n mod BLOCK_SIZE = 0 then
+ SetLength(FEntries, Length(FEntries) + BLOCK_SIZE);
+ end;
+ end;
+ 'END':
+ begin
+ if currEntry <> nil then
+ currEntry.Analyze;
+ if oldEntry <> nil then begin
+ currEntry := oldEntry;
+ oldEntry := nil;
+ end else
+ currEntry := nil;
+ end;
+ 'VERSION':
+ FVersion := itemValue;
+ else
+ if currEntry <> nil then
+ currEntry.Add(s);
+ end;
+ end;
+ SetLength(FEntries, n);
+end;
+
+function TVpICalendar.ConvertTime(ADateTime: TDateTime;
+ ATimeZoneID: String; ToUTC: Boolean): TDateTime;
+var
+ offs: Double;
+ i: Integer;
+begin
+ offs := 0;
+ for i:=0 to Count-1 do begin
+ if (FEntries[i] is TVpICalTimeZoneInfo) and
+ (TVpICalTimeZoneInfo(FEntries[i]).TimeZoneID = ATimeZoneID) then
+ begin
+ offs := TVpICalTimeZoneInfo(FEntries[i]).UTCOffset;
+ break;
+ end;
+ end;
+ if ToUTC then
+ Result := ADateTime - offs
+ else
+ Result := ADateTime + offs;
+end;
+
+function TVpICalendar.LocalTimeToUTC(ADateTime: TDateTime;
+ ATimeZoneID: String): TDateTime;
+begin
+ Result := ConvertTime(ADateTime, ATimeZoneID, true);
+end;
+
+function TVpICalendar.UTCToLocalTime(ADateTime: TDateTime;
+ ATimeZoneID: String): TDateTime;
+begin
+ Result := ConvertTime(ADateTime, ATimeZoneID, false);
+end;
+
+end.
+
diff --git a/components/tvplanit/source/vpvcard.pas b/components/tvplanit/source/vpvcard.pas
index 40e195823..89ba0fd6a 100644
--- a/components/tvplanit/source/vpvcard.pas
+++ b/components/tvplanit/source/vpvcard.pas
@@ -205,9 +205,9 @@ begin
'ORG':
FCompany := item.Value;
'ADR':
- if item.Tags.IndexOf('WORK') <> -1 then
+ if item.Attributes.IndexOf('WORK') <> -1 then
VCardAddress(item.Value, FWorkAddress, FWorkCity, FWorkZip, FWorkState, FWorkCountry)
- else if item.Tags.IndexOf('HOME') <> -1 then
+ else if item.Attributes.IndexOf('HOME') <> -1 then
VCardAddress(item.value, FHomeAddress, FHomeCity, FHomeZip, FHomeState, FHomeCountry)
else
if FCompany = '' then
@@ -215,30 +215,30 @@ begin
else
VCardAddress(item.Value, FWorkAddress, FWorkCity, FWorkZip, FWorkState, FWorkCountry);
'EMAIL':
- if (FCompany = '') or (item.Tags.IndexOf('HOME') <> -1) then
+ if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
FHomeEMail := IfThen(FHomeEMail = '', item.Value, FHomeEMail + ITEM_SEPARATOR + item.Value)
else
FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + item.Value);
'TEL':
- if item.Tags.IndexOf('CELL') <> -1 then
+ if item.Attributes.IndexOf('CELL') <> -1 then
FMobile := item.Value
else
- if item.Tags.IndexOf('PAGER') <> -1 then
+ if item.Attributes.IndexOf('PAGER') <> -1 then
FPager := item.Value
else
- if item.Tags.IndexOf('FAX') <> -1 then begin
- if (FCompany = '') or (item.Tags.IndexOf('HOME') <> -1) then
+ if item.Attributes.IndexOf('FAX') <> -1 then begin
+ if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
FHomeFax := item.Value
else
FWorkFax := item.Value;
end else
- if item.Tags.IndexOf('CAR') <> -1 then
+ if item.Attributes.IndexOf('CAR') <> -1 then
FCarPhone := item.Value
else
- if item.Tags.IndexOf('ISDN') <> -1 then
+ if item.Attributes.IndexOf('ISDN') <> -1 then
FISDN := item.Value
else
- if (FCompany = '') or (item.tags.IndexOf('HOME') <> -1) then
+ if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
FHomePhone := IfThen(FHomePhone = '', item.Value, FHomePhone + ITEM_SEPARATOR + item.Value)
else
FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + item.Value);
diff --git a/components/tvplanit/source/vpwavdlg.lfm b/components/tvplanit/source/vpwavdlg.lfm
index dfa531034..25fe9f257 100644
--- a/components/tvplanit/source/vpwavdlg.lfm
+++ b/components/tvplanit/source/vpwavdlg.lfm
@@ -79,8 +79,9 @@ object FrmSoundDialog: TFrmSoundDialog
Left = 0
Height = 25
Top = 4
- Width = 48
+ Width = 77
Anchors = [akTop, akLeft, akBottom]
+ Caption = 'Play'
Glyph.Data = {
DE010000424DDE01000000000000760000002800000024000000120000000100
0400000000006801000000000000000000001000000010000000000000000000
@@ -99,8 +100,9 @@ object FrmSoundDialog: TFrmSoundDialog
6666666666666688666666660000666666666666666666666666666666666666
0000
}
- Layout = blGlyphRight
+ Margin = 4
NumGlyphs = 2
+ Spacing = -1
OnClick = PlayButtonClick
end
object OkBtn: TButton
diff --git a/components/tvplanit/source/vpwavdlg.pas b/components/tvplanit/source/vpwavdlg.pas
index fb4942f5f..9a9169201 100644
--- a/components/tvplanit/source/vpwavdlg.pas
+++ b/components/tvplanit/source/vpwavdlg.pas
@@ -139,11 +139,11 @@ end;
procedure TFrmSoundDialog.FormShow(Sender: TObject);
begin
- AlignOKCancel(OkBtn, CancelBtn, ButtonPanel);
- PlayButton.Width := MulDiv(PlayButton.Height, 3, 2) ;
{$IFDEF NEW_ICONS}
LoadGlyphFromRCDATA(PlayButton.Glyph, 'VpSpeaker', 16, 24, 32);
{$ENDIF}
+ AlignOKCancel(OkBtn, CancelBtn, ButtonPanel);
+ PlayButton.Width := CancelBtn.Width; //MulDiv(PlayButton.Height, 3, 2) ;
end;
function TFrmSoundDialog.GetSelectedFileName: String;
@@ -181,32 +181,6 @@ begin
Label3.Caption := RSNothingToSelectFrom;
Label4.Caption := RSNothingToSelectFrom;
- (*
- DIST := ScaleX(DIST, DesignTimeDPI);
- VDist := ScaleY(VDist, DesignTimeDPI);
- HBORDER := ScaleX(HBORDER, DesignTimeDPI);
-
- OKBtn.Height := ScaleX(OKBtn.Height, DesignTimeDPI);
- CancelBtn.Height := OKBtn.Height;
- ButtonPanel.Height := VDist + OKBtn.Height + VDist;
- OKBtn.Top := VDist;
- CancelBtn.Top := VDist;
- PlayButton.Top := (ButtonPanel.Height - PlayButton.Height) div 2;
-
- OKBtn.Width := Max(GetButtonWidth(OKBtn), GetButtonWidth(CancelBtn));
- CancelBtn.Width := OKBtn.Width;
- {$IFDEF MSWINDOWS}
- CancelBtn.Left := ButtonPanel.ClientWidth - HBORDER - CancelBtn.Width;
- OKBtn.Left := CancelBtn.Left - DIST - OKBtn.Width;
- OKBtn.TabOrder := 0;
- CancelBtn.TabOrder := 1;
- {$ELSE}
- OKBtn.Left := ButtonPanel.ClientWidth - HBORDER - OKBtn.Width;
- CancelBtn.Left := OKBtn.Left - DIST - CancelBtn.Width;
- CancelBtn.TabOrder := 0;
- OKBtn.TabOrder := 1;
- {$ENDIF}
- *)
if DingPath = '' then begin
CBDefault.Checked := true;
if (MediaFolder <> '') and DirectoryExists(MediaFolder) then
@@ -215,6 +189,7 @@ begin
if FileExists(DingPath) then begin
ShellTreeview.Path := ExtractFileDir(DingPath);
ShellListview.Selected := FindFileItem(DingPath);
+ CbDefault.Checked := false;
end else begin
ShellTreeView.Path := MediaFolder;
end;