📄 ueditcontact.pas
字号:
Key := #0;
Beep;
end;
end;
end;
procedure TfrmEditContact.ResetButtonClick(Sender: TObject);
begin
if MessageDlgW(_('Are you sure you want to reset positions?'),
mtConfirmation, MB_YESNO or MB_DEFBUTTON2) = ID_YES then begin
ResetButton.Enabled := False;
FillChar(contact.Position,SizeOf(contact.Position),0);
SetCustomModified;
end;
end;
procedure TfrmEditContact.TabSheet4Show(Sender: TObject);
begin
UpdateDefNum;
end;
procedure TfrmEditContact.UpdateDefNum(SetTo: integer);
var
selpos: integer;
begin
if SetTo = 0 then selpos := cbDefaultNum.ItemIndex else selpos := SetTo;
cbDefaultNum.Items.Clear;
// see TContactData.DefaultIndex
// 0 none;1 cell;2 work;3 home;4 other
cbDefaultNum.Items.Add(_('None'));
if txtCell.Text <> '' then cbDefaultNum.Items.Add(Format(_('Mobile [%s]'), [txtCell.Text]));
if txtWork.Text <> '' then cbDefaultNum.Items.Add(Format(_('Work [%s]'), [txtWork.Text]));
if txtHome.Text <> '' then cbDefaultNum.Items.Add(Format(_('Home [%s]'), [txtHome.Text]));
if txtOther.Text <> '' then cbDefaultNum.Items.Add(Format(_('Other [%s]'), [txtOther.Text]));
if (selpos < 0) or (selpos >= cbDefaultNum.Items.Count) then
selpos := 0; // Out of range goes to None
cbDefaultNum.ItemIndex := selpos;
end;
procedure TfrmEditContact.txtCustomChange(Sender: TObject);
begin
SetCustomModified;
end;
procedure TfrmEditContact.txtPhoneChange(Sender: TObject);
const
sem: boolean = False;
var
i: integer;
s: string;
b: boolean;
begin
if {not FLoadingData and} not sem then
try
sem := true;
with (Sender as TTntEdit) do begin
b := False;
s := Text;
i := 1;
while i <= Length(s) do begin
if ((i > 1) and (s[1] = '+') and (s[i] = '+')) or
(Pos('+',s) > 1) or not (s[i] in ['+','0'..'9','#','*','p']) then begin // do not localize
Delete(s,i,1);
b := True;
end
else
inc(i);
end;
if s <> Text then Text := s;
if s <> FPhonePrev then begin
FPhonePrev := s;
ApplyButton.Enabled := not IsNew;
Self.Modified := True;
end;
if b then Beep;
end;
finally
sem := False;
end;
end;
procedure TfrmEditContact.txtPhoneEnter(Sender: TObject);
begin
FPhonePrev := (Sender as TTntEdit).Text;
end;
procedure TfrmEditContact.Set_UseSIMMode(const Value: boolean);
var
i: integer;
c: TColor;
b: boolean;
begin
FUseSIMMode := Value;
if Value then c := clBtnFace else c := clWindow;
b := not Value;
txtTitle.Enabled := b;
txtTitle.Color := c;
txtOrganization.Enabled := b;
txtOrganization.Color := c;
txtBirthday.Enabled := b;
txtBirthday.Color := c;
txtBirthdayChange(nil);
txtDisplayAs.Enabled := b;
txtDisplayAs.Color := c;
{ In SIM mode leave only General tab visible }
for i := 0 to PageControl1.PageCount-1 do
if (PageControl1.Pages[i] <> tsCallNotes) and (PageControl1.Pages[i] <> tsCallPrefs) and
(PageControl1.Pages[i] <> tsGeneral) then
PageControl1.Pages[i].TabVisible := b;
end;
procedure TfrmEditContact.SelectFile(Pos: TPoint; FileType: byte; Selected: WideString);
var
m: TTntMenuItem;
Node{,Item}: PVirtualNode;
EData: PFmaExplorerNode;
Offline: boolean;
What: string;
ImgIdx: integer;
rec: TSearchRec;
procedure GatherExternalFiles(FromFile: TFile; MenuItem: TTntMenuItem; FileType: integer);
var
i: integer;
NewMenuItem: TTntMenuItem;
CurFile: TFile;
data: PFmaExplorerNode;
begin
if FromFile.FileType = ftDir then begin
for i := 0 to FromFile.Count - 1 do begin
CurFile := FromFile.DirContent[i];
{ Add menu item }
NewMenuItem := TTntMenuItem.Create(nil);
try
NewMenuItem.Caption := CurFile.ExternalName;
NewMenuItem.Hint := CurFile.FullPath;
NewMenuItem.Tag := CurFile.Size;
NewMenuItem.AutoHotkeys := maManual;
data := Form1.ExplorerNew.GetNodeData(CurFile.TreeNode);
NewMenuItem.ImageIndex := data.ImageIndex;
MenuItem.Add(NewMenuItem);
except
NewMenuItem.Free;
end;
{ Set item handler }
case CurFile.FileType of
ftDir:
GatherExternalFiles(FromFile.DirContent[i], NewMenuItem, FileType);
ftFile:
case FileType of
0: NewMenuItem.OnClick := OnPicSelClick;
1: NewMenuItem.OnClick := OnSndSelClick;
end;
end;
end;
end;
end;
begin
Offline := not Form1.FConnected or not Form1.FUseObex;
PopupMenu1.Items.Clear;
if Offline then begin
case FileType of
0: What := 'pic\*.*'; // do not localize
1: What := 'snd\*.*'; // do not localize
end;
if FindFirst(Form1.GetProfilePath+What,faAnyFile,rec) = 0 then
try
repeat
ImgIdx := Form1.ExplorerFindExtImage(ExtractFileExt(rec.Name));
if ImgIdx = -1 then continue;
m := TTntMenuItem.Create(nil);
try
m.AutoHotkeys := maManual;
m.Caption := rec.Name;
m.Tag := rec.Size;
m.Hint := rec.Name; // ignored in offline mode
m.ImageIndex := ImgIdx;
case FileType of
0: m.OnClick := OnPicSelClick;
1: m.OnClick := OnSndSelClick;
end;
if Selected <> '' then begin
if WideCompareText(rec.Name,Selected) = 0 then begin
m.Click;
m.Free;
break;
end;
m.Free;
end
else
PopupMenu1.Items.Add(m);
except
m.Free;
end;
until FindNext(rec) <> 0;
finally
FindClose(rec);
end;
end
else begin
Node := Form1.FindObexFolderNode(FileType);
EData := Form1.ExplorerNew.GetNodeData(Node);
if Assigned(Node) then
GatherExternalFiles(TFile(EData.Data), TTntMenuItem(PopupMenu1.Items), Filetype);
end;
if PopupMenu1.Items.Count = 0 then begin
MessageBeep(MB_ICONASTERISK);
MessageDlgW(_('You should refresh Explorer Files folder prior using this feature.'+
sLinebreak+sLinebreak+
'Note that this is currently not supported if you are using IR connection.'),mtInformation, MB_OK);
end
else
PopupMenu1.Popup(pos.X,pos.Y);
end;
procedure TfrmEditContact.btnPicSelClick(Sender: TObject);
var
p: TPoint;
begin
p := btnPicSel.ClientToScreen(Point(btnPicSel.Width,0));
SelectFile(p,0);
end;
procedure TfrmEditContact.btnSndSelClick(Sender: TObject);
var
p: TPoint;
begin
p := btnSndSel.ClientToScreen(Point(btnSndSel.Width,0));
SelectFile(p,1);
end;
procedure TfrmEditContact.OnPicSelClick(Sender: TObject);
var
Filename,Fullpath,Objectname: WideString;
Filesize: integer;
begin
btnPicSel.Enabled := False;
btnSndSel.Enabled := False;
FLoadingData := True;
try
Objectname := (Sender as TTntMenuItem).Hint;
Filename := (Sender as TTntMenuItem).Caption;
Filesize := (Sender as TTntMenuItem).Tag;
Fullpath := Form1.GetProfilePath+'pic\'; // do not localize
lblPicDim.Caption := '';
lblPicSize.Caption := '';
lblPicPal.Caption := '';
lblPicName.Caption := Format(_('(Loading %s...)'), [Filename]);
try
ForceDirectories(Fullpath);
if Form1.FConnected and Form1.FUseObex and not FileExists(Fullpath+Filename) then
Form1.ObexGetFile(Fullpath+Filename,Objectname,False);
{ Use uGlobal function }
LoadBitmap32FromFile(Fullpath+Filename,SelImage.Bitmap);
IsCustomImage := True;
btnPicDel.Enabled := True;
except
btnPicDel.Click;
raise;
end;
lblPicName.Caption := Filename;
lblPicDim.Caption := Format(_('%dx%d (%dx%d pixels)'),[SelImage.Width,SelImage.Height,
SelImage.Bitmap.BitmapInfo.bmiHeader.biWidth,-SelImage.Bitmap.BitmapInfo.bmiHeader.biHeight]);
lblPicSize.Caption := Format(_('%.1n KB (%d bytes)'),[Filesize / 1024,Filesize]);
case SelImage.Bitmap.BitmapInfo.bmiHeader.biBitCount of
8: lblPicPal.Caption := _('Low-Color (256 colors)');
16: lblPicPal.Caption := _('Hi-Color (65535 colors)');
24: lblPicPal.Caption := _('True-Color (24-bit colors)');
32: lblPicPal.Caption := _('True-Color (32-bit colors)');
else lblPicPal.Caption := _('Low-Color (<256 colors)');
end;
SetCustomModified;
finally
btnPicSel.Enabled := True;
btnSndSel.Enabled := True;
FLoadingData := False;
end;
end;
procedure TfrmEditContact.OnSndSelClick(Sender: TObject);
var
Filename,Fullpath,Objectname: WideString;
Filesize: integer;
begin
btnPicSel.Enabled := False;
btnSndSel.Enabled := False;
FLoadingData := True;
try
Objectname := (Sender as TTntMenuItem).Hint;
Filename := (Sender as TTntMenuItem).Caption;
Filesize := (Sender as TTntMenuItem).Tag;
Fullpath := Form1.GetProfilePath+'snd\'; // do not localize
lblSndType.Caption := '';
lblSndSize.Caption := '';
lblSndName.Caption := Format(_('(Loading %s...)'), [Filename]);
try
ForceDirectories(Fullpath);
if Form1.FConnected and Form1.FUseObex and not FileExists(Fullpath+Filename) then
Form1.ObexGetFile(Fullpath+Filename,Objectname,False);
{ Load sound file }
MediaPlayer1.FileName := Fullpath+Filename;
MediaPlayer1.Enabled := True;
except
btnSndDel.Click;
raise;
end;
lblSndName.Caption := Filename;
lblSndSize.Caption := Format(_('%.1n KB (%d bytes)'),[Filesize / 1024,Filesize]);
try
MediaPlayer1.Open;
lblSndType.Caption := Format(_('Track length is %d samples (Custom format)'),[MediaPlayer1.TrackLength[1]]);
btnSndDel.Enabled := True;
except
lblSndType.Caption := _('Unknown (Unsupported format)');
MediaPlayer1.Enabled := False;
end;
SetCustomModified;
finally
btnPicSel.Enabled := True;
btnSndSel.Enabled := True;
FLoadingData := False;
end;
end;
procedure TfrmEditContact.btnPicDelClick(Sender: TObject);
begin
if FLoadingData or (MessageDlgW(_('Remove personalized picture?'),
mtConfirmation, MB_YESNO or MB_DEFBUTTON2) = ID_YES) then begin
if lblPicName.Caption <> '' then begin
SetCustomModified;
end;
lblPicDim.Caption := _('128x127 (0x0 pixels)');
lblPicName.Caption := '';
lblPicSize.Caption := _('0,0 KB (0 bytes)');
lblPicPal.Caption := _('Hi-Color (65535 colors)');
SelImage.Bitmap.Clear;
IsCustomImage := False;
btnPicDel.Enabled := False;
end;
end;
procedure TfrmEditContact.btnSndDelClick(Sender: TObject);
begin
if FLoadingData or (MessageDlgW(_('Remove personalized sound?'),
mtConfirmation, MB_YESNO or MB_DEFBUTTON2) = ID_YES) then begin
if lblSndName.Caption <> '' then begin
SetCustomModified;
end;
lblSndType.Caption := _('(polyphonic stereo sound, supported by phone)');
lblSndName.Caption := '';
lblSndSize.Caption := _('0,0 KB (0 bytes)');
MediaPlayer1.Close;
MediaPlayer1.Enabled := False;
btnSndDel.Enabled := False;
end;
end;
procedure TfrmEditContact.UpdatePersonalize;
var
m: TTntMenuItem;
f: TFileStream;
amod,cmod,OldApply: boolean;
procedure LoadFile(fname: string; ftype: byte);
var
dir: string;
begin
{ Emulate popup menu click here in order to select default
contact picture/sound file. }
case ftype of
0: dir := 'pic\'; // do not localize
1: dir := 'snd\'; // do not localize
end;
m := TTntMenuItem.Create(nil);
try
m.Caption := fname;
m.Hint := fname; // phone's objectname
try
f := TFileStream.Create(Form1.GetProfilePath+dir+fname,fmOpenRead);
try
m.Tag := f.Size;
finally
f.Free;
end;
except
m.Tag := 0;
end;
case ftype of
0: OnPicSelClick(m);
1: OnSndSelClick(m);
end;
finally
m.Free;
end;
end;
begin
OldApply := ApplyButton.Enabled;
{ Show window while updateing }
TabSheet2.Update;
amod := Modified;
cmod := customModified;
{ Load personalization files on tabsheet enter }
if (lblPicName.Caption = '') and (contact.picture <> '') then
LoadFile(contact.picture,0);
if (lblSndName.Caption = '') and (contact.sound <> '') then
LoadFile(contact.sound,1);
Modified := amod;
customModified := cmod;
ApplyButton.Enabled := OldApply;
end;
procedure TfrmEditContact.MediaPlayer1Click(Sender: TObject;
Button: TMPBtnType; var DoDefault: Boolean);
begin
if Button = btStop then MediaPlayer1.Rewind;
end;
procedure TfrmEditContact.PageControl1Change(Sender: TObject);
begin
case PageControl1.ActivePageIndex of
1: UpdatePersonalize;
2: UpdateDefNum;
end;
end;
procedure TfrmEditContact.Set_UseOwnMode(const Value: boolean);
var
i: integer;
begin
FUseOwnMode := Value;
{ In Edit Own Card mode leave only General tab visible }
for i := 1 to PageControl1.PageCount-1 do
PageControl1.Pages[i].TabVisible := not FUseOwnMode;
end;
procedure TfrmEditContact.btnUploadClick(Sender: TObject);
var
m: TTntMenuItem;
ObjType: integer;
begin
Form1.AskRequestConnection;
btnPicNew.Enabled := False;
btnSndNew.Enabled := False;
try
ObjType := TTntButton(Sender).Tag;
if not Form1.FUseObex then
raise EInOutError.Create(_('OBEX is not supported or disabled'));
if Form1.FConnected and Form1.ActionToolsUpload.Execute then begin
m := TTntMenuItem.Create(nil);
try
m.AutoHotkeys := maManual;
m.Caption := WideExtractFileName(Form1.ObexOpenDialog.FileName);
m.Hint := Form1.FindObexFolderName(ObjType)+'/'+m.Caption;
if ObjType = 0 then
m.OnClick := OnPicSelClick // image
else
m.OnClick := OnSndSelClick; // sound
{ select it }
m.Click;
finally
m.Free;
end;
end;
finally
btnPicNew.Enabled := True;
btnSndNew.Enabled := True;
end;
end;
procedure TfrmEditContact.DoSanityCheck;
var
TelCnt: integer;
s: WideString;
begin
s := Trim(txtName.Text);
if (s = '') and (Trim(txtOrganization.Text) <> '') then s := Trim(txtOrganization.Text);
{ check name }
if s = '' then begin
MessageDlgW(_('You have to enter contact or company name.'), mtError, MB_OK);
Abort;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -