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   
Pascal/Delphi Source File  |  1998-05-08  |  4KB  |  149 lines
  1. { *****************************************************************************
  2.   Implementing COM Component Callbacks in Delphi
  3.   Code written for Delphi Informant publication
  4.  
  5.   Comments, questions, suggestions?
  6.   Binh Ly, Systems Analyst (bly@brickhouse.com)
  7.   Brickhouse Data Systems (http://www.brickhouse.com)
  8.   *****************************************************************************
  9. }
  10. unit MainFrm;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   StdCtrls, ChatEvent, ChatServer_TLB, ExtCtrls;
  17.  
  18. type
  19.   TfrmMain = class(TForm)
  20.     Panel2: TPanel;
  21.     Label2: TLabel;
  22.     Edit1: TEdit;
  23.     Label1: TLabel;
  24.     Memo1: TMemo;
  25.     Panel1: TPanel;
  26.     Button1: TButton;
  27.     Button2: TButton;
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  30.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure Button2Click(Sender: TObject);
  33.     procedure FormResize(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.     FChatConnection : IChatConnection;
  37.     FUserName : string;
  38.     FUserId : integer;
  39.     FChatEvent : TChatEvent;
  40.     procedure ChatEventMessage (const UserName, Message : string);
  41.     procedure DisconnectUser;
  42.   public
  43.     { Public declarations }
  44.   end;
  45.  
  46. var
  47.   frmMain: TfrmMain;
  48.  
  49. implementation
  50.  
  51. {$R *.DFM}
  52.  
  53. uses
  54.   ComObj,
  55.   ActiveX
  56.   ;
  57.  
  58. procedure TfrmMain.ChatEventMessage (const UserName, Message : string);
  59. begin
  60.   { this is our TChatEvent.OnMessage handler. in here, we just append the
  61.     UserName and Message to the messages memo. 
  62.   }
  63.   Memo1.Lines.Add (UserName + '> ' + Message);
  64. end;
  65.  
  66. procedure TfrmMain.DisconnectUser;
  67. begin
  68.   { disconnect from chat server }
  69.   if (FChatConnection <> NIL) then begin
  70.     try
  71.       { disconnect and the free chat connection }
  72.       FChatConnection.BroadcastMessage (FUserName, 'disconnect');
  73.       FChatConnection.ChatChannel.DisconnectUser (FUserId);
  74.       FChatConnection := NIL;
  75.     except
  76.       { ignore any errors, trash bad connection }
  77.       pointer (FChatConnection) := NIL;
  78.     end;  { except }
  79.   end;  { if }
  80. end;
  81.  
  82. procedure TfrmMain.Button1Click(Sender: TObject);
  83. begin
  84.   { connect to chat server }
  85.   if (FChatConnection = NIL) then begin
  86.     if InputQuery ('Login', 'UserName', FUserName) then begin
  87.       try
  88.         { create chat connection and connect }
  89.         FChatConnection := CoChatConnection.Create;
  90.         FChatConnection.ChatChannel.ConnectUser (FChatEvent as IChatEvent, FUserId);
  91.         FChatConnection.BroadcastMessage (FUserName, 'connect');
  92.       except
  93.         { display error to user }
  94.         ShowMessage (
  95.           'Unable to connect to server! Make sure chat server is registered.'#13 +
  96.           'Error message: ' + Exception (ExceptObject).Message
  97.         );
  98.       end;  { except }
  99.     end;  { if }
  100.   end;  { if }
  101.   ActiveControl := Edit1;
  102. end;
  103.  
  104. procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
  105. begin
  106.   DisconnectUser;
  107.   FChatEvent.Free;
  108. end;
  109.  
  110. procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char);
  111. begin
  112.   if (Key = #13) then begin
  113.     if (FChatConnection <> NIL) then begin
  114.       { if user hit enter, broadcast user message to chat server }
  115.       try
  116.         FChatConnection.BroadcastMessage (FUserName, Edit1.Text);
  117.  
  118.         { clear for next message }
  119.         Edit1.Text := '';
  120.       except
  121.         { ignore all errors }
  122.       end;  { except }
  123.     end
  124.     else begin
  125.       ShowMessage ('Must be connected to chat server to broadcast a message!');
  126.     end;  { else }
  127.   end;  { if }
  128. end;
  129.  
  130. procedure TfrmMain.FormCreate(Sender: TObject);
  131. begin
  132.   FChatEvent := TChatEvent.Create;
  133.   FChatEvent.OnMessage := ChatEventMessage;
  134.   FUserName := 'Anonymous';
  135. end;
  136.  
  137. procedure TfrmMain.Button2Click(Sender: TObject);
  138. begin
  139.   DisconnectUser;
  140.   ActiveControl := Edit1;
  141. end;
  142.  
  143. procedure TfrmMain.FormResize(Sender: TObject);
  144. begin
  145.   Edit1.Width := Panel1.Left - Edit1.Left - 5;
  146. end;
  147.  
  148. end.
  149.