📄 addrbk.pas
字号:
function TEmails.FindItem(Value: TEmail): Integer;
var i: Integer;
begin
Result := -1;
for i := 0 to Count - 1 do begin
if Emails[i] = Value then begin
Result := i;
break;
end;
end;
end;
{ TPersons }
function TPersons.Add: TPerson;
begin
Result := (inherited Add) as TPerson;
Inc(FLastID);
Result.id := FLastID;
end;
function TPersons.FindItemID(ID: Integer): TPerson;
begin
Result := (inherited FindItemID(ID)) as TPerson;
end;
function TPersons.Insert(Index: Integer): TPerson;
begin
Result := (inherited Insert(Index)) as TPerson;
end;
function TPersons.GetPerson(Index: Integer): TPerson;
begin
Result := (inherited GetItem(Index)) as TPerson;
end;
procedure TPersons.SetPerson(Index: Integer; const Value: TPerson);
begin
inherited SetItem(Index, Value);
end;
function TPersons.FindItem(Value: TPerson): Integer;
var i: Integer;
begin
Result := -1;
for i := 0 to Count - 1 do begin
if Persons[i] = Value then begin
Result := i;
break;
end;
end;
end;
{ TAddressBooks }
function TAddressBooks.Add(addrBkName: String): TAddressBook;
begin
Result := (inherited Add) as TAddressBook;
Result.BookName := addrBkName;
end;
function TAddressBooks.FindItemID(ID: Integer): TAddressBook;
begin
Result := (inherited FindItemID(ID)) as TAddressBook;
end;
function TAddressBooks.Insert(Index: Integer): TAddressBook;
begin
Result := (inherited Insert(Index)) as TAddressBook;
end;
function TAddressBooks.GetAddressBook(Index: Integer): TAddressBook;
begin
Result := (inherited GetItem(Index)) as TAddressBook;
end;
procedure TAddressBooks.SetAddressBook(Index: Integer; const Value: TAddressBook);
begin
inherited SetItem(Index, Value);
end;
constructor TAddressBooks.Create(fileName: String);
begin
inherited Create(TAddressBook);
FFileName := fileName;
if not DirectoryExists(ExtractFilePath(FFileName) +'Pictures\') then
ForceDirectories(ExtractFilePath(FFileName) +'Pictures\');
if not DirectoryExists(ExtractFilePath(FFileName) +'Certificates\') then
ForceDirectories(ExtractFilePath(FFileName) +'Certificates\');
FPicturesPath := ExtractFilePath(FFileName) +'Pictures\';
FCertificatesPath := ExtractFilePath(FFileName) +'Certificates\';
end;
procedure TAddressBooks.Load;
begin
if FileExists(FFileName) then
TOmniMyXMLReader.LoadFromFile(Self, FFileName);
end;
procedure TAddressBooks.Save;
begin
if FDirty then begin
TOmniMyXMLWriter.SaveToFile(Self, FFileName, ofIndent);
FDirty := False;
end;
end;
//function returns 0 if no number is needed for book name to be unique
//or number so new address book name is unique
function TAddressBooks.GetNoForName(bookName: String): Integer;
function IsUnique(st: String): Boolean;
var c, i: Integer;
begin
c := Count - 1;
Result := True;
for i := 0 to c do begin
if st = AddressBooks[i].BookName then begin
Result := False;
break;
end;
end;
end;
var tmpStr: String;
begin
Result := 0;
tmpStr := bookName;
while not IsUnique(tmpStr) do begin
Result := GetTickCount;
if Result = 0 then Inc(Result); //result cannot be 0
tmpStr := bookName + '-' + IntToHex(Result, 4);
end;
end;
function TAddressBooks.FindItem(Value: TAddressBook): Integer;
var i: Integer;
begin
Result := -1;
for i := 0 to Count - 1 do begin
if AddressBooks[i] = Value then begin
Result := i;
break;
end;
end;
end;
{ TPersonal }
procedure TPersonal.Assign(Source: TPersistent);
var b: TPersonal;
begin
b := Source as TPersonal;
Self.Birthday := b.Birthday;
Self.Anniversary := b.Anniversary;
Self.CustomField1 := b.CustomField1;
Self.CustomField2 := b.CustomField2;
Self.CustomField3 := b.CustomField3;
Self.CustomField4 := b.CustomField4;
Self.CustomFieldLabel1 := b.CustomFieldLabel1;
Self.CustomFieldLabel2 := b.CustomFieldLabel2;
Self.CustomFieldLabel3 := b.CustomFieldLabel3;
Self.CustomFieldLabel4 := b.CustomFieldLabel4;
Self.Chats.Assign(b.Chats);
end;
constructor TPersonal.Create;
begin
inherited Create;
FChats := TChats.Create(TChat);
end;
destructor TPersonal.Destroy;
begin
FreeAndNil(FChats);
inherited Destroy;
end;
{ TPerson }
procedure TPerson.Assign(Source: TPersistent);
var b: TPerson;
begin
b := Source as TPerson;
Self.General.Assign(b.General);
Self.Home.Assign(b.Home);
Self.Personal.Assign(b.Personal);
Self.Work.Assign(b.Work);
Self.Emails.Assign(b.Emails);
Self.Notes := b.Notes;
end;
constructor TPerson.Create(Collection: TCollection);
begin
inherited Create(Collection);
FGeneral := TGeneral.Create;
FHome := THome.Create;
FPersonal := TPersonal.Create;
FWork := TWork.Create;
FEmails := TEmails.Create(TEmail);
end;
procedure TPerson.Delete;
var id: Integer;
begin
id := (Collection as TPersons).FindItem(Self);
if id >= 0 then
Collection.Delete(id);
end;
destructor TPerson.Destroy;
begin
FreeAndNil(FGeneral);
FreeAndNil(FHome);
FreeAndNil(FPersonal);
FreeAndNil(FWork);
FreeAndNil(FEmails);
inherited Destroy;
end;
{ TAddressBook }
constructor TAddressBook.Create(Collection: TCollection);
begin
inherited Create(Collection);
FPersons := TPersons.Create(TPerson);
end;
procedure TAddressBook.Delete;
var id: Integer;
begin
id := (Collection as TAddressBooks).FindItem(Self);
if id >= 0 then
Collection.Delete(id);
end;
destructor TAddressBook.Destroy;
begin
FreeAndNil(FPersons);
inherited Destroy;
end;
{ TGeneral }
procedure TGeneral.Assign(Source: TPersistent);
var b: TGeneral;
begin
b := Source as TGeneral;
Self.FirstName := b.FirstName;
Self.MiddleName := b.MiddleName;
Self.LastName := b.LastName;
Self.NickName := b.NickName;
Self.Gender := b.Gender;
Self.PhotoName := b.PhotoName;
end;
{ THome }
procedure THome.Assign(Source: TPersistent);
var b: THome;
begin
b := Source as THome;
Self.Telephone := b.Telephone;
Self.Extension := b.Extension;
Self.Mobile := b.Mobile;
Self.Fax := b.Fax;
Self.Pager := b.Pager;
Self.Street := b.Street;
Self.ZIP := b.ZIP;
Self.State := b.State;
Self.Country := b.Country;
Self.Homepage := b.Homepage;
end;
{ TWork }
procedure TWork.Assign(Source: TPersistent);
var b: TWork;
begin
inherited Assign(Source);
b := Source as TWork;
Self.CompanyName := b.CompanyName;
Self.JobTitle := b.JobTitle;
Self.Department := b.Department;
end;
{ TEmail }
procedure TEmail.Assign(Source: TPersistent);
var b: TEmail;
begin
b := Source as TEmail;
Self.Email := b.Email;
end;
{ TChat }
procedure TChat.Assign(Source: TPersistent);
var b: TChat;
begin
b := Source as TChat;
Self.Application := b.Application;
Self.ID := b.ID;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -