home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1999 March
/
Chip_1999-03_cd.bin
/
zkuste
/
delphi
/
INFO
/
DI9807BL.ZIP
/
Intf
/
Client
/
MainFrm.pas
< prev
Wrap
Pascal/Delphi Source File
|
1998-05-08
|
4KB
|
149 lines
{ *****************************************************************************
Implementing COM Component Callbacks in Delphi
Code written for Delphi Informant publication
Comments, questions, suggestions?
Binh Ly, Systems Analyst (bly@brickhouse.com)
Brickhouse Data Systems (http://www.brickhouse.com)
*****************************************************************************
}
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ChatEvent, ChatServer_TLB, ExtCtrls;
type
TfrmMain = class(TForm)
Panel2: TPanel;
Label2: TLabel;
Edit1: TEdit;
Label1: TLabel;
Memo1: TMemo;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
FChatConnection : IChatConnection;
FUserName : string;
FUserId : integer;
FChatEvent : TChatEvent;
procedure ChatEventMessage (const UserName, Message : string);
procedure DisconnectUser;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
uses
ComObj,
ActiveX
;
procedure TfrmMain.ChatEventMessage (const UserName, Message : string);
begin
{ this is our TChatEvent.OnMessage handler. in here, we just append the
UserName and Message to the messages memo.
}
Memo1.Lines.Add (UserName + '> ' + Message);
end;
procedure TfrmMain.DisconnectUser;
begin
{ disconnect from chat server }
if (FChatConnection <> NIL) then begin
try
{ disconnect and the free chat connection }
FChatConnection.BroadcastMessage (FUserName, 'disconnect');
FChatConnection.ChatChannel.DisconnectUser (FUserId);
FChatConnection := NIL;
except
{ ignore any errors, trash bad connection }
pointer (FChatConnection) := NIL;
end; { except }
end; { if }
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
{ connect to chat server }
if (FChatConnection = NIL) then begin
if InputQuery ('Login', 'UserName', FUserName) then begin
try
{ create chat connection and connect }
FChatConnection := CoChatConnection.Create;
FChatConnection.ChatChannel.ConnectUser (FChatEvent as IChatEvent, FUserId);
FChatConnection.BroadcastMessage (FUserName, 'connect');
except
{ display error to user }
ShowMessage (
'Unable to connect to server! Make sure chat server is registered.'#13 +
'Error message: ' + Exception (ExceptObject).Message
);
end; { except }
end; { if }
end; { if }
ActiveControl := Edit1;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DisconnectUser;
FChatEvent.Free;
end;
procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then begin
if (FChatConnection <> NIL) then begin
{ if user hit enter, broadcast user message to chat server }
try
FChatConnection.BroadcastMessage (FUserName, Edit1.Text);
{ clear for next message }
Edit1.Text := '';
except
{ ignore all errors }
end; { except }
end
else begin
ShowMessage ('Must be connected to chat server to broadcast a message!');
end; { else }
end; { if }
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FChatEvent := TChatEvent.Create;
FChatEvent.OnMessage := ChatEventMessage;
FUserName := 'Anonymous';
end;
procedure TfrmMain.Button2Click(Sender: TObject);
begin
DisconnectUser;
ActiveControl := Edit1;
end;
procedure TfrmMain.FormResize(Sender: TObject);
begin
Edit1.Width := Panel1.Left - Edit1.Left - 5;
end;
end.