tvplanit: Implement import of events from iCal files (*.ics). Some issues left.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6499 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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:"

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 ""

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"

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:"

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 ""

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 "Время начала:"

components/tvplanit/laz_visualplanit.lpk

@@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
 
 Contributor(s): "/>
     <Version Major="1" Release="11"/>
-    <Files Count="73">
+    <Files Count="74">
       <Item1>
         <Filename Value="source\vpbase.pas"/>
         <UnitName Value="VpBase"/>
@@ -325,6 +325,10 @@ Contributor(s): "/>
         <Filename Value="source\vpbasedatafiles.pas"/>
         <UnitName Value="vpbasedatafiles"/>
       </Item73>
+      <Item74>
+        <Filename Value="source\vpical.pas"/>
+        <UnitName Value="VpICAL"/>
+      </Item74>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>

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';

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;
+    function FindItem(AKey, Attributes: String): TVpFileItem;
-    property Value[AKey: String; const ATags: String]: String read GetValue;
+    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);
+  GetParts(FRaw, FKey, attrArray, FValue);
-  FTags := TStringList.Create;
+  FAttributes := TStringList.Create;
-  for i:=Low(tagarray) to High(tagarray) do
+  for i:=Low(attrArray) to High(attrArray) do
-    FTags.Add(tagarray[i]);
+    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 ';'
+      Attr := Split(keypart, KEY_DELIMITER);   // Split at ';'
-    for i:=Low(ATags) to High(ATags) do
+    for i:=Low(Attr) to High(Attr) do
-      if ATags[i] = 'QUOTED-PRINTABLE' then begin
+      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
+{ Finds the item with the specified key and attributes.
-  by a semicolon. If a tag name begins with a '-' then it must NOT be present.
+  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;
+  attrArray: TStringArray;
-  tag, notTag: String;
+  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
+      ok := true;                  // No attr specified --> use first item found
-      if Length(tagArr) > 0 then begin
+      if Length(attrArray) > 0 then begin
-        for tag in tagArr do begin
+        for attr in attrArray do begin
-          if tag[1] = '-' then
+          if attr[1] = '-' then
-            notTag := Copy(tag, 2, MaxInt);
+            notAttr := Copy(attr, 2, MaxInt)
-          if item.Tags.IndexOf(tag) = -1 then begin  // Tag not found --> reject
+          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

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, VpICal;
-  VpSR, VpVCard;
 
 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;
+  Result := TVpEvent.Create(Self);
-  if EndTime > StartTime then begin
+  try
-    Result := TVpEvent.Create(Self);
+    Result.Loading := true;
-    try
+    FEventList.Add(Result);
-      Result.Loading := true;
+    Result.RecordID := RecordID;
-      FEventList.Add(Result);
+    Result.StartTime := StartTime;
-      Result.RecordID := RecordID;
+    Result.EndTime := EndTime;
-      Result.StartTime := StartTime;
+    Result.Loading := false;
-      Result.EndTime := EndTime;
+    Sort;
-      Result.Loading := false;
+  except
-      Sort;
+    Result.Free;
-    except
+    raise EFailToCreateEvent.Create;
-      Result.free;
-      raise EFailToCreateEvent.Create;
-    end;
   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.

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
+  if ReadOnly or (not CheckCreateResource) or
-    Exit;
+     (not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
-  if not CheckCreateResource then
+  then
-    Exit;
-  if not Assigned (DataStore) then
-    Exit;
-  if 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

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

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.
+

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 item.Attributes.IndexOf('FAX') <> -1 then begin
-          if (FCompany = '') or (item.Tags.IndexOf('HOME') <> -1) then
+          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);

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

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;