home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / INFO / DI9806BL.ZIP / Cp / Client / MainFrm.pas < prev   
Pascal/Delphi Source File  |  1998-05-08  |  5KB  |  165 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. var
  68.   cpChatUsers : IConnectionPointContainer;
  69.   cpChatEventSinks : IConnectionPoint;
  70. begin
  71.   { disconnect from chat server }
  72.   if (FChatConnection <> NIL) then begin
  73.     try
  74.       { disconnect and the free chat connection }
  75.       FChatConnection.BroadcastMessage (FUserName, 'disconnect');
  76.  
  77.       { Standard disconnect code for connection points }
  78.       cpChatUsers := FChatConnection.ChatChannel as IConnectionPointContainer;
  79.       cpChatUsers.FindConnectionPoint (IChatEvent, cpChatEventSinks);
  80.       cpChatEventSinks.UnAdvise (FUserId);
  81.  
  82.       FChatConnection := NIL;
  83.     except
  84.       { ignore any errors, trash bad connection }
  85.       pointer (FChatConnection) := NIL;
  86.     end;  { except }
  87.   end;  { if }
  88. end;
  89.  
  90. procedure TfrmMain.Button1Click(Sender: TObject);
  91. var
  92.   cpChatUsers : IConnectionPointContainer;
  93.   cpChatEventSinks : IConnectionPoint;
  94. begin
  95.   { connect to chat server }
  96.   if (FChatConnection = NIL) then begin
  97.     if InputQuery ('Login', 'UserName', FUserName) then begin
  98.       try
  99.         { create chat connection and connect }
  100.         FChatConnection := CoChatConnection.Create;
  101.  
  102.         { Standard connect code for connection points }
  103.         cpChatUsers := FChatConnection.ChatChannel as IConnectionPointContainer;
  104.         cpChatUsers.FindConnectionPoint (IChatEvent, cpChatEventSinks);
  105.         cpChatEventSinks.Advise (FChatEvent as IUnknown, FUserId);
  106.  
  107.         FChatConnection.BroadcastMessage (FUserName, 'connect');
  108.       except
  109.         { display error to user }
  110.         ShowMessage (
  111.           'Unable to connect to server! Make sure chat server (Connection Points version) is registered.'#13 +
  112.           'OLE Error message: ' + Exception (ExceptObject).Message
  113.         );
  114.       end;  { except }
  115.     end;  { if }
  116.   end;  { if }
  117.   ActiveControl := Edit1;
  118. end;
  119.  
  120. procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
  121. begin
  122.   DisconnectUser;
  123.   FChatEvent.Free;
  124. end;
  125.  
  126. procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char);
  127. begin
  128.   if (Key = #13) then begin
  129.     if (FChatConnection <> NIL) then begin
  130.       { if user hit enter, broadcast user message to chat server }
  131.       try
  132.         FChatConnection.BroadcastMessage (FUserName, Edit1.Text);
  133.  
  134.         { clear for next message }
  135.         Edit1.Text := '';
  136.       except
  137.         { ignore all errors }
  138.       end;  { except }
  139.     end
  140.     else begin
  141.       ShowMessage ('Must be connected to chat server to broadcast a message!');
  142.     end;  { else }
  143.   end;  { if }
  144. end;
  145.  
  146. procedure TfrmMain.FormCreate(Sender: TObject);
  147. begin
  148.   FChatEvent := TChatEvent.Create;
  149.   FChatEvent.OnMessage := ChatEventMessage;
  150.   FUserName := 'Anonymous';
  151. end;
  152.  
  153. procedure TfrmMain.Button2Click(Sender: TObject);
  154. begin
  155.   DisconnectUser;
  156.   ActiveControl := Edit1;
  157. end;
  158.  
  159. procedure TfrmMain.FormResize(Sender: TObject);
  160. begin
  161.   Edit1.Width := Panel1.Left - Edit1.Left - 5;
  162. end;
  163.  
  164. end.
  165.