📄 fcontact.pas
字号:
txtCustom1.Text := Personal.CustomField1;
txtCustom2.Text := Personal.CustomField2;
txtCustom3.Text := Personal.CustomField3;
txtCustom4.Text := Personal.CustomField4;
txtCustomLabel1.Text := Personal.CustomFieldLabel1;
txtCustomLabel2.Text := Personal.CustomFieldLabel2;
txtCustomLabel3.Text := Personal.CustomFieldLabel3;
txtCustomLabel4.Text := Personal.CustomFieldLabel4;
lstChat.Clear;
for i :=0 to Personal.Chats.Count - 1 do begin
with PTreeChat(lstChat.GetNodeData(lstChat.AddChild(nil)))^ do begin
app := Personal.Chats.Chats[i].Application;
id := Personal.Chats.Chats[i].ID;
end;
end;
//work tab
txtWorkCompany.Text := Work.CompanyName;
txtWorkJobTitle.Text := Work.JobTitle;
txtWorkDepartment.Text := Work.Department;
txtWorkTelephone.Text := Work.Telephone;
txtWorkExtension.Text := Work.Extension;
txtWorkMobile.Text := Work.Mobile;
txtWorkFax.Text := Work.Fax;
txtWorkPager.Text := Work.Pager;
txtWorkStreet.Lines.Text := Work.Street;
txtWorkZIP.Text := Work.ZIP;
txtWorkState.Text := Work.State;
txtWorkCountry.Text := Work.Country;
txtWorkHomepage.Text := Work.Homepage;
//home tab
txtHomeTelephone.Text := Home.Telephone;
txtHomeExtension.Text := Home.Extension;
txtHomeMobile.Text := Home.Mobile;
txtHomeFax.Text := Home.Fax;
txtHomePager.Text := Home.Pager;
txtHomeStreet.Lines.Text := Home.Street;
txtHomeZIP.Text := Home.ZIP;
txtHomeState.Text := Home.State;
txtHomeCountry.Text := Home.Country;
txtHomeHomepage.Text := Home.Homepage;
//notes tab
txtNotes.Lines.Text := Notes;
end;
end;
end;
procedure TfrmContact.SavePerson;
var i: Integer;
var Node: PVirtualNode;
var cht: PTreeChat;
var uniqueFileName: String;
begin
if FScheduleAsNew then begin
FPerson := FAddressBook.Persons.Add;
end;
(FAddressBook.Collection as TAddressBooks).Dirty := True;
with FPerson do begin
//general tab
Emails.Clear;
for i := 0 to txtEmails.Lines.Count -1 do
Emails.Add.Email := txtEmails.Lines[i];
General.FirstName := Trim(txtFirstName.Text);
General.MiddleName := Trim(txtMiddleName.Text);
General.LastName := Trim(txtLastName.Text);
General.NickName := Trim(txtNickname.Text);
General.Gender := TGender(cmboxGender.ItemIndex);
//image cleared?
if deleteOldPicture then begin
deleteOldPicture := False;
if (General.PhotoName <> '') or (pictureFileName <> '') then begin
DeleteFile((AddressBook.Collection as TAddressBooks).PicturesPath + General.PhotoName);
General.PhotoName := '';
end;
end
else if pictureFileName <> '' then begin //save file
uniqueFileName := ExtractFileName(pictureFileName);
//this should return unique file name
uniqueFileName := General.FirstName + ' ' + General.MiddleName + ' ' + General.LastName +
' [' + IntToHex(GetTickCount,8) + '-' + IntToHex(Trunc(Random(MaxLongint)),8) + ']' +
ExtractFileExt(uniqueFileName);
uniqueFileName := TrimLeft(uniqueFileName);
CopyFile(PChar(pictureFileName), PChar((AddressBook.Collection as TAddressBooks).PicturesPath +
uniqueFileName), True);
General.PhotoName := uniqueFileName;
end;
//personal tab
if not dtBirthday.Checked then
Personal.Birthday := 0
else
Personal.Birthday := dtBirthday.Date;
if not dtAnniversary.Checked then
Personal.Anniversary := 0
else
Personal.Anniversary := dtAnniversary.Date;
Personal.CustomField1 := Trim(txtCustom1.Text);
Personal.CustomField2 := Trim(txtCustom2.Text);
Personal.CustomField3 := Trim(txtCustom3.Text);
Personal.CustomField4 := Trim(txtCustom4.Text);
Personal.CustomFieldLabel1 := Trim(txtCustomLabel1.Text);
Personal.CustomFieldLabel2 := Trim(txtCustomLabel2.Text);
Personal.CustomFieldLabel3 := Trim(txtCustomLabel3.Text);
Personal.CustomFieldLabel4 := Trim(txtCustomLabel4.Text);
//save chat IDs
Personal.Chats.Clear;
Node := lstChat.GetFirst;
while (Node <> nil) do begin
cht := PTreeChat(lstChat.GetNodeData(Node));
Personal.Chats.Add(cht^.app, cht^.id);
Node := lstChat.GetNext(Node);
end;
//work tab
Work.CompanyName := Trim(txtWorkCompany.Text);
Work.JobTitle := Trim(txtWorkJobTitle.Text);
Work.Department := Trim(txtWorkDepartment.Text);
Work.Telephone := Trim(txtWorkTelephone.Text);
Work.Extension := Trim(txtWorkExtension.Text);
Work.Mobile := Trim(txtWorkMobile.Text);
Work.Fax := Trim(txtWorkFax.Text);
Work.Pager := Trim(txtWorkPager.Text);
Work.Street := Trim(txtWorkStreet.Lines.Text);
Work.ZIP := Trim(txtWorkZIP.Text);
Work.State := Trim(txtWorkState.Text);
Work.Country := Trim(txtWorkCountry.Text);
Work.Homepage := Trim(txtWorkHomepage.Text);
//home tab
Home.Telephone := Trim(txtHomeTelephone.Text);
Home.Extension := Trim(txtHomeExtension.Text);
Home.Mobile := Trim(txtHomeMobile.Text);
Home.Fax := Trim(txtHomeFax.Text);
Home.Pager := Trim(txtHomePager.Text);
Home.Street := Trim(txtHomeStreet.Lines.Text);
Home.ZIP := Trim(txtHomeZIP.Text);
Home.State := Trim(txtHomeState.Text);
Home.Country := Trim(txtHomeCountry.Text);
Home.Homepage := Trim(txtHomeHomepage.Text);
//notes tab
Notes := Trim(txtNotes.Lines.Text);
end;
FScheduleAsNew := False;
end;
procedure TfrmContact.cmdOKClick(Sender: TObject);
begin
//at least one must be entred
if (Trim(txtFirstName.Text) = '') and (Trim(txtMiddleName.Text) = '') and
(Trim(txtLastName.Text) = '') and (Trim(txtNickname.Text) = '') then begin
MessageDlg(_('At least one of following fields shouldn''t be empty.' + #13#10 +
'First Name, Middle Name, Last Name or Nick Name'), mtError, [mbOK], 0);
Exit;
end;
//contact can not be without e-mail address
emailListRemoveEmptyLines;
if txtEmails.Lines.Count = 0 then begin
MessageDlg(_('Please enter at least one of e-mail.'), mtError, [mbOK], 0);
Exit;
end;
SavePerson;
Self.Close;
end;
procedure TfrmContact.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePageIndex = 1 then begin //certificates
emailListRemoveEmptyLines;
cmboxEmail.Items.Assign(txtEmails.Lines);
end;
end;
procedure TfrmContact.emailListRemoveEmptyLines;
var i: Integer;
begin
for i := txtEmails.Lines.Count - 1 downto 0 do begin
if txtEmails.Lines.Strings[i] = '' then
txtEmails.Lines.Delete(i);
end;
end;
procedure TfrmContact.actPersDeleteUpdate(Sender: TObject);
begin
if lstChat.SelectedCount >= 1 then
actPersDelete.Enabled := True
else
actPersDelete.Enabled := False;
end;
procedure TfrmContact.lstChatGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := sizeOf(TTreeChat);
end;
procedure TfrmContact.lstChatClick(Sender: TObject);
var Node: PVirtualNode;
var p: TPoint;
begin
p := Mouse.CursorPos;
p := lstChat.ScreenToClient(p);
Node := lstChat.GetNodeAt(p.X, p.Y);
if Node <> nil then
lstChat.EditNode(Node, lstChat.FocusedColumn)
end;
procedure TfrmContact.lstChatCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
case Column of
1: editorChat.LinkComboEditor(EditLink, PTreeChat(
(Sender as TVirtualStringTree).GetNodeData(Node))^.app);
2: editorChat.LinkEditor(EditLink, PTreeChat(
(Sender as TVirtualStringTree).GetNodeData(Node))^.id);
end;
end;
procedure TfrmContact.lstChatEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
if Column > 0 then
Allowed := True
else
Allowed := False;
end;
procedure TfrmContact.lstChatEdited(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
begin
case Column of
1:
PTreeChat((Sender as TVirtualStringTree).GetNodeData(Node))^.app := cmboxChatApp.Text;
2:
PTreeChat((Sender as TVirtualStringTree).GetNodeData(Node))^.id := txtChatId.Text;
end;
end;
procedure TfrmContact.lstChatGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
begin
//return each column's text
with PTreeChat((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
case Column of
1:
CellText := app;
2:
CellText := id;
end;
end;
end;
procedure TfrmContact.actPersNewExecute(Sender: TObject);
begin
with PTreeChat(lstChat.GetNodeData(lstChat.AddChild(nil)))^ do begin
app := '';
id := '';
end;
end;
procedure TfrmContact.actPersDeleteExecute(Sender: TObject);
begin
if lstChat.SelectedCount = 0 then exit;
lstChat.DeleteNode(lstChat.GetFirstSelected);
end;
procedure TfrmContact.lstChatAfterCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
begin
if Column <> 0 then exit;
// Simulate a fixed column by filling the main column with an edge similar to that of TCustomGrid.
with TargetCanvas do begin
if toShowVertGridLines in lstChat.TreeOptions.PaintOptions then
Inc(CellRect.Right);
if toShowHorzGridLines in lstChat.TreeOptions.PaintOptions then
Inc(CellRect.Bottom);
DrawEdge(Handle, CellRect, BDR_RAISEDINNER, BF_RECT or BF_MIDDLE);
if Node = Sender.FocusedNode then
ilChat.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 0);
end;
end;
procedure TfrmContact.cmdPictureClick(Sender: TObject);
begin
if diOpenPicture.Execute then begin
pictureFileName := diOpenPicture.FileName;
imgPerson.Bitmap.LoadFromFile(pictureFileName);
end;
end;
procedure TfrmContact.lblClearPictureClick(Sender: TObject);
begin
pictureFileName := '';
deleteOldPicture := True;
imgPerson.Bitmap := imgAuthor.Bitmap;
end;
procedure TfrmContact.FormCreate(Sender: TObject);
begin
//form: Contact, control: &Gender:
cmboxGender.Items.Text := _('Unspecified' + #13#10 +
'Male' + #13#10 +
'Female');
//form: Contact, control: Chat applications
cmboxChatApp.Items.Text := _('ICQ' + #13#10 +
'MSN' + #13#10 +
'Yahoo' + #13#10 +
'AIM' + #13#10 +
'Jabber');
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -