Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/Super TCP Channel Chat/SuperTCPChannelChat_ClientMain.pas

unit SuperTCPChannelChat_ClientMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClient, uROClientIntf, uRORemoteService, uROBinMessage, uROSuperTcpChannel,
   uROPoweredByRemObjectsButton, SuperTCPChannelChatLibrary_Intf,
  uROEventRepository;

type
  TSuperTCPChannelChat_ClientMainForm = class(TForm, IChatEvents)
    ROMessage: TROBinMessage;
    ROChannel: TROSuperTcpChannel;
    RORemoteService: TRORemoteService;
    ROPoweredByRemObjectsButton1: TROPoweredByRemObjectsButton;
    edOutput: TMemo;
    edUsers: TListBox;
    edText: TEdit;
    SendButton: TButton;
    ROEventReceiver: TROEventReceiver;
    LogonButton: TButton;
    LogoffButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
    procedure LogonButtonClick(Sender: TObject);
    procedure LogoffButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    aUserName: string;
    FConnected: Boolean;
    lLogin: ILoginService;
    lChat: IChatServerService;
    { Private declarations }
  public
    procedure Message(const From: string; const Target: string;
      const Message: string);
    procedure UserLogin(const Nickname: string);
    procedure UserLogout(const Nickname: string);
    procedure ShutdownServer;

    procedure SyncCall(var Msg: TMessage); message WM_USER;

  end;
  TSyncType = (stMessage, stUserLogin, stUserLogout);
  TStringArray = array of string;

var
  SuperTCPChannelChat_ClientMainForm: TSuperTCPChannelChat_ClientMainForm;

implementation

uses DateUtils;

{$R *.dfm}

{ TClientForm }

procedure TSuperTCPChannelChat_ClientMainForm.Message(const From, Target, Message: string);
var
  Data: array of string;
begin
  SetLength(Data, 3);
  Data[0] := From;
  Data[1] := Target;
  Data[2] := Message;
  SendMessage(Handle, WM_USER, Longint(stMessage), Longint(Data));
end;

procedure TSuperTCPChannelChat_ClientMainForm.UserLogin(const Nickname: string);
var
  Data: array of string;
begin
  SetLength(Data, 1);
  Data[0] := Nickname;
  SendMessage(Handle, WM_USER, Longint(stUserLogin), Longint(Data));
end;

procedure TSuperTCPChannelChat_ClientMainForm.UserLogout(const Nickname: string);
var
  Data: array of string;
begin
  SetLength(Data, 1);
  Data[0] := Nickname;
  SendMessage(Handle, WM_USER, Longint(stUserLogout), Longint(Data));
end;

procedure TSuperTCPChannelChat_ClientMainForm.FormCreate(Sender: TObject);
begin
  Fconnected := False;
  ROChannel.Host := 'localhost';
  lLogin := CoLoginService.Create(ROMessage, ROChannel);
  lChat := CoChatServerService.Create(ROMessage, ROChannel);
  ROEventReceiver.RegisterEventHandlers([EID_ChatEvents], [Self]);
  ROEventReceiver.Activate;
  aUserName := 'User' + IntToHex(GetTickCount and $FFFF, 4);
end;

procedure TSuperTCPChannelChat_ClientMainForm.FormDestroy(Sender: TObject);
begin
  ROEventReceiver.UnregisterEventHandlers([EID_ChatEvents]);
end;

procedure TSuperTCPChannelChat_ClientMainForm.SendButtonClick(Sender: TObject);
var
  idx: Integer;
begin
  idx := edUsers.ItemIndex;
  if idx < 1 then
    lChat.Talk(edText.Text)
  else
    lChat.TalkPrivate(edUsers.Items[idx], edText.Text);
  edText.Text := '';
  ActiveControl := edText;
end;

procedure TSuperTCPChannelChat_ClientMainForm.SyncCall(var Msg: TMessage);
var
  i: Integer;
  lSyncType: TSyncType;
  lData: TStringArray;
begin
  lSyncType := TSyncType(Msg.WParam);
  lData := TStringArray(Msg.LParam);
  case lSyncType of
    stMessage: begin
        if lData[1] = '' then
          SuperTCPChannelChat_ClientMainForm.edOutput.Lines.Add(Format('<%s> %s', [lData[0], lData[2]]))
        else
          SuperTCPChannelChat_ClientMainForm.edOutput.Lines.Add(Format('<%s: %s> %s', [lData[0], lData[1], lData[2]]));
      end;
    stUserLogin:
      SuperTCPChannelChat_ClientMainForm.edUsers.Items.Add(lData[0]);
    stUserLogout: begin
        i := SuperTCPChannelChat_ClientMainForm.edUsers.Items.IndexOf(lData[0]);
        if i <> -1 then
          SuperTCPChannelChat_ClientMainForm.EdUsers.Items.Delete(i);
      end;
  end;
end;

procedure TSuperTCPChannelChat_ClientMainForm.LogonButtonClick(
  Sender: TObject);
begin
  if not FConnected then try
    if InputQuery('Username', 'Please enter your &username:', aUsername) then begin
      lLogin.Login(aUsername);
      Fconnected := True;
    end;
  finally
    SendButton.Enabled := FConnected;
    LogonButton.Enabled := not FConnected;
    LogoffButton.Enabled := FConnected;
  end;
end;

procedure TSuperTCPChannelChat_ClientMainForm.LogoffButtonClick(
  Sender: TObject);
begin
  try
    if FConnected then try
      lLogin.Logout;
      Fconnected := False;
      while edUsers.Count > 1 do
        edUsers.Items.Delete(1);
      ROChannel.Active := False;
    finally
      SendButton.Enabled := FConnected;
      LogonButton.Enabled := not FConnected;
      LogoffButton.Enabled := FConnected;
    end;
  except
  end;
end;

procedure TSuperTCPChannelChat_ClientMainForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  LogoffButton.Click;
end;

procedure TSuperTCPChannelChat_ClientMainForm.ShutdownServer;
begin
  edOutput.Lines.Add('Server has been shutdown!');
  LogoffButton.Click;
end;

procedure TSuperTCPChannelChat_ClientMainForm.FormShow(Sender: TObject);
begin
  LogonButton.Click;
end;

end.