From 5920c0bc2f5c6e66ad84237fec53605345efb119 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 6 Sep 2016 19:59:25 +0000 Subject: [PATCH] tvplanit: Use TList sorting method for sorting resources, events, tasks and contacts. Cosmetic changes. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5132 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpdata.pas | 968 ++++++++++---------------- 1 file changed, 363 insertions(+), 605 deletions(-) diff --git a/components/tvplanit/source/vpdata.pas b/components/tvplanit/source/vpdata.pas index 94a4224bd..e133ef967 100644 --- a/components/tvplanit/source/vpdata.pas +++ b/components/tvplanit/source/vpdata.pas @@ -70,20 +70,20 @@ type TVpTask = class; TVpResources = class - protected{private} + private FOwner: TObject; - FResourceList: TList; - function Compare(Descr1, Descr2: string): Integer; - function GetItem(Index: Integer): TVpResource; function GetCount: Integer; + function GetItem(Index: Integer): TVpResource; + protected + FResourceList: TList; function NextResourceID: Integer; public constructor Create(Owner: TObject); destructor Destroy; override; function AddResource(ResID: Integer): TVpResource; + procedure ClearResources; function FindResourceByName(AName : string) : TVpResource; function GetResource(ID: Integer): TVpResource; - procedure ClearResources; procedure RemoveResource(Resource: TVpResource); procedure Sort; property Count: Integer read GetCount; @@ -92,19 +92,18 @@ type end; TVpResource = class - protected{private} - FLoading : Boolean; + private FOwner: TVpResources; - FActive: Boolean; { Internal flag used to determine whether to display } - { this resource } -// FItemIndex: integer; FChanged: Boolean; FDeleted: Boolean; FEventsDirty: Boolean; FContactsDirty: Boolean; + FLoading : Boolean; FTasksDirty: Boolean; FSchedule: TVpSchedule; FTasks: TVpTasks; + FContacts: TVpContacts; + FActive: Boolean; // Internal flag whether to display this resource FNotes: string; FDescription: string; { reserved for your use } @@ -119,16 +118,15 @@ type FUserField8: string; FUserField9: string; FResourceID: Integer; - FContacts: TVpContacts; function GetSchedule: TVpSchedule; procedure SetChanged(Value: Boolean); + procedure SetContacts(const Value: TVpContacts); procedure SetDeleted(Value: Boolean); procedure SetDescription(const Value: string); + procedure SetNotes(const Value: string); procedure SetResourceID(const Value: Integer); procedure SetSchedule(const Value: TVpSchedule); procedure SetTasks(const Value: TVpTasks); - procedure SetNotes(const Value: string); - procedure SetContacts(const Value: TVpContacts); public constructor Create(Owner: TVpResources); destructor Destroy; override; @@ -166,26 +164,26 @@ type end; TVpSchedule = class - protected{private} - FOwner : TVpResource; + private + FOwner: TVpResource; + function GetCount: Integer; + protected FEventList: TList; FBatchUpdate: Integer; - function Compare(Time1, Time2: TDateTime): Integer; // function FindTimeSlot(StartTime, EndTime: TDateTime): Boolean; - function GetCount: Integer; public constructor Create(Owner: TVpResource); destructor Destroy; override; function AddEvent(RecordID: Integer; StartTime, EndTime: TDateTime): TVpEvent; + procedure AllDayEventsByDate(Date: TDateTime; EventList: TList); + procedure BatchUpdate(Value: Boolean); + procedure ClearEvents; procedure DeleteEvent(Event: TVpEvent); + function EventCountByDay(Value: TDateTime): Integer; + procedure EventsByDate(Date: TDateTime; EventList: TList); function GetEvent(Index: Integer): TVpEvent; function RepeatsOn(Event: TVpEvent; Day: TDateTime): Boolean; procedure Sort; - procedure ClearEvents; - procedure BatchUpdate(Value: Boolean); - function EventCountByDay(Value: TDateTime): Integer; - procedure EventsByDate(Date: TDateTime; EventList: TList); - procedure AllDayEventsByDate(Date: TDateTime; EventList: TList); property Owner: TVpResource read FOwner; property EventCount: Integer read GetCount; end; @@ -193,9 +191,8 @@ type { TVpEvent } TVpEvent = class - protected{private} + private FOwner: TVpSchedule; -// FItemIndex: Integer; FChanged: Boolean; FDeleted: Boolean; FLoading: Boolean; @@ -254,39 +251,38 @@ type property Loading : Boolean read FLoading write FLoading; property Changed: Boolean read FChanged write SetChanged; property Deleted: Boolean read FDeleted write SetDeleted; -// property ItemIndex: Integer read FItemIndex; {$ifdef WITHRTTI} published {$else} public {$endif} - property RecordID : Integer read FRecordID write SetRecordID; + property RecordID: Integer read FRecordID write SetRecordID; property DingPath: string read FDingPath write SetDingPath; property AlarmWavPath: string read FDingPath write SetDingPath; deprecated 'Use "DingPath" instead'; property AlertDisplayed: Boolean read FAlertDisplayed write FAlertDisplayed; property AllDayEvent: Boolean read FAllDayEvent write SetAllDayEvent; - property StartTime : TDateTime read FStartTime write SetStartTime; - property EndTime : TDateTime read FEndTime write SetEndTime; - property Description : string read FDescription write SetDescription; - property Notes : string read FNotes write SetNotes; + property StartTime: TDateTime read FStartTime write SetStartTime; + property EndTime: TDateTime read FEndTime write SetEndTime; + property Description: string read FDescription write SetDescription; + property Notes: string read FNotes write SetNotes; property Note: String read FNotes write SetNotes; deprecated 'Use "Notes" instead'; - property Category : Integer read FCategory write SetCategory; - property AlarmSet : Boolean read FAlarmSet write SetAlarmSet; + property Category: Integer read FCategory write SetCategory; + property AlarmSet: Boolean read FAlarmSet write SetAlarmSet; property AlarmAdvance: Integer read FAlarmAdv write SetAlarmAdv; - property AlarmAdv : Integer read FAlarmAdv write SetAlarmAdv; deprecated 'Use "AlarmAdvance" instead'; + property AlarmAdv: Integer read FAlarmAdv write SetAlarmAdv; deprecated 'Use "AlarmAdvance" instead'; property Location: string read FLocation write SetLocation; { 0=Minutes, 1=Hours, 2=Days } property AlarmAdvanceType: TVpAlarmAdvType read FAlarmAdvType write SetAlarmAdvType; - property AlarmAdvType : TVpAlarmAdvType read FAlarmAdvType write SetAlarmAdvType; deprecated 'Use "AlarmAdvanceType" instead'; - property SnoozeTime : TDateTime read FSnoozeTime write SetSnoozeTime; + property AlarmAdvType: TVpAlarmAdvType read FAlarmAdvType write SetAlarmAdvType; deprecated 'Use "AlarmAdvanceType" instead'; + property SnoozeTime: TDateTime read FSnoozeTime write SetSnoozeTime; { rtNone, rtDaily, rtWeekly, rtMonthlyByDay, rtMonthlyByDate, } { rtYearlyByDay, rtYearlyByDate, rtCustom } property RepeatCode: TVpRepeatType read FRepeatCode write SetRepeatCode; property RepeatRangeEnd: TDateTime read FRepeatRangeEnd write SetRepeatRangeEnd; { Custom Repeat Interval in seconds } { is Zero if IntervalCode <> 7 } - property CustomInterval : Integer read FCustInterval write SetCustInterval; - property CustInterval : Integer read FCustInterval write SetCustInterval; deprecated 'Use "CustomInterval" instead'; + property CustomInterval: Integer read FCustInterval write SetCustInterval; + property CustInterval: Integer read FCustInterval write SetCustInterval; deprecated 'Use "CustomInterval" instead'; { Reserved for your use } property UserField0: string read FUserField0 write FUserField0; property UserField1: string read FUserField1 write FUserField1; @@ -301,8 +297,9 @@ type end; TVpTasks = class - protected{private} + private FOwner: TVpResource; + protected FTaskList: TList; FBatchUpdate: Integer; public @@ -310,26 +307,24 @@ type destructor Destroy; override; function AddTask(RecordID: Integer): TVpTask; procedure BatchUpdate(value: Boolean); - function Compare(Item1, Item2: TVpTask): Integer; - function Count : Integer; + procedure ClearTasks; + function Count: Integer; function CountByDay(Date: TDateTime): Integer; + procedure DeleteTask(Task: TVpTask); + function First: TVpTask; + function FirstByDay(Date: TDateTime): TVpTask; function IndexOf(ATask: TVpTask): Integer; function Last: TVpTask; function LastByDay(Date: TDateTime): TVpTask; - function First: TVpTask; - function FirstByDay(Date: TDateTime): TVpTask; procedure Sort; - - procedure DeleteTask(Task: TVpTask); function GetTask(Index: Integer): TVpTask; - procedure ClearTasks; property Owner: TVpREsource read FOwner; end; TVpTask = class - protected{private} - FLoading: Boolean; + private FOwner: TVpTasks; + FLoading: Boolean; FChanged: Boolean; FDeleted: Boolean; FItemIndex: Integer; @@ -342,7 +337,6 @@ type FCompletedOn: TDateTIme; FRecordID: Integer; FDueDate: TDateTime; - { reserved for your use } FUserField0: string; FUserField1: string; @@ -364,6 +358,7 @@ type procedure SetDetails(const Value: string); procedure SetDueDate(const Value: TDateTime); procedure SetPriority(const Value: Integer); + protected function IsOverdue: Boolean; public constructor Create(Owner: TVpTasks); @@ -404,91 +399,87 @@ type end; TVpContacts = class + private + FOwner: TVpResource; + FContactsList: TList; + FContactSort: TVpContactSort; + procedure SetContactSort(const v: TVpContactSort); protected - FOwner : TVpResource; - FContactsList : TList; - FBatchUpdate : Integer; - FContactSort : TVpContactSort; - function Compare(Item1, Item2: TVpContact): Integer; - procedure SetContactSort (const v : TVpContactSort); + FBatchUpdate: Integer; public constructor Create(Owner: TVpResource); destructor Destroy; override; - procedure BatchUpdate(Value: Boolean); - function Count: Integer; - function Last:TVpContact; - function First: TVpContact; - procedure Sort; function AddContact(RecordID: Integer): TVpContact; - procedure DeleteContact(Contact: TVpContact); - function GetContact(Index: Integer): TVpContact; + procedure BatchUpdate(Value: Boolean); procedure ClearContacts; + function Count: Integer; + procedure DeleteContact(Contact: TVpContact); + function First: TVpContact; + function FindContactByName(const Name: string; + CaseInsensitive: Boolean = True): TVpContact; + function FindContactIndexByName(const Name: string; + CaseInsensitive: Boolean = True): Integer; + function GetContact(Index: Integer): TVpContact; + function Last:TVpContact; + procedure Sort; - { new functions introduced to support the new buttonbar component } - function FindContactByName(const Name: string; - CaseInsensitive: Boolean = True): TVpContact; - function FindContactIndexByName(const Name: string; - CaseInsensitive: Boolean = True): Integer; - - property ContactsList: TList read FContactsList; - property ContactSort : TVpContactSort - read FContactSort write SetContactSort default csLastFirst; + property ContactsList: TList + read FContactsList; + property ContactSort: TVpContactSort + read FContactSort write SetContactSort default csLastFirst; end; TVpContact = class - protected{private} - FLoading : Boolean; - FOwner : TVpContacts; - FChanged : Boolean; -// FItemIndex : Integer; - FRecordID : Integer; - FDeleted : Boolean; - FPosition : string; - FLastName : string; - FFirstName : string; - FBirthDate : TDateTime; - FAnniversary : TDateTime; - FTitle : string; - FCompany : string; - FEmail : string; - FPhone1 : string; - FPhone2 : string; - FPhone3 : string; - FPhone4 : string; - FPhone5 : string; - FPhoneType1 : integer; - FPhoneType2 : integer; - FPhoneType3 : integer; - FPhoneType4 : integer; - FPhoneType5 : integer; - FAddress : string; - FCity : string; - FState : string; - FZip : string; - FCountry : string; - FNotes : string; - FPrivateRec : boolean; - FCategory : integer; - FCustom1 : string; - FCustom2 : string; - FCustom3 : string; - FCustom4 : string; + FOwner: TVpContacts; + FLoading: Boolean; + FChanged: Boolean; + FRecordID: Integer; + FDeleted: Boolean; + FPosition: string; + FLastName: string; + FFirstName: string; + FBirthDate: TDateTime; + FAnniversary: TDateTime; + FTitle: string; + FCompany: string; + FEmail: string; + FPhone1: string; + FPhone2: string; + FPhone3: string; + FPhone4: string; + FPhone5: string; + FPhoneType1: integer; + FPhoneType2: integer; + FPhoneType3: integer; + FPhoneType4: integer; + FPhoneType5: integer; + FAddress: string; + FCity: string; + FState: string; + FZip: string; + FCountry: string; + FNotes: string; + FPrivateRec: boolean; + FCategory: integer; + FCustom1: string; + FCustom2: string; + FCustom3: string; + FCustom4: string; { reserved for your use } - FUserField0 : string; - FUserField1 : string; - FUserField2 : string; - FUserField3 : string; - FUserField4 : string; - FUserField5 : string; - FUserField6 : string; - FUserField7 : string; - FUserField8 : string; - FUserField9 : string; - + FUserField0: string; + FUserField1: string; + FUserField2: string; + FUserField3: string; + FUserField4: string; + FUserField5: string; + FUserField6: string; + FUserField7: string; + FUserField8: string; + FUserField9: string; procedure SetAddress(const Value: string); procedure SetBirthDate(Value: TDateTime); procedure SetAnniversary(Value: TDateTime); - procedure SetCategory( Value: integer); + procedure SetCategory(Value: integer); procedure SetChanged(Value: Boolean); procedure SetCity(const Value: string); procedure SetCompany(const Value: string); @@ -520,71 +511,133 @@ type public constructor Create(Owner: TVpContacts); destructor Destroy; override; - function FullName : string; - property Loading : Boolean read FLoading write FLoading; - property Changed : Boolean read FChanged write SetChanged; - property Deleted : Boolean read FDeleted write SetDeleted; - property Owner : TVpContacts read FOwner write FOwner; + function FullName: string; + property Loading: Boolean read FLoading write FLoading; + property Changed: Boolean read FChanged write SetChanged; + property Deleted: Boolean read FDeleted write SetDeleted; + property Owner: TVpContacts read FOwner write FOwner; {$ifdef WITHRTTI} published {$else} public {$endif} - property RecordID : Integer read FRecordID write SetRecordID; - property Job_Position : string read FPosition write SetPosition; - property Position : string read FPosition write SetPosition; deprecated 'Use "Job_Position" instead'; - property FirstName : string read FFirstName write SetFirstName; - property LastName : string read FLastName write SetLastName; - property BirthDate : TDateTime read FBirthdate write SetBirthdate; - property Anniversary : TDateTime read FAnniversary write SetAnniversary; - property Title : string read FTitle write SetTitle; - property Company : string read FCompany write SetCompany; - property EMail : string read FEmail write SetEMail; - property Phone1 : string read FPhone1 write SetPhone1; - property Phone2 : string read FPhone2 write SetPhone2; - property Phone3 : string read FPhone3 write SetPhone3; - property Phone4 : string read FPhone4 write SetPhone4; - property Phone5 : string read FPhone5 write SetPhone5; - property PhoneType1 : integer read FPhoneType1 write SetPhoneType1; - property PhoneType2 : integer read FPhoneType2 write SetPhoneType2; - property PhoneType3 : integer read FPhoneType3 write SetPhoneType3; - property PhoneType4 : integer read FPhoneType4 write SetPhoneType4; - property PhoneType5 : integer read FPhoneType5 write SetPhoneType5; - property Address : string read FAddress write SetAddress; - property City : string read FCity write SetCity; - property State : string read FState write SetState; - property Zip : string read FZip write SetZip; - property Country : string read FCountry write SetCountry; - property Note : string read FNotes write SetNotes; deprecated 'Use "Notes" instead'; - property Notes : string read FNotes write SetNotes; - property Category : integer read FCategory write SetCategory; - property Custom1 : string read FCustom1 write SetCustom1; - property Custom2 : string read FCustom2 write SetCustom2; - property Custom3 : string read FCustom3 write SetCustom3; - property Custom4 : string read FCustom4 write SetCustom4; + property RecordID: Integer read FRecordID write SetRecordID; + property Job_Position: string read FPosition write SetPosition; + property Position: string read FPosition write SetPosition; deprecated 'Use "Job_Position" instead'; + property FirstName: string read FFirstName write SetFirstName; + property LastName: string read FLastName write SetLastName; + property BirthDate: TDateTime read FBirthdate write SetBirthdate; + property Anniversary: TDateTime read FAnniversary write SetAnniversary; + property Title: string read FTitle write SetTitle; + property Company: string read FCompany write SetCompany; + property EMail: string read FEmail write SetEMail; + property Phone1: string read FPhone1 write SetPhone1; + property Phone2: string read FPhone2 write SetPhone2; + property Phone3: string read FPhone3 write SetPhone3; + property Phone4: string read FPhone4 write SetPhone4; + property Phone5: string read FPhone5 write SetPhone5; + property PhoneType1: integer read FPhoneType1 write SetPhoneType1; + property PhoneType2: integer read FPhoneType2 write SetPhoneType2; + property PhoneType3: integer read FPhoneType3 write SetPhoneType3; + property PhoneType4: integer read FPhoneType4 write SetPhoneType4; + property PhoneType5: integer read FPhoneType5 write SetPhoneType5; + property Address: string read FAddress write SetAddress; + property City: string read FCity write SetCity; + property State: string read FState write SetState; + property Zip: string read FZip write SetZip; + property Country: string read FCountry write SetCountry; + property Note: string read FNotes write SetNotes; deprecated 'Use "Notes" instead'; + property Notes: string read FNotes write SetNotes; + property Category: integer read FCategory write SetCategory; + property Custom1: string read FCustom1 write SetCustom1; + property Custom2: string read FCustom2 write SetCustom2; + property Custom3: string read FCustom3 write SetCustom3; + property Custom4: string read FCustom4 write SetCustom4; { Reserved for your use } - property UserField0 : string read FUserField0 write FUserField0; - property UserField1 : string read FUserField1 write FUserField1; - property UserField2 : string read FUserField2 write FUserField2; - property UserField3 : string read FUserField3 write FUserField3; - property UserField4 : string read FUserField4 write FUserField4; - property UserField5 : string read FUserField5 write FUserField5; - property UserField6 : string read FUserField6 write FUserField6; - property UserField7 : string read FUserField7 write FUserField7; - property UserField8 : string read FUserField8 write FUserField8; - property UserField9 : string read FUserField9 write FUserField9; + property UserField0: string read FUserField0 write FUserField0; + property UserField1: string read FUserField1 write FUserField1; + property UserField2: string read FUserField2 write FUserField2; + property UserField3: string read FUserField3 write FUserField3; + property UserField4: string read FUserField4 write FUserField4; + property UserField5: string read FUserField5 write FUserField5; + property UserField6: string read FUserField6 write FUserField6; + property UserField7: string read FUserField7 write FUserField7; + property UserField8: string read FUserField8 write FUserField8; + property UserField9: string read FUserField9 write FUserField9; end; - -function CompareEventsByTimeOnly(P1, P2: Pointer): Integer; +function CompareEventsByTimeOnly(Item1, Item2: Pointer): Integer; implementation uses Math, - VpException, VpMisc; + VpException, VpConst, VpMisc; +const + TIME_EPS = 1.0 / SecondsInDay; // Epsilon for comparing times + +{ Compare function for sorting resources: Compares the resource descriptions } +function CompareResources(Item1, Item2: Pointer): Integer; +begin + Result := CompareText(TVpResource(Item1).Description, TVpResource(Item2).Description); + // CompareTEXT --> ignore case +end; + +{ Compare function for sorting events: Compares the start times of two events. + If the times are equal (within 1 seconds) then end times are compared. } +function CompareEvents(Item1, Item2: Pointer): Integer; +begin + if SameValue(TVpEvent(Item1).StartTime, TVpEvent(Item2).StartTime, TIME_EPS) then + Result := CompareValue(TVpEvent(Item1).EndTime, TVpEvent(Item2).EndTime) + else + Result := CompareValue(TVpEvent(Item1).StartTime, TVpEvent(Item2).StartTime); +end; + +{ Call back function for TList.Sort. Sorting of events by time only, date part + is ignored. } +function CompareEventsByTimeOnly(Item1, Item2: Pointer): Integer; +var + event1, event2: TVpEvent; +begin + event1 := TVpEvent(Item1); + event2 := TVpEvent(Item2); + Result := CompareValue(frac(event1.StartTime), frac(event2.StartTime)); + if Result = 0 then + Result := CompareValue(frac(event1.EndTime), frac(event2.EndTime)); +end; + +{ Compare function for sorting tasks: Compares the due dates. If they are equal + then the task descriptions are used. } +function CompareTasks(Item1, Item2: Pointer): Integer; +begin + if SameValue(TVpTask(Item1).DueDate, TVpTask(Item2).DueDate, TIME_EPS) then + Result := CompareText(TVpTask(Item1).Description, TVpTask(Item2).Description) + else + Result := CompareValue(TVpTask(Item1).DueDate, TVpTask(Item2).DueDate); +end; + +{ Compare function for sorting contacts: Compare the first names of the contacts, + if equal compare the last names. } +function CompareContacts_FirstLast(Item1, Item2: Pointer): Integer; +begin + Result := CompareText(TVpContact(Item1).FirstName, TVpContact(Item2).Firstname); + if Result = 0 then + Result := CompareText(TVpContact(Item1).LastName, TVpContact(Item2).LastName); +end; + +{ Compare function for sorting contacts: Compare the last names of the contacts, + if equal compare the first names. } +function CompareContacts_LastFirst(Item1, Item2: Pointer): Integer; +begin + Result := CompareText(TVpContact(Item1).LastName, TVpContact(Item2).Lastname); + if Result = 0 then + Result := CompareText(TVpContact(Item1).FirstName, TVpContact(Item2).FirstName); +end; + + +(*****************************************************************************) { TVpResources } (*****************************************************************************) @@ -594,7 +647,6 @@ begin FOwner := Owner; FResourceList := TList.Create; end; -{=====} destructor TVpResources.Destroy; begin @@ -602,19 +654,16 @@ begin FResourceList.Free; inherited; end; -{=====} function TVpResources.GetItem(Index: Integer): TVpResource; begin - result := TVpResource(FResourceList.List^[Index]); + Result := TVpResource(FResourceList.List^[Index]); end; -{=====} function TVpResources.GetCount: Integer; begin - result := FResourceList.Count; + Result := FResourceList.Count; end; -{=====} function TVpResources.NextResourceID: Integer; var @@ -629,19 +678,17 @@ begin and (ID <= Res.ResourceID) then Inc(ID); end; - result := ID; + Result := ID; end; -{=====} function TVpResources.AddResource(ResID: Integer): TVpResource; var - Resource : TVpResource; + Resource: TVpResource; begin Resource := TVpResource.Create(Self); try Resource.Loading := true; FResourceList.Add(Resource); -// Resource.FItemIndex := FResourceList.Add(Resource); Resource.ResourceID := ResID; Resource.ResourceActive := true; Resource.Loading := false; @@ -651,22 +698,19 @@ begin raise EFailToCreateResource.Create; end; end; -{=====} function TVpResources.FindResourceByName (AName : string) : TVpResource; var - i : Integer; - + i: Integer; begin Result := nil; AName := LowerCase(AName); for i := 0 to Count - 1 do - if LowerCase (Items[i].Description) = AName then begin + if LowerCase(Items[i].Description) = AName then begin Result := Items[i]; Break; end; end; -{=====} function TVpResources.GetResource(ID: integer): TVpResource; var @@ -682,76 +726,29 @@ begin end; end; end; -{=====} procedure TVpResources.ClearResources; begin while FResourceList.Count > 0 do TVpResource(FResourceList.Last).Free; end; -{=====} procedure TVpResources.RemoveResource(Resource: TVpREsource); begin - { The resource removes the list entry in its destructor } + // The resource removes the list entry in its destructor Resource.Free; end; -{=====} procedure TVpResources.Sort; -var - i, j: integer; - IndexOfMin: integer; - Temp: pointer; - CompResult: integer; {Comparison Result} begin - for i := 0 to pred(FResourceList.Count) do begin - IndexOfMin := i; - for j := i to FResourceList.Count - 1 do begin - - { compare description item[j] and item[i] } - CompResult := Compare(TVpResource(FResourceList.List^[j]).Description, - TVpResource(FResourceList.List^[IndexOfMin]).Description); - - { if the description of j is less than the description of i then flip 'em} - if CompResult < 0 then - IndexOfMin := j; - end; - - Temp := FResourceList.List^[i]; - FResourceList.List^[i] := FResourceList.List^[IndexOfMin]; - FResourceList.List^[IndexOfMin] := Temp; - end; - (* - { Fix object embedded ItemIndexes } - for i := 0 to pred(FResourceList.Count) do begin - TVpResource(FResourceList.List^[i]).FItemIndex := i; - end; - *) + FResourceList.Sort(@CompareResources); end; -{=====} - -{ Used in the above sort procedure. Compares the descriptions of the two } -{ passed in events. } -function TVpResources.Compare(Descr1, Descr2: string): Integer; -begin - { Compares the value of the Item descriptions } - - if Descr1 < Descr2 then - result := -1 - - else if Descr1 = Descr2 then - result := 0 - - else - {Descr2 is less than Descr1} - result := 1; -end; -{=====} +(*****************************************************************************) { TVpResource } (*****************************************************************************) + constructor TVpResource.Create(Owner: TVpResources); begin inherited Create; @@ -762,7 +759,6 @@ begin // FItemIndex := -1; FActive := false; end; -{=====} destructor TVpResource.Destroy; var @@ -781,20 +777,14 @@ begin idx := FOwner.FResourceList.IndexOf(self); if idx > -1 then FOwner.FResourceList.Delete(idx); end; - { - FOwner.FResourceList.Delete(idx); - if (FItemIndex > -1) and (FOwner <> nil) then - FOwner.FResourceList.Delete(FItemIndex); - } + inherited; end; -{=====} procedure TVpResource.SetContacts(const Value: TVpContacts); begin FContacts := Value; end; -{=====} procedure TVpResource.SetChanged(Value: Boolean); begin @@ -804,7 +794,6 @@ begin FChanged := Value; end; end; -{=====} procedure TVpResource.SetDeleted(Value: Boolean); begin @@ -813,7 +802,6 @@ begin Changed := true; end; end; -{=====} function TVpResource.GetSchedule: TVpSchedule; begin @@ -821,7 +809,6 @@ begin FSchedule := TVpSchedule.Create(self); result := FSchedule; end; -{=====} procedure TVpResource.SetDescription(const Value: string); begin @@ -835,7 +822,6 @@ begin FChanged := true; end; end; -{=====} procedure TVpResource.SetNotes(const Value: string); begin @@ -847,19 +833,17 @@ procedure TVpResource.SetResourceID(const Value: Integer); begin FResourceID := Value; end; -{=====} procedure TVpResource.SetSchedule(const Value: TVpSchedule); begin FSchedule := Value; end; -{=====} procedure TVpResource.SetTasks(const Value: TVpTasks); begin FTasks := Value; end; -{=====} + { TVpEvent } (*****************************************************************************) @@ -869,10 +853,8 @@ begin FAlertDisplayed := false; FOwner := Owner; FChanged := false; -// FItemIndex := -1; FSnoozeTime := 0.0; end; -{=====} destructor TVpEvent.Destroy; var @@ -880,17 +862,10 @@ var begin if (FOwner <> nil) then begin idx := FOwner.FEventList.IndexOf(self); - FOwner.FEventList.Delete(idx); + if idx > -1 then FOwner.FEventList.Delete(idx); end; - { - if (FOwner <> nil) and (FItemIndex <> -1) then begin - FOwner.FEventList.Delete(FItemIndex); - FOwner.Sort; - end; - } inherited; end; -{=====} procedure TVpEvent.SetAlarmAdv(Value: Integer); begin @@ -899,7 +874,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetAlarmAdvType(Value: TVpAlarmAdvType); begin @@ -908,7 +882,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetSnoozeTime(Value: TDateTime); begin @@ -917,7 +890,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetAlarmSet(Value: Boolean); begin @@ -926,7 +898,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetCategory(Value: Integer); begin @@ -935,7 +906,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetDescription(const Value: string); begin @@ -944,7 +914,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetEndTime(Value: TDateTime); begin @@ -953,7 +922,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetAllDayEvent(Value: Boolean); begin @@ -963,18 +931,7 @@ begin Changed := true; end; end; -{=====} -(* -procedure TVpEvent.SetItemIndex(Value: Integer); -begin - if Value <> FItemIndex then begin - FItemIndex := Value; - Changed := true; - end; -end; -{=====} - *) procedure TVpEvent.SetChanged(Value: Boolean); begin if Loading then Exit; @@ -985,7 +942,6 @@ begin Owner.FOwner.EventsDirty := true; end; end; -{=====} procedure TVpEvent.SetDeleted(Value: Boolean); begin @@ -994,7 +950,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetDingPath(Value: string); begin @@ -1003,7 +958,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetLocation(const Value: String); begin @@ -1012,7 +966,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetNotes(const Value: string); begin @@ -1021,7 +974,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetRecordID(Value: Integer); begin @@ -1030,7 +982,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetRepeatCode(Value: TVpRepeatType); begin @@ -1043,7 +994,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetRepeatRangeEnd(Value: TDateTime); begin @@ -1052,7 +1002,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetCustInterval(Value: Integer); begin @@ -1064,7 +1013,6 @@ begin Changed := true; end; end; -{=====} procedure TVpEvent.SetStartTime(Value: TDateTime); begin @@ -1073,10 +1021,12 @@ begin Changed := true; end; end; -{=====} + +(*****************************************************************************) { TVpSchedule } (*****************************************************************************) + constructor TVpSchedule.Create(Owner: TVpResource); begin inherited Create; @@ -1084,7 +1034,6 @@ begin FBatchUpdate := 0; FEventList := TList.Create; end; -{=====} destructor TVpSchedule.Destroy; begin @@ -1092,8 +1041,21 @@ begin FEventList.Free; inherited; end; -{=====} +procedure TVpSchedule.Sort; +begin + { for greater performance, we don't sort while doing batch updates. } + if FBatchUpdate > 0 then + exit; + + { WARNING!! The DayView component is heavily dependent upon the events + being properly sorted. Sorting is based on the CompareEventTimes function. + If you change the way this procedure works, you WILL break the DayView + component!!! } + FEventList.Sort(@CompareEvents); +end; + +(* procedure TVpSchedule.Sort; var i, j : integer; @@ -1135,14 +1097,14 @@ begin 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. } @@ -1159,8 +1121,7 @@ begin else {Time2 is earlier than Time1} result := 1; -end; -{=====} +end; *) {Adds the event to the eventlist and returns a pointer to it, or nil on failure} function TVpSchedule.AddEvent(RecordID: Integer; StartTime, @@ -1172,7 +1133,6 @@ begin try Result.Loading := true; FEventList.Add(Result); - //result.FItemIndex := FEventList.Add(result); Result.RecordID := RecordID; Result.StartTime := StartTime; Result.EndTime := EndTime; @@ -1184,7 +1144,6 @@ begin end; end; end; -{=====} procedure TVpSchedule.ClearEvents; begin @@ -1196,7 +1155,6 @@ begin BatchUpdate(false); end; end; -{=====} procedure TVpSchedule.BatchUpdate(Value: Boolean); begin @@ -1210,22 +1168,20 @@ begin Sort; end; end; -{=====} -{ Frees the specified event, which also removes it from the list. } +{ Initiates destruction of the specified event which also removes it from the + list. } procedure TVpSchedule.DeleteEvent(Event: TVpEvent); begin Event.Deleted := true; Owner.EventsDirty := true; end; -{=====} function TVpSchedule.GetEvent(Index: Integer): TVpEvent; begin { Returns an event on success or nil on failure } result := FEventList.Items[Index]; end; -{=====} function TVpSchedule.RepeatsOn(Event: TVpEvent; Day: TDateTime): Boolean; var @@ -1251,69 +1207,63 @@ begin rtMonthlyByDay: 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 } + // Get the year, month and day of the first event in the series DecodeDate(Event.StartTime, EY, EM, ED); - { get the weekday of the first event in the series } + // Get the weekday of the first event in the series EventWkDay := DayOfWeek(Event.StartTime); - { Get the occurence of the first event in the series } - { (First Monday, Third Monday, etc...) } + // Get the occurence of the first event in the series (First Monday, Third Monday, etc...) EventDayCount := ED div 7 + 1; - { get the year, month and day of the "Day" parameter } + // Get the year, month and day of the "Day" parameter DecodeDate(Day, NY, NM, ND); - { get the weekday of the "Day" parameter } + // Get the weekday of the "Day" parameter ThisWkDay := DayOfWeek(Day); - { Get the weekday occurence of the "Day" parameter } - { (First Monday, Third Monday, etc...) } + // Get the weekday occurence of the "Day" parameter (First Monday, Third Monday, etc...) ThisDayCount := ND div 7 + 1; - { if (ThisWeekDay is equal to EventWkDay) } - { AND (ThisDayCount is equal to EventDayCount) } - { then we have a recurrence on this day } + // If (ThisWeekDay is equal to EventWkDay) and (ThisDayCount is equal to EventDayCount) + // then we have a recurrence on this day result := (ThisWkDay = EventWkDay) and (ThisDayCount = EventDayCount); end; rtMonthlyByDate: 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 } + // Get the year, month and day of the first event in the series DecodeDate(Event.StartTime, EY, EM, ED); - { get the year, month and day of the "Day" parameter } + // Get the year, month and day of the "Day" parameter DecodeDate(Day, NY, NM, ND); - { if the day values are equal then we have a recurrence on this } - { day } + // If the day values are equal then we have a recurrence on this day result := ED = ND; end; rtYearlyByDay: if (Day < trunc(Event.RepeatRangeEnd) + 1) and (Day > trunc(Event.StartTime)) then begin - { get the julian date of the first event in the series } + // Get the julian date of the first event in the series EventJulian := GetJulianDate(Event.StartTime); - { get the julian date of the "Day" parameter } + // Get the julian date of the "Day" parameter ThisJulian := GetJulianDate(Day); - { if the julian values are equal then we have a recurrence on } - { this day } + // Ff the julian values are equal then we have a recurrence on this day result := EventJulian = ThisJulian; end; rtYearlyByDate: 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 } + // Get the year, month and day of the first event in the series. DecodeDate(Event.StartTime, EY, EM, ED); - { get the year, month and day of the "Day" parameter } + // Get the year, month and day of the "Day" parameter. DecodeDate(Day, NY, NM, ND); - { if the day values and month values are equal then we have a } - { recurrence on this day } + // If the day values and month values are equal then we have a recurrence on this day result := (ED = ND) and (EM = NM); end; rtCustom: 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 } - { interval, then we have a recurrence on this day } - result := (Trunc(Day) - Trunc(Event.StartTime)) mod Event.CustomInterval = 0; + // If the number of elapsed days between the "Day" parameter and + // the event start time is evenly divisible by the event's custom + // interval, then we have a recurrence on this day + result := (Trunc(Day) - Trunc(Event.StartTime)) mod Event.CustomInterval = 0; end; end; end; @@ -1328,10 +1278,10 @@ begin result := 0; for I := 0 to pred(EventCount) do begin Event := GetEvent(I); - { if this is a repeating event and it falls on today then inc result } + // If this is a repeating event and it falls on today then inc result if (Event.RepeatCode > rtNone) and RepeatsOn(Event, Value) then Inc(Result) - { Otherwise if it is an event that naturally falls on today, then inc result } + // Otherwise if it is an event that naturally falls on today, then inc result // else if ((trunc(Value) >= trunc(Event.StartTime)) // and (trunc(Value) <= trunc(Event.EndTime))) then else @@ -1350,15 +1300,15 @@ begin EventList.Clear else begin - { Add this day's events to the Event List. } + // Add this day's events to the Event List. for I := 0 to pred(EventCount) do begin Event := GetEvent(I); - { if this is a repeating event and it falls on "Date" then add it to the list. } + // If this is a repeating event and it falls on "Date" then add it to the list. if (Event.RepeatCode > rtNone) and RepeatsOn(Event, Date) then EventList.Add(Event) else - { otherwise if this event naturally falls on "Date" then add it to the list. } + // otherwise if this event naturally falls on "Date" then add it to the list. if DateInRange(Date, Event.StartTime, Event.EndTime, true) then EventList.Add(Event); end; @@ -1377,7 +1327,7 @@ begin Exit else begin - { Add this days events to the Event List. } + // Add this days events to the Event List. for I := 0 to pred(EventCount) do begin Event := GetEvent(I); if Event.AllDayEvent and @@ -1472,10 +1422,9 @@ function TVpSchedule.GetCount: Integer; begin result := FEventList.Count; end; -{=====} - +(*****************************************************************************) { TVpContact } (*****************************************************************************) constructor TVpContact.Create(Owner: TVpContacts); @@ -1483,31 +1432,24 @@ begin inherited Create; FChanged := false; FOwner := Owner; -// FItemIndex := -1; FPhoneType1 := Ord(ptWork); FPhoneType2 := Ord(ptHome); FPhoneType3 := Ord(ptWorkFax); FPhoneType4 := Ord(ptMobile); FPhoneType5 := Ord(ptAssistant); end; -{=====} destructor TVpContact.Destroy; var idx: Integer; begin - { Remove self from owners list } + // Remove self from owners list if (FOwner <> nil) then begin idx := FOwner.FContactsList.IndexOf(self); if idx > -1 then FOwner.FContactsList.Delete(idx); end; - { - if (FItemIndex > -1) and (FOwner <> nil) then - FOwner.FContactsList.Delete(FItemIndex); - } inherited; end; -{=====} function TVpContact.FullName : string; begin @@ -1516,7 +1458,6 @@ begin else Result := FFirstName + ' ' + FLastName; end; -{=====} procedure TVpContact.SetBirthDate(Value: TDateTIme); begin @@ -1525,7 +1466,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetAnniversary(Value: TDateTIme); begin @@ -1534,7 +1474,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetAddress(const Value: string); begin @@ -1543,7 +1482,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCategory(Value: integer); begin @@ -1552,7 +1490,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetChanged(Value: Boolean); begin @@ -1564,7 +1501,6 @@ begin FOwner.FOwner.ContactsDirty := true; end; end; -{=====} procedure TVpContact.SetCity(const Value: string); begin @@ -1573,7 +1509,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCompany(const Value: string); begin @@ -1582,7 +1517,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCountry(const Value: string); begin @@ -1591,7 +1525,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCustom1(const Value: string); begin @@ -1600,7 +1533,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCustom2(const Value: string); begin @@ -1609,7 +1541,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCustom3(const Value: string); begin @@ -1618,7 +1549,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetCustom4(const Value: string); begin @@ -1627,7 +1557,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetDeleted(Value: Boolean); begin @@ -1636,7 +1565,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetEMail(const Value: string); begin @@ -1645,7 +1573,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetFirstName(const Value: string); begin @@ -1654,7 +1581,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetLastName(const Value: string); begin @@ -1663,7 +1589,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetNotes(const Value: string); begin @@ -1672,7 +1597,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhone1(const Value: string); begin @@ -1681,7 +1605,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhone2(const Value: string); begin @@ -1690,7 +1613,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhone3(const Value: string); begin @@ -1699,7 +1621,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhone4(const Value: string); begin @@ -1708,7 +1629,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhone5(const Value: string); begin @@ -1717,7 +1637,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhoneType1(Value: Integer); begin @@ -1726,7 +1645,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhoneType2(Value: Integer); begin @@ -1735,7 +1653,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhoneType3(Value: Integer); begin @@ -1744,7 +1661,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhoneType4(Value: Integer); begin @@ -1753,7 +1669,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPhoneType5(Value: Integer); begin @@ -1762,7 +1677,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetPosition(const Value: string); begin @@ -1771,7 +1685,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetRecordID(Value: Integer); begin @@ -1780,7 +1693,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetState(const Value: string); begin @@ -1789,7 +1701,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetTitle(const Value: string); begin @@ -1798,7 +1709,6 @@ begin Changed := true; end; end; -{=====} procedure TVpContact.SetZip(const Value: string); begin @@ -1807,10 +1717,12 @@ begin Changed := true; end; end; -{=====} + +(*****************************************************************************) { TVpContacts } (*****************************************************************************) + constructor TVpContacts.Create(Owner: TVpResource); begin inherited Create; @@ -1819,7 +1731,6 @@ begin FContactSort := csLastFirst; end; -{=====} destructor TVpContacts.Destroy; begin @@ -1827,7 +1738,23 @@ begin FContactsList.Free; inherited; end; -{=====} + +function TVpContacts.AddContact(RecordID: Integer): TVpContact; +var + Contact: TVpContact; +begin + Contact := TVpContact.Create(Self); + try + Contact.Loading := true; + FContactsList.Add(Contact); + Contact.RecordID := RecordID; + Contact.Loading := false; + result := Contact; + except + Contact.Free; + raise EFailToCreateContact.Create; + end; +end; procedure TVpContacts.BatchUpdate(Value: Boolean); begin @@ -1841,123 +1768,45 @@ begin Sort; end; end; -{=====} - -procedure TVpContacts.Sort; -var - i, j : integer; - IndexOfMin : integer; - Temp : pointer; -begin - { for greater performance, we don't sort while doing batch updates. } - if FBatchUpdate > 0 then exit; - - for i := 0 to pred(FContactsList.Count) do begin - IndexOfMin := i; - for j := i to FContactsList.Count - 1 do - if (Compare(FContactsList.List^[j], FContactsList.List^[IndexOfMin]) < 0) - then IndexOfMin := j; - Temp := FContactsList.List^[i]; - FContactsList.List^[i] := FContactsList.List^[IndexOfMin]; - FContactsList.List^[IndexOfMin] := Temp; - end; - (* - { Fix object embedded ItemIndexes } - for i := 0 to pred(FContactsList.Count) do begin - TVpContact(FContactsList.List^[i]).FItemIndex := i; - end; - *) -end; -{=====} - -{ Used by the above sort procedure } -function TVpContacts.Compare(Item1, Item2: TVpContact): Integer; -begin - if ContactSort = csFirstLast then begin - - { Compares the value of the contact Names } - if Item1.FirstName < Item2.FirstName then - result := -1 - else if Item1.FirstName = Item2.FirstName then begin - { if first names are equal then compare last names } - if Item1.LastName < Item2.LastName then - result := -1 - else if Item1.LastName = Item2.LastName then - result := 0 - else - result := 1; - end - else - result := 1; - - end else begin - { Compares the value of the contact Names } - if Item1.LastName < Item2.LastName then - result := -1 - else if Item1.LastName = Item2.LastName then begin - { if last names are equal then compare first names } - if Item1.FirstName < Item2.FirstName then - result := -1 - else if Item1.FirstName = Item2.FirstName then - result := 0 - else - result := 1; - end - else - result := 1; - end; -end; -{=====} - -function TVpContacts.AddContact(RecordID: Integer): TVpContact; -var - Contact: TVpContact; -begin - Contact := TVpContact.Create(Self); - try - Contact.Loading := true; - FContactsList.Add(Contact); -// Contact.FItemIndex := FContactsList.Add(Contact); - Contact.RecordID := RecordID; - Contact.Loading := false; - result := Contact; - except - Contact.Free; - raise EFailToCreateContact.Create; - end; -end; -{=====} function TVpContacts.Count: Integer; begin result := FContactsList.Count; end; -{=====} + +procedure TVpContacts.Sort; +begin + // For greater performance, we don't sort while doing batch updates. + if FBatchUpdate > 0 then + exit; + + // Do the sort + if ContactSort = csFirstLast then + FContactsList.Sort(@CompareContacts_FirstLast) + else + FContactsList.Sort(@CompareContacts_LastFirst); +end; function TVpContacts.Last: TVpContact; begin result := FContactsList.Items[FContactsList.Count - 1]; end; -{=====} function TVpContacts.First: TVpContact; begin result := FContactsList.Items[0]; end; -{=====} procedure TVpContacts.DeleteContact(Contact: TVpContact); begin - {Contacts automatically remove themselves from the list in their destructor } + // Contacts automatically remove themselves from the list in their destructor Contact.Free; end; -{=====} function TVpContacts.GetContact(Index: Integer): TVpContact; begin result := FContactsList.Items[Index]; end; -{=====} procedure TVpContacts.ClearContacts; begin @@ -1969,9 +1818,7 @@ begin BatchUpdate(false); end; end; -{=====} -{ - new} { new function introduced to support the new buttonbar component } function TVpContacts.FindContactByName(const Name: string; CaseInsensitive: Boolean): TVpContact; @@ -1982,40 +1829,35 @@ var begin Result := nil; - { to enhance performance, uppercase the input name } - { and get its length only once } + // To enhance performance, uppercase the input name and get its length only once if CaseInsensitive then SearchStr := uppercase(Name) else SearchStr := Name; SearchLength := Length(SearchStr); - { Iterate the contacts looking for a match } + // Iterate the contacts looking for a match for I := 0 to FContactsList.Count - 1 do begin if CaseInsensitive then begin - { not case sensitive } - if (Copy(uppercase(TVpContact(FContactsList.List^[I]).LastName), 1, - SearchLength) = SearchStr) + // not case sensitive + if Copy(uppercase(TVpContact(FContactsList[I]).LastName), 1, SearchLength) = SearchStr then begin - { we found a match, so return it and bail out } - Result := FContactsList.Items[I]; + // We found a match, so return it and bail out + Result := FContactsList[I]; Exit; end; end else begin - { case sensitive } - if (Copy(TVpContact(FContactsList.List^[I]).LastName, 1, - SearchLength) = SearchStr ) + // case sensitive + if Copy(TVpContact(FContactsList[I]).LastName, 1, SearchLength) = SearchStr then begin - { we found a match, so return it and bail out } - Result := FContactsList.Items[I]; + // We found a match, so return it and bail out + Result := FContactsList[I]; Exit; end; end; end; end; -{=====} -{ - new} { new function introduced to support the new buttonbar component } function TVpContacts.FindContactIndexByName(const Name: string; CaseInsensitive: Boolean): Integer; @@ -2027,7 +1869,6 @@ begin if Contact <> nil then Result := FContactsList.IndexOf(Contact); end; -{=====} procedure TVpContacts.SetContactSort (const v : TVpContactSort); begin @@ -2036,10 +1877,11 @@ begin Sort; end; end; -{=====} + (*****************************************************************************) { TVpTask } +(*****************************************************************************) constructor TVpTask.Create(Owner: TVpTasks); begin @@ -2050,33 +1892,24 @@ begin FDescription := ''; FItemIndex := -1; end; -{=====} destructor TVpTask.Destroy; var idx: Integer; begin - { Remove self from owners list } + // Remove self from owners list if (FOwner <> nil) then begin idx := FOwner.FTaskList.IndexOf(Self); if idx > -1 then FOwner.FTasklist.Delete(idx); FOwner.Sort; end; - { - if (FItemIndex > -1) and (FOwner <> nil) then begin - FOwner.FTaskList.Delete(FItemIndex); - FOwner.Sort; - end; - } inherited; end; -{=====} function TVpTask.IsOverdue: Boolean; begin result := (Trunc(DueDate) < now + 1); end; -{=====} procedure TVpTask.SetCategory(const Value: Integer); begin @@ -2085,7 +1918,6 @@ begin Changed := true; end; end; -{=====} procedure TVpTask.SetChanged(const Value: Boolean); begin @@ -2097,7 +1929,6 @@ begin Owner.FOwner.TasksDirty := true; end; end; -{=====} procedure TVpTask.SetComplete(const Value: Boolean); begin @@ -2109,7 +1940,6 @@ begin SetCompletedOn(0.0); end; end; -{=====} procedure TVpTask.SetCompletedOn(const Value: TDateTIme); begin @@ -2118,7 +1948,6 @@ begin Changed := true; end; end; -{=====} procedure TVpTask.SetCreatedOn(const Value: TDateTime); begin @@ -2127,7 +1956,6 @@ begin Changed := true; end; end; -{=====} procedure TVpTask.SetDescription(const Value: string); begin @@ -2136,7 +1964,6 @@ begin Changed := true; end; end; -{=====} procedure TVpTask.SetPriority(const Value: Integer); begin @@ -2145,7 +1972,6 @@ begin Changed := true; end; end; -{=====} procedure TVpTask.SetDetails(const Value: string); begin @@ -2154,31 +1980,28 @@ begin Changed := true; end; end; -{=====} procedure TVpTask.SetDueDate(const Value: TDateTime); begin - { Trunc the time element from the DueDate value so that it reflects } - { the Date only. } + // Trunc the time element from the DueDate value so that it reflects the Date only. if FDueDate <> Trunc(Value) then begin FDueDate := Trunc(Value); Changed := true; end; end; -{=====} (*****************************************************************************) { TVpTaskList } +(*****************************************************************************) constructor TVpTasks.Create(Owner: TVpResource); begin inherited Create; FOwner := Owner; FTaskList := TList.Create; - FTaskList.Clear; {!!!} + FTaskList.Clear; end; -{=====} destructor TVpTasks.Destroy; begin @@ -2186,7 +2009,6 @@ begin FTaskList.Free; inherited; end; -{=====} function TVpTasks.AddTask(RecordID: Integer): TVpTask; var @@ -2207,13 +2029,11 @@ begin raise EFailToCreateTask.Create; end; end; -{=====} function TVpTasks.Count: Integer; begin result := FTaskList.Count; end; -{=====} function TVpTasks.IndexOf(ATask: TVpTask): Integer; begin @@ -2224,62 +2044,55 @@ function TVpTasks.Last: TVpTask; begin result := FTaskList.Last; end; -{=====} function TVpTasks.First: TVpTask; begin result := FTaskList.First; end; -{=====} function TVpTasks.CountByDay(Date: TDateTime): Integer; var - i : Integer; - ATask : TVpTask; - + i: Integer; + ATask: TVpTask; begin Result := 0; - for i := 0 to pred (Count) do begin - ATask := GetTask (i); - if Trunc (ATask.DueDate) = Trunc (Date) then - Inc (Result); + for i := 0 to pred(Count) do begin + ATask := GetTask(i); + if Trunc(ATask.DueDate) = Trunc(Date) then + Inc(Result); end; end; -{=====} function TVpTasks.LastByDay(Date: TDateTime): TVpTask; var - i : Integer; - ATask : TVpTask; + i: Integer; + ATask: TVpTask; begin result := nil; - - for i := 0 to pred (Count) do begin - ATask := GetTask (i); - if Trunc (ATask.CreatedOn) = Trunc (Date) then begin + for i := 0 to pred(Count) do begin + ATask := GetTask(i); + if Trunc(ATask.CreatedOn) = Trunc(Date) then begin Result := ATask; + break; end; end; end; -{=====} function TVpTasks.FirstByDay(Date: TDateTime): TVpTask; var - i : Integer; - ATask : TVpTask; + i: Integer; + ATask: TVpTask; begin result := nil; - - for i := 0 to pred (Count) do begin - ATask := GetTask (i); - if Trunc (ATask.CreatedOn) = Trunc (Date) then begin + for i := 0 to pred(Count) do begin + ATask := GetTask(i); + if Trunc(ATask.CreatedOn) = Trunc(Date) then begin Result := ATask; Break; end; end; end; -{=====} procedure TVpTasks.ClearTasks; begin @@ -2291,7 +2104,6 @@ begin BatchUpdate(False); end; end; -{=====} procedure TVpTasks.BatchUpdate(value: Boolean); begin @@ -2305,83 +2117,29 @@ begin Sort; end; end; -{=====} procedure TVpTasks.Sort; var - i, j : integer; - IndexOfMin : integer; - Temp : pointer; + i: Integer; begin - { for greater performance, we don't sort while doing batch updates. } - if FBatchUpdate > 0 then exit; - - for i := 0 to pred(FTaskList.Count) do begin - IndexOfMin := i; - for j := i to FTaskList.Count - 1 do - if (Compare(FTaskList.List^[j], FTaskList.List^[IndexOfMin]) < 0) - then IndexOfMin := j; - Temp := FTaskList.List^[i]; - FTaskList.List^[i] := FTaskList.List^[IndexOfMin]; - FTaskList.List^[IndexOfMin] := Temp; - end; - - { Fix object embedded ItemIndexes } - for i := 0 to pred(FTaskList.Count) do begin - TVpTask(FTaskList.List^[i]).FItemIndex := i; - end; + // For greater performance, we don't sort while doing batch updates. + if FBatchUpdate > 0 then + exit; + FTaskList.Sort(@CompareTasks); + // Fix object embedded ItemIndexes // wp --- maybe this can be removed + for i:=0 to FTaskList.Count-1 do + TVpTask(FTaskList[i]).FItemIndex := i; end; -{=====} - -{ Used in the above sort procedure. Compares the start times of the two } -{ passed in events. } -function TVpTasks.Compare(Item1, Item2: TVpTask): Integer; -begin - { Compares the value of the Items DueDates } - - if Item1.DueDate < Item2.DueDate then - result := -1 - - { if the start times are equal then sort by description } - else if Item1.DueDate = Item2.DueDate then begin - if Item1.Description < Item2.Description then - result := -1 - else if Item1.Description = Item2.Description then - result := 0 - else - result := 1 - end - - else - {Item 2 starts earlier than Item 1} - result := 1; -end; -{=====} procedure TVpTasks.DeleteTask(Task: TVpTask); begin - {Tasks automatically remove themselves from the list in their destructor } + // Tasks automatically remove themselves from the list in their destructor Task.Free; end; -{=====} function TVpTasks.GetTask(Index: Integer): TVpTask; begin result := FTaskList.Items[Index]; end; -{=====} - -{ Call back function for TList.Sort. Sorting of events by time onla, date part - is ignored. } -function CompareEventsByTimeOnly(P1, P2: Pointer): Integer; -var - event1, event2: TVpEvent; -begin - event1 := TVpEvent(P1); - event2 := TVpEvent(P2); - Result := CompareValue(frac(event1.StartTime), frac(event2.StartTime)); - if Result = 0 then - Result := CompareValue(frac(event1.EndTime), frac(event2.EndTime)); -end; end.