⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ueditcontact.pas

📁 FMA is a free1 powerful phone editing tool allowing users to easily manage all of the personal data
💻 PAS
📖 第 1 页 / 共 3 页
字号:
      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 + -