home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Samples / Network / Chat / Main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  3.3 KB  |  140 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, DXPlay, DirectX;
  8.  
  9. const
  10.   DXCHAT_MESSAGE = 0;
  11.  
  12. type
  13.   TDXChatMessage = record
  14.     dwType: DWORD;  {  dwType is absolutely necessary.  }
  15.     Len: Integer;
  16.     C: array[0..0] of Char;
  17.   end;
  18.  
  19. type
  20.   TMainForm = class(TForm)
  21.     DXPlay1: TDXPlay;
  22.     Memo1: TMemo;
  23.     Edit1: TEdit;
  24.     Button1: TButton;
  25.     procedure DXPlay1AddPlayer(Sender: TObject; Player: TDXPlayPlayer);
  26.     procedure DXPlay1DeletePlayer(Sender: TObject; Player: TDXPlayPlayer);
  27.     procedure FormDestroy(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure DXPlay1Message(Sender: TObject; Player: TDXPlayPlayer; Data: Pointer;
  30.       DataSize: Integer);
  31.     procedure Button1Click(Sender: TObject);
  32.     procedure Edit1KeyDown(Sender: TObject; var Key: Word;
  33.       Shift: TShiftState);
  34.     procedure DXPlay1Open(Sender: TObject);
  35.   end;
  36.  
  37. var
  38.   MainForm: TMainForm;
  39.  
  40. implementation
  41.  
  42. {$R *.DFM}
  43.  
  44. procedure TMainForm.DXPlay1AddPlayer(Sender: TObject; Player: TDXPlayPlayer);
  45. begin
  46.   Memo1.Lines.Add(Format('  %s entered a room.', [Player.Name]));
  47. end;
  48.  
  49. procedure TMainForm.DXPlay1DeletePlayer(Sender: TObject;
  50.   Player: TDXPlayPlayer);
  51. begin
  52.   Memo1.Lines.Add(Format('  %s left a room.', [Player.Name]));
  53. end;
  54.  
  55. procedure TMainForm.DXPlay1Open(Sender: TObject);
  56. var
  57.   i: Integer;
  58. begin
  59.   for i:=0 to DXPlay1.Players.Count-1 do
  60.     if DXPlay1.Players[i].RemotePlayer then
  61.       Memo1.Lines.Add(Format('  %s is entering a room.', [DXPlay1.Players[i].Name]));
  62. end;
  63.  
  64. procedure TMainForm.FormDestroy(Sender: TObject);
  65. begin
  66.   DXPlay1.Close;
  67. end;
  68.  
  69. procedure TMainForm.FormCreate(Sender: TObject);
  70. begin
  71.   try
  72.     DXPlay1.Open;
  73.   except
  74.     on E: Exception do
  75.     begin
  76.       Application.ShowMainForm := False;
  77.       Application.HandleException(E);
  78.       Application.Terminate;
  79.     end;
  80.   end;
  81.  
  82.   MainForm.Caption := Format('%s : %s', [DXPlay1.ProviderName, DXPlay1.SessionName]);
  83. end;
  84.  
  85. procedure TMainForm.DXPlay1Message(Sender: TObject; Player: TDXPlayPlayer; Data: Pointer;
  86.   DataSize: Integer);
  87. var
  88.   s: string;
  89. begin
  90.   case DXPlayMessageType(Data) of
  91.     DXCHAT_MESSAGE:
  92.         begin     
  93.           if TDXChatMessage(Data^).Len<=0 then
  94.             s := ''
  95.           else begin
  96.             SetLength(s, TDXChatMessage(Data^).Len);
  97.             StrLCopy(PChar(s), @TDXChatMessage(Data^).c, Length(s));
  98.           end;
  99.  
  100.           Memo1.Lines.Add(Format('%s>    %s', [Player.Name, s]));
  101.         end;
  102.   end;
  103. end;
  104.  
  105. procedure TMainForm.Button1Click(Sender: TObject);
  106. var
  107.   Msg: ^TDXChatMessage;
  108.   MsgSize: Integer;
  109. begin
  110.   MsgSize := SizeOf(TDXChatMessage)+Length(Edit1.Text);
  111.   GetMem(Msg, MsgSize);
  112.   try
  113.     Msg.dwType := DXCHAT_MESSAGE;
  114.     Msg.Len := Length(Edit1.Text);
  115.     StrLCopy(@Msg^.c, PChar(Edit1.Text), Length(Edit1.Text));
  116.  
  117.     {  The message is sent all.  }
  118.     DXPlay1.SendMessage(DPID_ALLPLAYERS, Msg, MsgSize);
  119.  
  120.     {  The message is sent also to me.  }
  121.     DXPlay1.SendMessage(DXPlay1.LocalPlayer.ID, Msg, MsgSize);
  122.  
  123.     Edit1.Text := '';
  124.   finally
  125.     FreeMem(Msg);
  126.   end;
  127. end;
  128.  
  129. procedure TMainForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  130.   Shift: TShiftState);
  131. begin
  132.   if Key=VK_RETURN then
  133.   begin
  134.     Button1Click(nil);
  135.     key := 0;
  136.   end;
  137. end;
  138.  
  139. end.
  140.