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 + -
显示快捷键?