I am migrating an application from 'Delphi 5' to 'Delphi 2006
VCL for Win32'. The D5 code uses a TServerSocket, so I am
having to use a TIdTCPServer in D2006, which might be causing
a problem.
I have constructed a minimalist application that illustrates
the problem, code attached below. The IdTCPServer.DefaultPort
is set to 50. I test the application using telnet from a
command-line prompt as : 'telnet 127.0.0.1 50', escape with
'Ctrl+]' and quit with 'q'.
As designed, the application runs in the SysTray, and is closed
by right-clicking the Tray and selecting 'Remove'.
Right-clicking and selecting 'Restore' shows the MainForm,
containing a list box showing the conversation with telnet.
With the line 'ShowWindow()' in the .dpr commented out, the
MainForm is initially visible. When it is returned to the
Tray, telnet used, and then shown again, the listbox contains
the conversation. The application shuts down normally.
However, with the line 'ShowWindow()' active, the MainForm
is initially in the Tray. When telnet is used and the MainForm
shown again, the listbox has disappeared. Also when the
apllication shuts down it generates a 'System Error Code 1400 -
Invalid window handle'.
Also, if all the lbxLog.Item.Add() lines are commented out
then the error does not occur.
I would be grateful if anyone can explain the cause of the
problem and suggest a solution.
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
program IndyError;
uses
Forms, Windows,
IndyErrorMain in 'IndyErrorMain.pas' {frmIEMain};
{$R *.res}
begin
Application.Initialize;
Application.Title := 'IndyError';
Application.CreateForm(TfrmIEMain, frmIEMain);
Application.ShowMainForm := false;
// hides MainForm at App.Run
Application.Run;
end.
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
unit IndyErrorMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer,IdContext, Menus,
ShellAPI;
type
TfrmIEMain = class(TForm)
IdTCPServer: TIdTCPServer;
lbxLog: TListBox;
puTray: TPopupMenu;
puitRestore: TMenuItem;
btnToTray: TButton;
puTerminate: TMenuItem;
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure puTerminateClick(Sender: TObject);
procedure btnToTrayClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure puitRestoreClick(Sender: TObject);
procedure IdTCPServerExecute(AContext: TIdContext);
procedure IdTCPServerDisconnect(AContext: TIdContext);
procedure IdTCPServerConnect(AContext: TIdContext);
protected
// responds to WM_USER+1 sent by
// taskbar_icon-mouse interaction
procedure WndProc(var Msg : TMessage);
override; // first method that receives messages for a form
// NB: virtual, protected in base
class
private
IconData : TNotifyIconData;
procedure MakeOrderlyExit;
public
{ Public declarations }
end;
var
frmIEMain: TfrmIEMain;
implementation
{$R *.dfm}
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
procedure TfrmIEMain.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
case Msg.Msg of
WM_USER+1 : case Msg.lParam of
WM_RBUTTONDOWN : begin
GetCursorPos(p);
puTray.PopUp(trunc(Screen.Width*0.95),
trunc(Screen.Height*0.88));
end;
end; // case2
end; // case1
inherited; // don't forget !
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
procedure TfrmIEMain.btnToTrayClick(Sender: TObject);
begin
Close; // sends to SysTray
end;
procedure TfrmIEMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caNone;
frmIEMain.Hide; // just hide form instead
end;
procedure TfrmIEMain.FormCreate(Sender: TObject);
begin
// initialise IconData and display first icon
with IconData do
begin
cbSize := sizeof(IconData);
Wnd := Handle;
uID := 100;
uFlags := NIF_MESSAGE
+ NIF_ICON
+ NIF_TIP;
uCallbackMessage := WM_USER+1;
hIcon := Application.Icon.Handle;
strPCopy(szTip,Application.Title);
end;
Shell_NotifyIcon(NIM_ADD,@IconData);
end;
procedure TfrmIEMain.IdTCPServerConnect(AContext: TIdContext);
begin
lbxLog.Items.Add('Connected');
try
with AContext.Connection do
IOHandler.WriteLn(Application.Title+' ready');
except on E: Exception do
showmessage(E.Message);
end;
end;
procedure TfrmIEMain.IdTCPServerDisconnect(AContext: TIdContext);
begin
lbxLog.Items.Add('Disconnected');
end;
procedure TfrmIEMain.IdTCPServerExecute(AContext: TIdContext);
var
s : string;
begin
with AContext.Connection do
begin
try
s := IOHandler.ReadLn;
lbxLog.Items.Add(s);
except on E: Exception do
lbxLog.Items.Add('IndyError: '+E.Message);
end;
end;
end;
procedure TfrmIEMain.MakeOrderlyExit;
begin
Shell_NotifyIcon(NIM_DELETE,@IconData);
Application.ProcessMessages;
IdTCPServer.Active := false;
Application.Terminate;
end;
procedure TfrmIEMain.puitRestoreClick(Sender: TObject);
begin
frmIEMain.Show;
end;
procedure TfrmIEMain.puTerminateClick(Sender: TObject);
begin
if MessageBox(Application.Handle,
pChar('Do you REALLY want to CLOSE DOWN '+Application.Title+' ?'
+#13
+#13+'If you do then -'
+#13+' PIMS will not be able'
+#13+' to print any more labels !'),
pChar('Exiting '+Application.Title+' application'),
MB_YESNO or MB_ICONEXCLAMATION) = IDYES then
// OK to exit
MakeOrderlyExit;
end;
end.
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~//
