pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6499 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-06-15 23:40:18 +00:00
parent 6f60c99a2a
commit 8a9d5799a8
16 changed files with 968 additions and 225 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
components/tvplanit/languages/vpsr.de.po
View File

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

18
components/tvplanit/languages/vpsr.fi.po
View File

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

18
components/tvplanit/languages/vpsr.fr.po
View File

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

18
components/tvplanit/languages/vpsr.nl.po
View File

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

18
components/tvplanit/languages/vpsr.po
View File

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

18
components/tvplanit/languages/vpsr.ru.po
View File

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

6
components/tvplanit/laz_visualplanit.lpk
View File

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

6
components/tvplanit/source/include/vpsr.inc
View File

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

71
components/tvplanit/source/vpbasedatafiles.pas
View File

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

264
components/tvplanit/source/vpdata.pas
View File

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

113
components/tvplanit/source/vpdayview.pas
View File

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

10
components/tvplanit/source/vpevnteditdlg.pas
View File

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

558
components/tvplanit/source/vpical.pas Normal file
View File

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

20
components/tvplanit/source/vpvcard.pas
View File

@ -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);

6
components/tvplanit/source/vpwavdlg.lfm
View File

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

31
components/tvplanit/source/vpwavdlg.pas
View File

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