WebSVN – alarming – Diff – /trunk/Delphi Client/DoorAlarmClientMain.pas


unit DoorAlarmClientMain;
 
// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected, with different event sounds etc
// TODO: ask server to subscribe/unsubscribe to events (doorbell, motion)
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, HTTPApp, StdCtrls,
  IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,
  JPEG, MJPEGDecoderUnit, IniFiles, Menus;
 
type
  TAlarmType = (atUnknown, atMotion, atDoorbell);
 
  TForm1 = class(TForm)
    Image1: TImage;
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    Open1: TMenuItem;
    Image2: TImage;
    CloseTimer: TTimer;
    UpdateIPTimer: TTimer;
    Allowmutingsoundinterface1: TMenuItem;
    N1: TMenuItem;
    Startalarm1: TMenuItem;
    N2: TMenuItem;
    Stopalarm1: TMenuItem;
    Gotocontrolpanelwebsite1: TMenuItem;
    doorbellPanel: TPanel;
    N3: TMenuItem;
    Ignoredoorbell1: TMenuItem;
    Ignoremotionalert1: TMenuItem;
    unknownAlarm: TPanel;
    Simulatealarm1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrayIcon1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure CloseTimerTimer(Sender: TObject);
    procedure UpdateIPTimerTimer(Sender: TObject);
    procedure Startalarm1Click(Sender: TObject);
    procedure Stopalarm1Click(Sender: TObject);
    procedure Gotocontrolpanelwebsite1Click(Sender: TObject);
    procedure ImageClick(Sender: TObject);
    procedure Simulatealarm1Click(Sender: TObject);
  private
    MJPEGDecoder: TMJPEGDecoder;
    LastDingDong: TDateTime;
    SimpleCS: boolean;
    ini: TMemIniFile;
    last_known_webcam_port: integer;
    procedure ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure MotionDetected;
    procedure HandleFrame(Sender: TObject; Frame: TJPEGImage);
    procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
    procedure StartStream;
    procedure StopStream;
    procedure DoShowForm(AlarmType: TAlarmType);
    procedure DoPosition;
    procedure StopMusic;
    function ControlServerUrl: string;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  mmSystem, idhttp, DateUtils, ActiveX, ComObj, AudioVolCntrl, ShellAPI;
 
var
  Server: TIdHTTPServer;
  gShuttingDown: boolean;
 
procedure CallUrl(const url: string);
var
  idhttp: TIdHTTP;
begin
  if url <> '' then
  begin
    idhttp := TIdHTTP.Create(nil);
    try
      idhttp.Get(url);
    finally
      FreeAndNil(idhttp);
    end;
  end;
end;
 
procedure TForm1.Stopalarm1Click(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  //try
    try
      UpdateIPTimerTimer(UpdateIPTimer); // make sure we are registered
 
      lParamList := TStringList.Create;
      lParamList.Add('action=motion_off'); // 1.3.6.1.4.1.37476.2.4.1.101
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  //except
    // Nothing
  //end;
end;
 
procedure TForm1.StopMusic;
const
  TIMEOUT = 1000; // ms
var
  lpdwResult: DWORD;
begin
  // Stops Spotify, WMP, etc.
  lpdwResult := 0;
  SendMessageTimeout(HWND_BROADCAST, WM_APPCOMMAND, 0, MAKELONG(0, APPCOMMAND_MEDIA_STOP), SMTO_NORMAL, TIMEOUT, lpdwResult);
 
  // Mutes everything (also YouTube)
  if Allowmutingsoundinterface1.Checked then
  begin
    OleCheck(CoInitialize(nil));
    try
      MuteAllAudioDevices(true);
    finally
      CoUninitialize;
    end;
  end;
end;
 
procedure TForm1.HandleFrame(Sender: TObject; Frame: TJPEGImage);
begin
  try
    Image1.Picture.Bitmap.Assign(Frame);
 
    Left := Left + (ClientWidth  - Image1.Picture.Width);
    Top  := Top  + (ClientHeight - Image1.Picture.Height);
 
    ClientWidth := Image1.Picture.Width;
    ClientHeight := Image1.Picture.Height;
  finally
    Frame.Free;
  end;
end;
 
procedure TForm1.ImageClick(Sender: TObject);
(*
var
  pnt: TPoint;
*)
begin
  (*
  if GetCursorPos(pnt) then
    PopupMenu1.Popup(pnt.X, pnt.Y);
  *)
end;
 
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
  gShuttingDown := true;
  Message.Result := 1;
end;
 
procedure TForm1.Startalarm1Click(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  //try
    try
      UpdateIPTimerTimer(UpdateIPTimer); // make sure we are registered
 
      lParamList := TStringList.Create;
      lParamList.Add('action=motion_on'); // 1.3.6.1.4.1.37476.2.4.1.100
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  //except
    // Nothing
  //end;
end;
 
procedure TForm1.StartStream;
begin
  if last_known_webcam_port = 0 then exit;
 
  MJPEGDecoder.OnFrame := HandleFrame;
  MJPEGDecoder.OnError := nil;
  MJPEGDecoder.OnMessage := nil;
  MJPEGDecoder.Connect(ini.ReadString('Server', 'Address', '127.0.0.1'),
                       last_known_webcam_port,
                       '/');
end;
 
procedure TForm1.StopStream;
begin
  MJPEGDecoder.Disconnect;
end;
 
procedure TForm1.CloseTimerTimer(Sender: TObject);
begin
  CloseTimer.Enabled := false;
  Close;
end;
 
procedure TForm1.MotionDetected;
var
  AlarmSound: string;
  DingDongMinInterval: integer;
begin
  DingDongMinInterval := ini.ReadInteger('Sound', 'AlarmMinInterval', 10);
  if SecondsBetween(Now, LastDingDong) > DingDongMinInterval then
  begin
    LastDingDong := Now;
 
    if ini.ReadBool('Sound', 'StopMusic', true) then
    begin
      StopMusic;
    end;
 
    AlarmSound := ini.ReadString('Sound', 'AlarmSoundFile', '');
    if AlarmSound <> '' then
    begin
      PlaySound(PChar(AlarmSound), 0, SND_ALIAS or SND_ASYNC);
    end;
  end;
end;
 
procedure TForm1.Exit1Click(Sender: TObject);
begin
  gShuttingDown := true;
  Close;
end;
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CloseTimer.Enabled := false;
  CanClose := gShuttingDown;
  if not CanClose then Hide;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
 
  DoubleBuffered := true;
 
  Server := TIdHTTPServer.Create();
  Server.DefaultPort := ini.ReadInteger('Client', 'ListenPort', 80);
  Server.OnCommandGet := ServerCommandGet;
  Server.Active := true;
 
  Gotocontrolpanelwebsite1.Visible := true;
  Startalarm1.Visible := true;
  Stopalarm1.Visible := true;
  N2.Visible := Gotocontrolpanelwebsite1.Visible or Startalarm1.Visible or Stopalarm1.Visible;
 
  MJPEGDecoder := TMJPEGDecoder.Create(Self);
 
  DoPosition;
 
  // Question: Should these settings also be saved for the next program session?
  Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false);
  Ignoredoorbell1.Checked := ini.ReadBool('Client', 'IgnoreDoorbell', false);
  Ignoremotionalert1.Checked := ini.ReadBool('Client', 'IgnoreMotion', false);
 
  UpdateIPTimerTimer(UpdateIPTimer);
  UpdateIPTimer.Interval := ini.ReadInteger('Client', 'SubscribeInterval', 30*60) * 1000;
  UpdateIPTimer.Enabled := true;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(Server) then Server.Active := false;
  FreeAndNil(Server);
 
  FreeAndNil(ini);
 
  FreeAndNil(MJPEGDecoder);
end;
 
procedure TForm1.FormHide(Sender: TObject);
begin
  if Image2.Visible then
    StopStream;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
  if Image2.Visible then
    StartStream;
end;
 
procedure TForm1.Gotocontrolpanelwebsite1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', PChar(ControlServerUrl), '', '', SW_NORMAL);
end;
 
procedure TForm1.Open1Click(Sender: TObject);
begin
  TrayIcon1Click(TrayIcon1);
end;
 
procedure TForm1.ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  AutoCloseTimerInterval: integer;
  AlarmType: TAlarmType;
begin
  aResponseInfo.ResponseNo  := 200;
  aResponseInfo.ContentType := 'text/html';
  aResponseInfo.ContentText := '';
 
  if (ARequestInfo.CommandType = hcPOST) and
     (ARequestInfo.Params.Values['action'] = 'client_alert') then // 1.3.6.1.4.1.37476.2.4.1.3
  begin
    if ARequestInfo.Params.Values['motion_port'] <> '' then
    begin
      TryStrToInt(ARequestInfo.Params.Values['motion_port'], last_known_webcam_port);
    end;
 
    if ARequestInfo.Params.Values['simulation'] = '1' then
    begin
      exit;
    end;
 
    if SimpleCS then exit;
    SimpleCS := true;
    try
      if CloseTimer.Enabled then
      begin
        CloseTimer.Enabled := false;
        CloseTimer.Enabled := true; // "Restart" timer
      end;
 
      AutoCloseTimerInterval := ini.ReadInteger('Client', 'AutoCloseTimer', 5000);
      if (not Visible) and (AutoCloseTimerInterval <> -1) then
      begin
        CloseTimer.Interval := AutoCloseTimerInterval;
        CloseTimer.Enabled := true;
      end;
 
      if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.1002' {camera, motion}) >= 0 then
        AlarmType := atMotion
      else if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.2001' {sound, doorbell}) >= 0 then
        AlarmType := atDoorbell
      else
      begin
        // TODO: Make plugin DLLs ?
        AlarmType := atUnknown;
      end;
 
      // Attention: Ignoring these events at the client does not prevent the server
      // doing other actions (e.g. ask Spotify to stop the music on connected devices)
      if Ignoredoorbell1.Checked and (AlarmType = atDoorbell) then Exit;
      if Ignoremotionalert1.Checked and (AlarmType = atMotion) then Exit;
 
      if AlarmType = atUnknown then
      begin
        unknownAlarm.ShowHint := true;
        unknownAlarm.Hint := ARequestInfo.Params.Text;
      end;
      DoShowForm(AlarmType);
 
      if ini.ReadBool('Client', 'AutoPopup', true) then
      begin
        Application.Restore;
        WindowState := wsNormal;
      end;
 
      if ini.ReadBool('Client', 'AlarmStayOnTop', true) then
        FormStyle := fsStayOnTop
      else
        FormStyle := fsNormal;
 
      MotionDetected;
    finally
      SimpleCS := false;
    end;
  end;
end;
 
procedure TForm1.Simulatealarm1Click(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  //try
    try
      lParamList := TStringList.Create;
      lParamList.Add('action=server_alert'); // 1.3.6.1.4.1.37476.2.4.1.2
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0');    // Any
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  //except
    // Nothing
  //end;
end;
 
procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
  // TODO: when clicked, the icon-selection won't close
  Application.Restore;
  WindowState := wsNormal;
  FormStyle := fsNormal;
  DoShowForm(atMotion);
end;
 
procedure TForm1.UpdateIPTimerTimer(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  try
    try
      lParamList := TStringList.Create;
      lParamList.Add('action=client_subscribe'); // 1.3.6.1.4.1.37476.2.4.1.1
      lParamList.Add('port='+ini.ReadString('Client', 'ListenPort', ''));
      lParamList.Add('ttl='+IntToStr((UpdateIPTimer.Interval div 1000) * 2 + 10));
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0');    // Any
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  except
    // Nothing
  end;
end;
 
function TForm1.ControlServerUrl: string;
begin
  result := 'http://' + ini.ReadString('Server', 'Address', '127.0.0.1') + ':' + ini.ReadString('Server', 'Port', '80') + '/';
end;
 
procedure TForm1.DoPosition;
  function _TaskBarHeight: integer;
  var
    hTB: HWND;
    TBRect: TRect;
  begin
    hTB := FindWindow('Shell_TrayWnd', '');
    if hTB = 0 then
      Result := 0
    else
    begin
      GetWindowRect(hTB, TBRect);
      Result := TBRect.Bottom - TBRect.Top;
    end;
  end;
begin
  // TODO: modify this code so that it works also if the task bar is on top or on the right corner of the screen
  // TODO: user should select in which corner the window show be
  Self.Left := Screen.Width - Self.Width;
  Self.Top := Screen.Height - Self.Height - _TaskBarHeight;
end;
 
procedure TForm1.DoShowForm(AlarmType: TAlarmType);
begin
  Image1.Visible := AlarmType = atMotion;
  Image2.Visible := AlarmType = atMotion;
 
  // BUGBUG! TODO: This does not work. The panels are not visible for some reason! I just get a white window!
  doorbellPanel.Visible := AlarmType = atDoorbell;
  unknownAlarm.Visible := AlarmType = atUnknown;
 
  if ini.ReadBool('Client', 'AutoReposition', true) then
  begin
    DoPosition;
  end;
 
  Show;
end;
 
end.
 

Rev 7	Rev 9
1	unit DoorAlarmClientMain;	1	unit DoorAlarmClientMain;
2		2
3	// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected, with different event sounds etc	3	// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected, with different event sounds etc
4	// TODO: ask server to subscribe/unsubscribe to events (doorbell, motion)	4	// TODO: ask server to subscribe/unsubscribe to events (doorbell, motion)
5		5
6	interface	6	interface
7		7
8	uses	8	uses
9	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,	9	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
10	Dialogs, HTTPApp, StdCtrls,	10	Dialogs, HTTPApp, StdCtrls,
11	IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,	11	IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,
12	JPEG, MJPEGDecoderUnit, IniFiles, Menus;	12	JPEG, MJPEGDecoderUnit, IniFiles, Menus;
13		13
14	type	14	type
15	TAlarmType = (atUnknown, atMotion, atDoorbell);	15	TAlarmType = (atUnknown, atMotion, atDoorbell);
16		16
17	TForm1 = class(TForm)	17	TForm1 = class(TForm)
18	Image1: TImage;	18	Image1: TImage;
19	TrayIcon1: TTrayIcon;	19	TrayIcon1: TTrayIcon;
20	PopupMenu1: TPopupMenu;	20	PopupMenu1: TPopupMenu;
21	Exit1: TMenuItem;	21	Exit1: TMenuItem;
22	Open1: TMenuItem;	22	Open1: TMenuItem;
23	Image2: TImage;	23	Image2: TImage;
24	CloseTimer: TTimer;	24	CloseTimer: TTimer;
25	UpdateIPTimer: TTimer;	25	UpdateIPTimer: TTimer;
26	Allowmutingsoundinterface1: TMenuItem;	26	Allowmutingsoundinterface1: TMenuItem;
27	N1: TMenuItem;	27	N1: TMenuItem;
28	Startalarm1: TMenuItem;	28	Startalarm1: TMenuItem;
29	N2: TMenuItem;	29	N2: TMenuItem;
30	Stopalarm1: TMenuItem;	30	Stopalarm1: TMenuItem;
31	Gotocontrolpanelwebsite1: TMenuItem;	31	Gotocontrolpanelwebsite1: TMenuItem;
32	doorbellPanel: TPanel;	32	doorbellPanel: TPanel;
33	N3: TMenuItem;	33	N3: TMenuItem;
34	Ignoredoorbell1: TMenuItem;	34	Ignoredoorbell1: TMenuItem;
35	Ignoremotionalert1: TMenuItem;	35	Ignoremotionalert1: TMenuItem;
36	unknownAlarm: TPanel;	36	unknownAlarm: TPanel;
-		37	Simulatealarm1: TMenuItem;
37	procedure FormDestroy(Sender: TObject);	38	procedure FormDestroy(Sender: TObject);
38	procedure FormCreate(Sender: TObject);	39	procedure FormCreate(Sender: TObject);
39	procedure TrayIcon1Click(Sender: TObject);	40	procedure TrayIcon1Click(Sender: TObject);
40	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	41	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
41	procedure Exit1Click(Sender: TObject);	42	procedure Exit1Click(Sender: TObject);
42	procedure Open1Click(Sender: TObject);	43	procedure Open1Click(Sender: TObject);
43	procedure FormShow(Sender: TObject);	44	procedure FormShow(Sender: TObject);
44	procedure FormHide(Sender: TObject);	45	procedure FormHide(Sender: TObject);
45	procedure CloseTimerTimer(Sender: TObject);	46	procedure CloseTimerTimer(Sender: TObject);
46	procedure UpdateIPTimerTimer(Sender: TObject);	47	procedure UpdateIPTimerTimer(Sender: TObject);
47	procedure Startalarm1Click(Sender: TObject);	48	procedure Startalarm1Click(Sender: TObject);
48	procedure Stopalarm1Click(Sender: TObject);	49	procedure Stopalarm1Click(Sender: TObject);
49	procedure Gotocontrolpanelwebsite1Click(Sender: TObject);	50	procedure Gotocontrolpanelwebsite1Click(Sender: TObject);
50	procedure ImageClick(Sender: TObject);	51	procedure ImageClick(Sender: TObject);
-		52	procedure Simulatealarm1Click(Sender: TObject);
51	private	53	private
52	MJPEGDecoder: TMJPEGDecoder;	54	MJPEGDecoder: TMJPEGDecoder;
53	LastDingDong: TDateTime;	55	LastDingDong: TDateTime;
54	SimpleCS: boolean;	56	SimpleCS: boolean;
55	ini: TMemIniFile;	57	ini: TMemIniFile;
56	last_known_webcam_port: integer;	58	last_known_webcam_port: integer;
57	procedure ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);	59	procedure ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
58	procedure MotionDetected;	60	procedure MotionDetected;
59	procedure HandleFrame(Sender: TObject; Frame: TJPEGImage);	61	procedure HandleFrame(Sender: TObject; Frame: TJPEGImage);
60	procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;	62	procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
61	procedure StartStream;	63	procedure StartStream;
62	procedure StopStream;	64	procedure StopStream;
63	procedure DoShowForm(AlarmType: TAlarmType);	65	procedure DoShowForm(AlarmType: TAlarmType);
64	procedure DoPosition;	66	procedure DoPosition;
65	procedure StopMusic;	67	procedure StopMusic;
66	function ControlServerUrl: string;	68	function ControlServerUrl: string;
67	end;	69	end;
68		70
69	var	71	var
70	Form1: TForm1;	72	Form1: TForm1;
71		73
72	implementation	74	implementation
73		75
74	{$R *.dfm}	76	{$R *.dfm}
75		77
76	uses	78	uses
77	mmSystem, idhttp, DateUtils, ActiveX, ComObj, AudioVolCntrl, ShellAPI;	79	mmSystem, idhttp, DateUtils, ActiveX, ComObj, AudioVolCntrl, ShellAPI;
78		80
79	var	81	var
80	Server: TIdHTTPServer;	82	Server: TIdHTTPServer;
81	gShuttingDown: boolean;	83	gShuttingDown: boolean;
82		84
83	procedure CallUrl(const url: string);	85	procedure CallUrl(const url: string);
84	var	86	var
85	idhttp: TIdHTTP;	87	idhttp: TIdHTTP;
86	begin	88	begin
87	if url <> '' then	89	if url <> '' then
88	begin	90	begin
89	idhttp := TIdHTTP.Create(nil);	91	idhttp := TIdHTTP.Create(nil);
90	try	92	try
91	idhttp.Get(url);	93	idhttp.Get(url);
92	finally	94	finally
93	FreeAndNil(idhttp);	95	FreeAndNil(idhttp);
94	end;	96	end;
95	end;	97	end;
96	end;	98	end;
97		99
98	procedure TForm1.Stopalarm1Click(Sender: TObject);	100	procedure TForm1.Stopalarm1Click(Sender: TObject);
99	var	101	var
100	lParamList: TStringList;	102	lParamList: TStringList;
101	idhttp: TIdHttp;	103	idhttp: TIdHttp;
102	begin	104	begin
-		105	//try
103	try	106	try
-		107	UpdateIPTimerTimer(UpdateIPTimer); // make sure we are registered
104	try	108
105	lParamList := TStringList.Create;	109	lParamList := TStringList.Create;
106	lParamList.Add('action=motion_off'); // 1.3.6.1.4.1.37476.2.4.1.101	110	lParamList.Add('action=motion_off'); // 1.3.6.1.4.1.37476.2.4.1.101
107		111
108	idhttp := TIdHTTP.Create(nil);	112	idhttp := TIdHTTP.Create(nil);
109	try	113	try
110	idhttp.Post(ControlServerUrl, lParamList);	114	idhttp.Post(ControlServerUrl, lParamList);
111	finally	115	finally
112	FreeAndNil(idhttp);	116	FreeAndNil(idhttp);
113	end;	117	end;
114	finally	118	finally
115	FreeAndNil(lParamList);	119	FreeAndNil(lParamList);
116	end;	120	end;
117	except	121	//except
118	// Nothing	122	// Nothing
119	end;	123	//end;
120	end;	124	end;
121		125
122	procedure TForm1.StopMusic;	126	procedure TForm1.StopMusic;
123	const	127	const
124	TIMEOUT = 1000; // ms	128	TIMEOUT = 1000; // ms
125	var	129	var
126	lpdwResult: DWORD;	130	lpdwResult: DWORD;
127	begin	131	begin
128	// Stops Spotify, WMP, etc.	132	// Stops Spotify, WMP, etc.
129	lpdwResult := 0;	133	lpdwResult := 0;
130	SendMessageTimeout(HWND_BROADCAST, WM_APPCOMMAND, 0, MAKELONG(0, APPCOMMAND_MEDIA_STOP), SMTO_NORMAL, TIMEOUT, lpdwResult);	134	SendMessageTimeout(HWND_BROADCAST, WM_APPCOMMAND, 0, MAKELONG(0, APPCOMMAND_MEDIA_STOP), SMTO_NORMAL, TIMEOUT, lpdwResult);
131		135
132	// Mutes everything (also YouTube)	136	// Mutes everything (also YouTube)
133	if Allowmutingsoundinterface1.Checked then	137	if Allowmutingsoundinterface1.Checked then
134	begin	138	begin
135	OleCheck(CoInitialize(nil));	139	OleCheck(CoInitialize(nil));
136	try	140	try
137	MuteAllAudioDevices(true);	141	MuteAllAudioDevices(true);
138	finally	142	finally
139	CoUninitialize;	143	CoUninitialize;
140	end;	144	end;
141	end;	145	end;
142	end;	146	end;
143		147
144	procedure TForm1.HandleFrame(Sender: TObject; Frame: TJPEGImage);	148	procedure TForm1.HandleFrame(Sender: TObject; Frame: TJPEGImage);
145	begin	149	begin
146	try	150	try
147	Image1.Picture.Bitmap.Assign(Frame);	151	Image1.Picture.Bitmap.Assign(Frame);
148		152
149	Left := Left + (ClientWidth - Image1.Picture.Width);	153	Left := Left + (ClientWidth - Image1.Picture.Width);
150	Top := Top + (ClientHeight - Image1.Picture.Height);	154	Top := Top + (ClientHeight - Image1.Picture.Height);
151		155
152	ClientWidth := Image1.Picture.Width;	156	ClientWidth := Image1.Picture.Width;
153	ClientHeight := Image1.Picture.Height;	157	ClientHeight := Image1.Picture.Height;
154	finally	158	finally
155	Frame.Free;	159	Frame.Free;
156	end;	160	end;
157	end;	161	end;
158		162
159	procedure TForm1.ImageClick(Sender: TObject);	163	procedure TForm1.ImageClick(Sender: TObject);
160	(*	164	(*
161	var	165	var
162	pnt: TPoint;	166	pnt: TPoint;
163	*)	167	*)
164	begin	168	begin
165	(*	169	(*
166	if GetCursorPos(pnt) then	170	if GetCursorPos(pnt) then
167	PopupMenu1.Popup(pnt.X, pnt.Y);	171	PopupMenu1.Popup(pnt.X, pnt.Y);
168	*)	172	*)
169	end;	173	end;
170		174
171	procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);	175	procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
172	begin	176	begin
173	gShuttingDown := true;	177	gShuttingDown := true;
174	Message.Result := 1;	178	Message.Result := 1;
175	end;	179	end;
176		180
177	procedure TForm1.Startalarm1Click(Sender: TObject);	181	procedure TForm1.Startalarm1Click(Sender: TObject);
178	var	182	var
179	lParamList: TStringList;	183	lParamList: TStringList;
180	idhttp: TIdHttp;	184	idhttp: TIdHttp;
181	begin	185	begin
-		186	//try
182	try	187	try
-		188	UpdateIPTimerTimer(UpdateIPTimer); // make sure we are registered
183	try	189
184	lParamList := TStringList.Create;	190	lParamList := TStringList.Create;
185	lParamList.Add('action=motion_on'); // 1.3.6.1.4.1.37476.2.4.1.100	191	lParamList.Add('action=motion_on'); // 1.3.6.1.4.1.37476.2.4.1.100
186		192
187	idhttp := TIdHTTP.Create(nil);	193	idhttp := TIdHTTP.Create(nil);
188	try	194	try
189	idhttp.Post(ControlServerUrl, lParamList);	195	idhttp.Post(ControlServerUrl, lParamList);
190	finally	196	finally
191	FreeAndNil(idhttp);	197	FreeAndNil(idhttp);
192	end;	198	end;
193	finally	199	finally
194	FreeAndNil(lParamList);	200	FreeAndNil(lParamList);
195	end;	201	end;
196	except	202	//except
197	// Nothing	203	// Nothing
198	end;	204	//end;
199	end;	205	end;
200		206
201	procedure TForm1.StartStream;	207	procedure TForm1.StartStream;
202	begin	208	begin
203	if last_known_webcam_port = 0 then exit;	209	if last_known_webcam_port = 0 then exit;
204		210
205	MJPEGDecoder.OnFrame := HandleFrame;	211	MJPEGDecoder.OnFrame := HandleFrame;
206	MJPEGDecoder.OnError := nil;	212	MJPEGDecoder.OnError := nil;
207	MJPEGDecoder.OnMessage := nil;	213	MJPEGDecoder.OnMessage := nil;
208	MJPEGDecoder.Connect(ini.ReadString('Server', 'Address', '127.0.0.1'),	214	MJPEGDecoder.Connect(ini.ReadString('Server', 'Address', '127.0.0.1'),
209	last_known_webcam_port,	215	last_known_webcam_port,
210	'/');	216	'/');
211	end;	217	end;
212		218
213	procedure TForm1.StopStream;	219	procedure TForm1.StopStream;
214	begin	220	begin
215	MJPEGDecoder.Disconnect;	221	MJPEGDecoder.Disconnect;
216	end;	222	end;
217		223
218	procedure TForm1.CloseTimerTimer(Sender: TObject);	224	procedure TForm1.CloseTimerTimer(Sender: TObject);
219	begin	225	begin
220	CloseTimer.Enabled := false;	226	CloseTimer.Enabled := false;
221	Close;	227	Close;
222	end;	228	end;
223		229
224	procedure TForm1.MotionDetected;	230	procedure TForm1.MotionDetected;
225	var	231	var
226	AlarmSound: string;	232	AlarmSound: string;
227	DingDongMinInterval: integer;	233	DingDongMinInterval: integer;
228	begin	234	begin
229	DingDongMinInterval := ini.ReadInteger('Sound', 'AlarmMinInterval', 10);	235	DingDongMinInterval := ini.ReadInteger('Sound', 'AlarmMinInterval', 10);
230	if SecondsBetween(Now, LastDingDong) > DingDongMinInterval then	236	if SecondsBetween(Now, LastDingDong) > DingDongMinInterval then
231	begin	237	begin
232	LastDingDong := Now;	238	LastDingDong := Now;
233		239
234	if ini.ReadBool('Sound', 'StopMusic', true) then	240	if ini.ReadBool('Sound', 'StopMusic', true) then
235	begin	241	begin
236	StopMusic;	242	StopMusic;
237	end;	243	end;
238		244
239	AlarmSound := ini.ReadString('Sound', 'AlarmSoundFile', '');	245	AlarmSound := ini.ReadString('Sound', 'AlarmSoundFile', '');
240	if AlarmSound <> '' then	246	if AlarmSound <> '' then
241	begin	247	begin
242	PlaySound(PChar(AlarmSound), 0, SND_ALIAS or SND_ASYNC);	248	PlaySound(PChar(AlarmSound), 0, SND_ALIAS or SND_ASYNC);
243	end;	249	end;
244	end;	250	end;
245	end;	251	end;
246		252
247	procedure TForm1.Exit1Click(Sender: TObject);	253	procedure TForm1.Exit1Click(Sender: TObject);
248	begin	254	begin
249	gShuttingDown := true;	255	gShuttingDown := true;
250	Close;	256	Close;
251	end;	257	end;
252		258
253	procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);	259	procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
254	begin	260	begin
255	CloseTimer.Enabled := false;	261	CloseTimer.Enabled := false;
256	CanClose := gShuttingDown;	262	CanClose := gShuttingDown;
257	if not CanClose then Hide;	263	if not CanClose then Hide;
258	end;	264	end;
259		265
260	procedure TForm1.FormCreate(Sender: TObject);	266	procedure TForm1.FormCreate(Sender: TObject);
261	begin	267	begin
262	ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));	268	ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
263		269
264	DoubleBuffered := true;	270	DoubleBuffered := true;
265		271
266	Server := TIdHTTPServer.Create();	272	Server := TIdHTTPServer.Create();
267	Server.DefaultPort := ini.ReadInteger('Client', 'ListenPort', 80);	273	Server.DefaultPort := ini.ReadInteger('Client', 'ListenPort', 80);
268	Server.OnCommandGet := ServerCommandGet;	274	Server.OnCommandGet := ServerCommandGet;
269	Server.Active := true;	275	Server.Active := true;
270		276
271	Gotocontrolpanelwebsite1.Visible := true;	277	Gotocontrolpanelwebsite1.Visible := true;
272	Startalarm1.Visible := true;	278	Startalarm1.Visible := true;
273	Stopalarm1.Visible := true;	279	Stopalarm1.Visible := true;
274	N2.Visible := Gotocontrolpanelwebsite1.Visible or Startalarm1.Visible or Stopalarm1.Visible;	280	N2.Visible := Gotocontrolpanelwebsite1.Visible or Startalarm1.Visible or Stopalarm1.Visible;
275		281
276	MJPEGDecoder := TMJPEGDecoder.Create(Self);	282	MJPEGDecoder := TMJPEGDecoder.Create(Self);
277		283
278	DoPosition;	284	DoPosition;
279		285
280	// Question: Should these settings also be saved for the next program session?	286	// Question: Should these settings also be saved for the next program session?
281	Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false);	287	Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false);
282	Ignoredoorbell1.Checked := ini.ReadBool('Client', 'IgnoreDoorbell', false);	288	Ignoredoorbell1.Checked := ini.ReadBool('Client', 'IgnoreDoorbell', false);
283	Ignoremotionalert1.Checked := ini.ReadBool('Client', 'IgnoreMotion', false);	289	Ignoremotionalert1.Checked := ini.ReadBool('Client', 'IgnoreMotion', false);
284		290
285	UpdateIPTimerTimer(UpdateIPTimer);	291	UpdateIPTimerTimer(UpdateIPTimer);
286	UpdateIPTimer.Interval := ini.ReadInteger('Client', 'SubscribeInterval', 3060) 1000;	292	UpdateIPTimer.Interval := ini.ReadInteger('Client', 'SubscribeInterval', 3060) 1000;
287	UpdateIPTimer.Enabled := true;	293	UpdateIPTimer.Enabled := true;
288	end;	294	end;
289		295
290	procedure TForm1.FormDestroy(Sender: TObject);	296	procedure TForm1.FormDestroy(Sender: TObject);
291	begin	297	begin
292	if Assigned(Server) then Server.Active := false;	298	if Assigned(Server) then Server.Active := false;
293	FreeAndNil(Server);	299	FreeAndNil(Server);
294		300
295	FreeAndNil(ini);	301	FreeAndNil(ini);
296		302
297	FreeAndNil(MJPEGDecoder);	303	FreeAndNil(MJPEGDecoder);
298	end;	304	end;
299		305
300	procedure TForm1.FormHide(Sender: TObject);	306	procedure TForm1.FormHide(Sender: TObject);
301	begin	307	begin
302	if Image2.Visible then	308	if Image2.Visible then
303	StopStream;	309	StopStream;
304	end;	310	end;
305		311
306	procedure TForm1.FormShow(Sender: TObject);	312	procedure TForm1.FormShow(Sender: TObject);
307	begin	313	begin
308	if Image2.Visible then	314	if Image2.Visible then
309	StartStream;	315	StartStream;
310	end;	316	end;
311		317
312	procedure TForm1.Gotocontrolpanelwebsite1Click(Sender: TObject);	318	procedure TForm1.Gotocontrolpanelwebsite1Click(Sender: TObject);
313	begin	319	begin
314	ShellExecute(Handle, 'open', PChar(ControlServerUrl), '', '', SW_NORMAL);	320	ShellExecute(Handle, 'open', PChar(ControlServerUrl), '', '', SW_NORMAL);
315	end;	321	end;
316		322
317	procedure TForm1.Open1Click(Sender: TObject);	323	procedure TForm1.Open1Click(Sender: TObject);
318	begin	324	begin
319	TrayIcon1Click(TrayIcon1);	325	TrayIcon1Click(TrayIcon1);
320	end;	326	end;
321		327
322	procedure TForm1.ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);	328	procedure TForm1.ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
323	var	329	var
324	AutoCloseTimerInterval: integer;	330	AutoCloseTimerInterval: integer;
325	AlarmType: TAlarmType;	331	AlarmType: TAlarmType;
326	begin	332	begin
327	aResponseInfo.ResponseNo := 200;	333	aResponseInfo.ResponseNo := 200;
328	aResponseInfo.ContentType := 'text/html';	334	aResponseInfo.ContentType := 'text/html';
329	aResponseInfo.ContentText := '';	335	aResponseInfo.ContentText := '';
330		336
331	if (ARequestInfo.CommandType = hcPOST) and	337	if (ARequestInfo.CommandType = hcPOST) and
332	(ARequestInfo.Params.Values['action'] = 'client_alert') then // 1.3.6.1.4.1.37476.2.4.1.3	338	(ARequestInfo.Params.Values['action'] = 'client_alert') then // 1.3.6.1.4.1.37476.2.4.1.3
333	begin	339	begin
334	if ARequestInfo.Params.Values['motion_port'] <> '' then	340	if ARequestInfo.Params.Values['motion_port'] <> '' then
335	begin	341	begin
336	TryStrToInt(ARequestInfo.Params.Values['motion_port'], last_known_webcam_port);	342	TryStrToInt(ARequestInfo.Params.Values['motion_port'], last_known_webcam_port);
337	end;	343	end;
338		344
339	if ARequestInfo.Params.Values['simulation'] = '1' then	345	if ARequestInfo.Params.Values['simulation'] = '1' then
340	begin	346	begin
341	exit;	347	exit;
342	end;	348	end;
343		349
344	if SimpleCS then exit;	350	if SimpleCS then exit;
345	SimpleCS := true;	351	SimpleCS := true;
346	try	352	try
347	if CloseTimer.Enabled then	353	if CloseTimer.Enabled then
348	begin	354	begin
349	CloseTimer.Enabled := false;	355	CloseTimer.Enabled := false;
350	CloseTimer.Enabled := true; // "Restart" timer	356	CloseTimer.Enabled := true; // "Restart" timer
351	end;	357	end;
352		358
353	AutoCloseTimerInterval := ini.ReadInteger('Client', 'AutoCloseTimer', 5000);	359	AutoCloseTimerInterval := ini.ReadInteger('Client', 'AutoCloseTimer', 5000);
354	if (not Visible) and (AutoCloseTimerInterval <> -1) then	360	if (not Visible) and (AutoCloseTimerInterval <> -1) then
355	begin	361	begin
356	CloseTimer.Interval := AutoCloseTimerInterval;	362	CloseTimer.Interval := AutoCloseTimerInterval;
357	CloseTimer.Enabled := true;	363	CloseTimer.Enabled := true;
358	end;	364	end;
359		365
360	if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.1002' {camera, motion}) >= 0 then	366	if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.1002' {camera, motion}) >= 0 then
361	AlarmType := atMotion	367	AlarmType := atMotion
362	else if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.2001' {sound, doorbell}) >= 0 then	368	else if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.2001' {sound, doorbell}) >= 0 then
363	AlarmType := atDoorbell	369	AlarmType := atDoorbell
364	else	370	else
365	begin	371	begin
366	// TODO: Make plugin DLLs ?	372	// TODO: Make plugin DLLs ?
367	AlarmType := atUnknown;	373	AlarmType := atUnknown;
368	end;	374	end;
369		375
370	// Attention: Ignoring these events at the client does not prevent the server	376	// Attention: Ignoring these events at the client does not prevent the server
371	// doing other actions (e.g. ask Spotify to stop the music on connected devices)	377	// doing other actions (e.g. ask Spotify to stop the music on connected devices)
372	if Ignoredoorbell1.Checked and (AlarmType = atDoorbell) then Exit;	378	if Ignoredoorbell1.Checked and (AlarmType = atDoorbell) then Exit;
373	if Ignoremotionalert1.Checked and (AlarmType = atMotion) then Exit;	379	if Ignoremotionalert1.Checked and (AlarmType = atMotion) then Exit;
374		380
375	if AlarmType = atUnknown then	381	if AlarmType = atUnknown then
376	begin	382	begin
377	unknownAlarm.ShowHint := true;	383	unknownAlarm.ShowHint := true;
378	unknownAlarm.Hint := ARequestInfo.Params.Text;	384	unknownAlarm.Hint := ARequestInfo.Params.Text;
379	end;	385	end;
380	DoShowForm(AlarmType);	386	DoShowForm(AlarmType);
381		387
382	if ini.ReadBool('Client', 'AutoPopup', true) then	388	if ini.ReadBool('Client', 'AutoPopup', true) then
383	begin	389	begin
384	Application.Restore;	390	Application.Restore;
385	WindowState := wsNormal;	391	WindowState := wsNormal;
386	end;	392	end;
387		393
388	if ini.ReadBool('Client', 'AlarmStayOnTop', true) then	394	if ini.ReadBool('Client', 'AlarmStayOnTop', true) then
389	FormStyle := fsStayOnTop	395	FormStyle := fsStayOnTop
390	else	396	else
391	FormStyle := fsNormal;	397	FormStyle := fsNormal;
392		398
393	MotionDetected;	399	MotionDetected;
394	finally	400	finally
395	SimpleCS := false;	401	SimpleCS := false;
396	end;	402	end;
397	end;	403	end;
398	end;	404	end;
-		405
-		406	procedure TForm1.Simulatealarm1Click(Sender: TObject);
-		407	var
-		408	lParamList: TStringList;
-		409	idhttp: TIdHttp;
-		410	begin
-		411	//try
-		412	try
-		413	lParamList := TStringList.Create;
-		414	lParamList.Add('action=server_alert'); // 1.3.6.1.4.1.37476.2.4.1.2
-		415	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0'); // Any
-		416	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera
-		417	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell
-		418
-		419	idhttp := TIdHTTP.Create(nil);
-		420	try
-		421	idhttp.Post(ControlServerUrl, lParamList);
-		422	finally
-		423	FreeAndNil(idhttp);
-		424	end;
-		425	finally
-		426	FreeAndNil(lParamList);
-		427	end;
-		428	//except
-		429	// Nothing
-		430	//end;
-		431	end;
399		432
400	procedure TForm1.TrayIcon1Click(Sender: TObject);	433	procedure TForm1.TrayIcon1Click(Sender: TObject);
401	begin	434	begin
402	// TODO: when clicked, the icon-selection won't close	435	// TODO: when clicked, the icon-selection won't close
403	Application.Restore;	436	Application.Restore;
404	WindowState := wsNormal;	437	WindowState := wsNormal;
405	FormStyle := fsNormal;	438	FormStyle := fsNormal;
406	DoShowForm(atMotion);	439	DoShowForm(atMotion);
407	end;	440	end;
408		441
409	procedure TForm1.UpdateIPTimerTimer(Sender: TObject);	442	procedure TForm1.UpdateIPTimerTimer(Sender: TObject);
410	var	443	var
411	lParamList: TStringList;	444	lParamList: TStringList;
412	idhttp: TIdHttp;	445	idhttp: TIdHttp;
413	begin	446	begin
414	try	447	try
415	try	448	try
416	lParamList := TStringList.Create;	449	lParamList := TStringList.Create;
417	lParamList.Add('action=client_subscribe'); // 1.3.6.1.4.1.37476.2.4.1.1	450	lParamList.Add('action=client_subscribe'); // 1.3.6.1.4.1.37476.2.4.1.1
418	lParamList.Add('port='+ini.ReadString('Client', 'ListenPort', ''));	451	lParamList.Add('port='+ini.ReadString('Client', 'ListenPort', ''));
419	lParamList.Add('ttl='+IntToStr((UpdateIPTimer.Interval div 1000) * 2 + 10));	452	lParamList.Add('ttl='+IntToStr((UpdateIPTimer.Interval div 1000) * 2 + 10));
420	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0'); // Any	453	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0'); // Any
421	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera	454	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera
422	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell	455	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell
423		456
424	idhttp := TIdHTTP.Create(nil);	457	idhttp := TIdHTTP.Create(nil);
425	try	458	try
426	idhttp.Post(ControlServerUrl, lParamList);	459	idhttp.Post(ControlServerUrl, lParamList);
427	finally	460	finally
428	FreeAndNil(idhttp);	461	FreeAndNil(idhttp);
429	end;	462	end;
430	finally	463	finally
431	FreeAndNil(lParamList);	464	FreeAndNil(lParamList);
432	end;	465	end;
433	except	466	except
434	// Nothing	467	// Nothing
435	end;	468	end;
436	end;	469	end;
437		470
438	function TForm1.ControlServerUrl: string;	471	function TForm1.ControlServerUrl: string;
439	begin	472	begin
440	result := 'http://' + ini.ReadString('Server', 'Address', '127.0.0.1') + ':' + ini.ReadString('Server', 'Port', '80') + '/';	473	result := 'http://' + ini.ReadString('Server', 'Address', '127.0.0.1') + ':' + ini.ReadString('Server', 'Port', '80') + '/';
441	end;	474	end;
442		475
443	procedure TForm1.DoPosition;	476	procedure TForm1.DoPosition;
444	function _TaskBarHeight: integer;	477	function _TaskBarHeight: integer;
445	var	478	var
446	hTB: HWND;	479	hTB: HWND;
447	TBRect: TRect;	480	TBRect: TRect;
448	begin	481	begin
449	hTB := FindWindow('Shell_TrayWnd', '');	482	hTB := FindWindow('Shell_TrayWnd', '');
450	if hTB = 0 then	483	if hTB = 0 then
451	Result := 0	484	Result := 0
452	else	485	else
453	begin	486	begin
454	GetWindowRect(hTB, TBRect);	487	GetWindowRect(hTB, TBRect);
455	Result := TBRect.Bottom - TBRect.Top;	488	Result := TBRect.Bottom - TBRect.Top;
456	end;	489	end;
457	end;	490	end;
458	begin	491	begin
459	// TODO: modify this code so that it works also if the task bar is on top or on the right corner of the screen	492	// TODO: modify this code so that it works also if the task bar is on top or on the right corner of the screen
460	// TODO: user should select in which corner the window show be	493	// TODO: user should select in which corner the window show be
461	Self.Left := Screen.Width - Self.Width;	494	Self.Left := Screen.Width - Self.Width;
462	Self.Top := Screen.Height - Self.Height - _TaskBarHeight;	495	Self.Top := Screen.Height - Self.Height - _TaskBarHeight;
463	end;	496	end;
464		497
465	procedure TForm1.DoShowForm(AlarmType: TAlarmType);	498	procedure TForm1.DoShowForm(AlarmType: TAlarmType);
466	begin	499	begin
467	Image1.Visible := AlarmType = atMotion;	500	Image1.Visible := AlarmType = atMotion;

Subversion Repositories alarming

alarming/trunk/Delphi Client/DoorAlarmClientMain.pas – Rev 7 → 9