ucalling.pas

来自「FMA is a free1 powerful phone editing to」· PAS 代码 · 共 520 行 · 第 1/2 页

PAS
520
字号
unit uCalling;

{
*******************************************************************************
* Descriptions: Calling/Called Popup Implementation
* $Source: /cvsroot/fma/fma/uCalling.pas,v $
* $Locker:  $
*
* Todo:
*   - Update to support note taking for the active caller
*
* Change Log:
* $Log: uCalling.pas,v $
*
*******************************************************************************
}

interface

uses
  Windows, TntWindows, Messages, SysUtils, TntSysUtils, Variants, Classes, TntClasses, Graphics, TntGraphics, Controls, TntControls, Forms, TntForms,
  Dialogs, TntDialogs, StdCtrls, TntStdCtrls, Placemnt, GR32_Image, ExtCtrls, TntExtCtrls, MPlayer,
  jpeg, MMSystem, uSyncPhonebook, Menus, TntMenus;

type
  TfrmCalling = class(TTntForm)
    HandupButton: TTntButton;
    AnswerButton: TTntButton;
    FormPlacement1: TFormPlacement;
    lbAlpha: TTntLabel;
    lbNumber: TTntLabel;
    MoreButton: TTntButton;
    ImagePanel: TTntPanel;
    Image32: TImage32;
    MediaPlayer1: TMediaPlayer;
    Image1: TTntImage;
    lblTime: TTntLabel;
    TimeTimer: TTimer;
    Memo: TTntMemo;
    PopupMenu1: TTntPopupMenu;
    HeadsetButton: TTntMenuItem;
    N1: TTntMenuItem;
    AddToPhonebook1: TTntMenuItem;
    N2: TTntMenuItem;
    MessageContact1: TTntMenuItem;
    HangUp1: TTntMenuItem;
    Answer1: TTntMenuItem;
    N3: TTntMenuItem;
    Ignore1: TTntMenuItem;
    procedure FormShow(Sender: TObject);
    procedure MediaPlayer1Notify(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure TimeTimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure HeadsetButtonClick(Sender: TObject);
    procedure AddToPhonebook1Click(Sender: TObject);
    procedure MoreButtonClick(Sender: TObject);
    procedure Ignore1Click(Sender: TObject);
    procedure AnswerButtonClick(Sender: TObject);
    procedure HandupButtonClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure MessageContact1Click(Sender: TObject);
  private
    { Private declarations }
    FContactData: TContactData;
    FNotesContact: PContactData;
    FStartTime: TDateTime;
    FCreated,FPersonalized,FPersonalizedSem,FStopped: boolean;
    FIsIncoming: Boolean;
    FRingSecs,FRingOn: integer;
    FCheck,FCalling: Boolean;
    FCustomImage: Boolean;
    procedure Set_IsIncoming(const Value: Boolean);
    function Get_Busy: Boolean;
    procedure Set_Busy(const Value: Boolean);
    procedure Set_CustomImage(const Value: Boolean);
    procedure DoStopPersonalize(Exiting: boolean = True);
  public
    { Public declarations }
    procedure CreateCall(Number: WideString; Popup: boolean; AlphaBlend: Integer);
    procedure CloseCall(CanClose: boolean = True; CanHangUp: boolean = True);
    procedure DoExiting;
    procedure DoInCall;
    procedure DoPersonalize;
    procedure DoShowNotes;
    procedure DoResizeWide;
    function HasPersonalizedSound: boolean;
  published
    property IsCreated: Boolean read FCreated;
    property IsIncoming: Boolean read FIsIncoming write Set_IsIncoming;
    property IsTalking: Boolean read FCheck write FCheck;     { means: Are we picked up the call }
    property IsCalling: Boolean read FCalling write FCalling; { means: Should we hang up or not on exit? }
    property IsPersonalized: Boolean read FPersonalized;      { means: Do we have personalized contact? }
    property IsCustomImage: Boolean read FCustomImage write Set_CustomImage;
    property IsBusy: Boolean read Get_Busy write Set_Busy;    { means: Is busy signal detected? }
  end;

var
  frmCalling: TfrmCalling;

implementation

uses
  gnugettext, gnugettexthelpers,
  uImg32Helper, Unit1, uMissedCalls, uDialogs, uSIMEdit, uComposeSMS;

const
  DefRingOutgoingSecs = 5;

{$R *.dfm}

procedure TfrmCalling.FormShow(Sender: TObject);
begin
  SetWindowPos(Handle, HWND_TOPMOST,
    Left, Top, Width, Height,
    SWP_NOACTIVATE or SWP_NOSIZE);
end;

procedure TfrmCalling.DoPersonalize;
var
  s: string;
  ContactName: WideString;
  Where: TFindContactResult;
begin
  { Try to lookup caller and load personalized info about the contact }
  if not FPersonalizedSem then begin
    FPersonalizedSem := True; // allow it only once
    { Lookup contact name }
    if (lbAlpha.Caption = sUnknownNumber) or (lbAlpha.Caption = sUnknownContact) then
      lbAlpha.Caption := Form1.ExtractContact(Form1.ContactNumberByTel(lbNumber.Caption));
    { Resize window if needed }
    DoResizeWide;
    { Personalize }
    ContactName := Form1.ExtractContact(lbAlpha.Caption);
    Where := Form1.WhereisContact(ContactName,fcByName);
    if Where = Form1.WhereisContact(lbNumber.Caption,fcByNumber) then
    case Where of
      frIrmcSync:
        if Form1.frmSyncPhonebook.FindContact(ContactName,FNotesContact) then begin
          FPersonalized := True;
          if IsIncoming then
            Form1.ShowBaloonInfo(Format(_('%s is calling...'),[GetContactFullName(FNotesContact)]),60);
          // image
          IsCustomImage := False;
          try
            s := GetContactPictureFile(FNotesContact);
            if s <> '' then begin
              { Use uGlobal function }
              LoadBitmap32FromFile(s,Image32.Bitmap);
              IsCustomImage := True;
            end;
          except
          end;
          // sound
          { WaitASec(500); // delay to sync our with phone sounds :) }
          try
            s := GetContactSoundFile(FNotesContact);
            if IsIncoming and (s <> '') then begin
              { Stop default ringing sound }
              if IsIncoming then PlaySound(nil, 0, SND_PURGE);
              { Play personalized sound }
              MediaPlayer1.FileName := s;
              MediaPlayer1.Open;
              MediaPlayer1.Play;
              MediaPlayer1.Notify := True;
            end
            else
              MediaPlayer1.FileName := '';
          except
            MediaPlayer1.FileName := '';
          end;
          FStopped := False;
        end;
    end;
    { Notes }
    DoShowNotes;
  end;
  { Play default ringing sound if no personalization set up for that contact,
    or if personalization is set up, but only for the contact picture, i.e. no sound }
  if (not FPersonalized or (MediaPlayer1.FileName = '')) then
    if IsIncoming then
      FStopped := not PlaySound(pChar('FMA_CallReceived'), 0, SND_ASYNC or SND_APPLICATION or SND_NODEFAULT) // do not localize
    else
      FStopped := not PlaySound(pChar('FMA_Calling'), 0, SND_ASYNC or SND_APPLICATION or SND_NODEFAULT); // do not localize
end;

procedure TfrmCalling.MediaPlayer1Notify(Sender: TObject);
begin
  { loop sound }
  if FPersonalized and not FStopped and (MediaPlayer1.Mode = mpStopped) then
    try
      MediaPlayer1.Play;
      MediaPlayer1.Notify := True;
    except
    end;
end;

procedure TfrmCalling.DoStopPersonalize(Exiting: boolean);
begin
  { if Exiting is False, we are entering call;
    if Exiting is True, we are closing form (call ended) }
  if Exiting then begin
    { Save contact notes always }
    if Assigned(FNotesContact) then
      SetContactNotes(FNotesContact,Memo.Lines);
  end;
  if not FStopped then begin
    FStopped := True; // allow it only once
    if Exiting then
      IsCustomImage := False
    else begin
      TimeTimer.Enabled := True;
      FStartTime := Now;
    end;
    { Stop personalized ringing sound } 
    if MediaPlayer1.FileName <> '' then
      try
        MediaPlayer1.Notify := False;
        if IsIncoming then
          try
            MediaPlayer1.Stop;
            MediaPlayer1.Close;
          except
          end;
        MediaPlayer1.FileName := '';
      except
      end
    else begin
      { Stop default ringing sound }
      PlaySound(nil, 0, SND_PURGE);
    end;
  end;
end;

procedure TfrmCalling.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Form1.FConnected and IsCalling and not IsTalking and not IsIncoming then
    CanClose := MessageDlgW(_('Closing this box will Hang Up current outgoing call. Continue?'),
      mtConfirmation, MB_OKCANCEL) = ID_OK;
end;

procedure TfrmCalling.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseCall(False);
end;

procedure TfrmCalling.TimeTimerTimer(Sender: TObject);
begin
  { This timer will be triggered once a call is active
    or when an outgoing call is initiated... }
  if IsTalking then
    lblTime.Caption := FormatDateTime('nn:ss',Now - FStartTime) // do not localize ?
  else
    if not IsIncoming then begin
      { perform default outgoing ringing sound on every RingSecs seconds }
      inc(FRingSecs);
      if FRingSecs = FRingOn then begin
        DoPersonalize;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?