?? fringer.pas
字號:
unit fRinger;
interface
uses
Windows, Forms, SysUtils, StdCtrls, Buttons, Controls, ExtCtrls, TAPILine, ImgList,
CoolTrayIcon, Menus, Graphics, Classes, jpeg;
type
TfrmRinger = class(TForm)
ppmRinger: TPopupMenu;
N2: TMenuItem;
Exit1: TMenuItem;
mmoLog: TMemo;
TrayIcon: TCoolTrayIcon;
IconList: TImageList;
N1: TMenuItem;
ppmPopUp: TMenuItem;
tmrClear: TTimer;
imgRingerIcon: TImage;
Line: TTAPILine;
panLog: TPanel;
panPopup: TPanel;
panSobre: TPanel;
Label1: TLabel;
lblVersao: TLabel;
btbSobre: TBitBtn;
mmoSobre: TMemo;
N3: TMenuItem;
Sobre1: TMenuItem;
imgPopup: TImage;
procedure Exit1Click(Sender: TObject);
procedure MenuClick(Sender: TObject);
procedure ppmPopUpClick(Sender: TObject);
procedure imgPopupClick(Sender: TObject);
procedure TrayIconDblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LineCallOffering(Sender: TObject);
procedure tmrClearTimer(Sender: TObject);
procedure btbSobreClick(Sender: TObject);
procedure Sobre1Click(Sender: TObject);
private
procedure Log(Mensagem:String;ShowLog:Boolean=False);
procedure MontaMenu;
procedure MostraLog;
procedure MostraPopup;
procedure MostraSobre;
procedure MostraApp;
{ Private declarations }
public
{ Public declarations }
end;
var
frmRinger: TfrmRinger;
implementation
{$R *.dfm}
function FileGetVersionInfo(const FileName:WideString):String;
var
buf: Pointer;
bufSize,
n: DWORD;
OK: Boolean;
pInfo: PVSFixedFileInfo;
begin
Result:= '';
if Win32Platform = VER_PLATFORM_WIN32_NT then
bufSize:= GetFileVersionInfoSizeW(PWChar(FileName), n)
else
bufSize:= GetFileVersionInfoSizeA(PChar(string(FileName)), n);
if bufSize=0 then
Exit;
GetMem(buf, bufSize);
try
if Win32Platform = VER_PLATFORM_WIN32_NT then
OK:= GetFileVersionInfoW(PWChar(FileName), 0, bufSize, buf)
else
OK:= GetFileVersionInfoA(PChar(string(FileName)), 0, bufSize, buf);
if OK then
begin
if VerQueryValue(buf, '\', pointer(pInfo), n) then
begin
Result:= Format('%d.%d.%d.%d',
[HiWord(pInfo.dwFileVersionMS),
LoWord(pInfo.dwFileVersionMS),
HiWord(pInfo.dwFileVersionLS),
LoWord(pInfo.dwFileVersionLS)]);
if (LoWord(pInfo.dwFileFlags) and 2) = 2 then
Result := Result + ' beta';
if (LoWord(pInfo.dwFileFlags) and 1) = 1 then
Result := Result + ' debug';
end;
end;
finally
FreeMem(buf, bufSize);
end;
end;
// ==============------------------
procedure TfrmRinger.MostraApp;
begin
try
Application.Restore;
Application.BringToFront;
Application.ProcessMessages;
except
on E: exception do
Log('MostraApp:: '+E.Message);
end;
end;
procedure TfrmRinger.MostraSobre;
begin
MostraApp;
panSobre.BringToFront;
end;
procedure TfrmRinger.MostraPopup;
begin
MostraApp;
panPopup.BringToFront;
end;
procedure TfrmRinger.MostraLog;
begin
MostraApp;
panLog.BringToFront;
end;
procedure TfrmRinger.Log(Mensagem:String;ShowLog:Boolean=False);
var
stLog: String;
begin
stLog := FormatDateTime('dd-mm-yyyy hh:nn:ss',Now)+' : '+Mensagem;
mmoLog.Lines.Add(stLog);
if ShowLog then
MostraLog;
end;
// ----- // -----
procedure TfrmRinger.FormCreate(Sender: TObject);
begin
lblVersao.Caption := FileGetVersionInfo(ParamStr(0));
Caption := 'Ringer - '+lblVersao.Caption;
TrayIcon.Hint := Caption;
TrayIcon.Icon.Assign(imgRingerIcon.Picture.Icon);
panLog.Align := alClient;
panPopup.Align := alClient;
imgPopup.Align := alClient;
MontaMenu;
Log('Iniciado '+Caption);
end;
procedure TfrmRinger.MontaMenu;
var
i: Integer;
ListTemp: TStrings;
mnuItem: TMenuItem;
procedure AddMenu(Text:String;Id:Integer=-1);
begin
mnuItem := TMenuItem.Create(ppmRinger);
ppmRinger.Items.Insert(0,mnuItem);
mnuItem.Caption := Text;
if Id >= 0 then
begin
mnuItem.RadioItem := True;
mnuItem.GroupIndex := 0;
mnuItem.Tag := Id;
mnuItem.OnClick := MenuClick;
end;
end;
begin
ListTemp := TStringList.Create;
try
Line.FillTAPILine(ListTemp);
if ListTemp.Count > 0 then
begin
AddMenu('-');
for i := 0 to ListTemp.Count -1 do
begin
AddMenu(ListTemp[i],i);
end;
AddMenu('-');
AddMenu('Off');
mnuItem.RadioItem := True;
mnuItem.GroupIndex := 0;
mnuItem.Tag := -1;
mnuItem.OnClick := MenuClick;
mnuItem.Checked := True;
end;
finally
ListTemp.Free;
end;
end;
procedure TfrmRinger.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TfrmRinger.MenuClick(Sender: TObject);
var
inPort: Integer;
begin
inPort := (Sender as TComponent).Tag;
Line.Close;
if inPort = -1 then
begin
Log('Monitor desligado.');
Exit;
end;
try
Line.DevIdToInitialize := inPort;
Line.DeviceDirectAccess := False;
Line.WaitForCall := False;
Line.Open;
Log('Monitorando dispositivo '+(Sender as TMenuItem).Caption);
(Sender as TMenuItem).Checked := True;
except
on E: exception do
Log('Erro, dispositivo '+(Sender as TMenuItem).Caption+' : '+E.Message,True);
end;
end;
procedure TfrmRinger.ppmPopUpClick(Sender: TObject);
begin
(Sender as TMenuItem).Checked := not (Sender as TMenuItem).Checked;
if (Sender as TMenuItem).Checked then
Log('Pop-Up ativado.')
else
Log('Pop-Up desativado.');
end;
procedure TfrmRinger.imgPopupClick(Sender: TObject);
begin
Application.Minimize;
end;
procedure TfrmRinger.TrayIconDblClick(Sender: TObject);
begin
MostraLog;
end;
procedure TfrmRinger.LineCallOffering(Sender: TObject);
begin
Log('Telefone tocando...');
TrayIcon.CycleIcons := True;
if ppmPopUp.Checked then
MostraPopup;
tmrClear.Enabled := True;
end;
procedure TfrmRinger.tmrClearTimer(Sender: TObject);
begin
tmrClear.Enabled := False;
TrayIcon.CycleIcons := False;
TrayIcon.Icon.Assign(imgRingerIcon.Picture.Icon);
Application.Minimize;
end;
procedure TfrmRinger.btbSobreClick(Sender: TObject);
begin
MostraLog;
end;
procedure TfrmRinger.Sobre1Click(Sender: TObject);
begin
MostraSobre;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -