io Programmo 23/IOPROG_23.ISO/SOFT/DELPHIX.ZIP/Source/DXPlayFm.pas

Pascal/Delphi Source File | 1998-10-06 | 9.4 KB | 348 lines

unit DXPlayFm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DirectX, DXPlay, ActiveX, DXETable, DIB;

type
  TDelphiXDXPlayForm = class(TForm)
    Notebook: TNotebook;
    NextButton: TButton;
    BackButton: TButton;
    CancelButton: TButton;
    Bevel1: TBevel;
    ProviderList: TListBox;
    Label1: TLabel;
    Bevel2: TBevel;
    Label2: TLabel;
    NewGame: TRadioButton;
    JoinGame: TRadioButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    NewGameSessionName: TEdit;
    NewGamePlayerName: TEdit;
    Label7: TLabel;
    JoinGamePlayerName: TEdit;
    Label8: TLabel;
    JoinGameSessionList: TListBox;
    DXPaintBox1: TDXPaintBox;
    procedure NotebookPageChanged(Sender: TObject);
    procedure BackButtonClick(Sender: TObject);
    procedure NextButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure ProviderListClick(Sender: TObject);
    procedure NewGameClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure EditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure NewGameSessionNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure NewGamePlayerNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure JoinGameSessionListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure JoinGamePlayerNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    FProviderGUID: TGUID;
  public
    DPlay: IDirectPlay3A;
    DXPlay: TCustomDXPlay;
    PlayerName: string;
    ProviderName: string;
    SessionName: string;
  end;

var
  DelphiXDXPlayForm: TDelphiXDXPlayForm;

implementation

uses DXConsts;

{$R *.DFM}

procedure TDelphiXDXPlayForm.FormShow(Sender: TObject);
begin
  ProviderList.Items := DXPlay.Providers;
  NotebookPageChanged(nil);
end;

procedure TDelphiXDXPlayForm.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i:=0 to JoinGameSessionList.Items.Count-1 do
    Dispose(PGUID(JoinGameSessionList.Items.Objects[i]));
end;

procedure TDelphiXDXPlayForm.BackButtonClick(Sender: TObject);
begin
  if Notebook.ActivePage='SessionNew' then
  begin
    DPlay := nil;
    Notebook.ActivePage := 'SessionType'
  end else if Notebook.ActivePage='SessionJoin' then
  begin
    DPlay := nil;
    Notebook.ActivePage := 'SessionType'
  end else
    Notebook.PageIndex := Notebook.PageIndex - 1;
end;

procedure TDelphiXDXPlayForm.NextButtonClick(Sender: TObject);

  procedure InitDirectPlay;
  var
    DPlay1: IDirectPlay;
  begin
    if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
      raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);

    DPlay := DPlay1 as IDirectPlay3A;
  end;

  function EnumSessionsCallback(const lpThisSD: DPSESSIONDESC2;
      var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
  var
    Guid: PGUID;
  begin
    if dwFlags and DPESC_TIMEDOUT<>0 then
    begin
      Result := False;
      Exit;
    end;

    Guid := New(PGUID);
    Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
    TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));

    Result := True;
  end;

var
  dpDesc: DPSESSIONDESC2;
  i: Integer;
  c: array[0..1023] of Char;
  hr: HRESULT;
begin
  if Notebook.ActivePage='SelectProvider' then
  begin
    FProviderGUID := PGUID(ProviderList.Items.Objects[ProviderList.ItemIndex])^;

    InitDirectPlay;

    Notebook.ActivePage := 'SessionType';
  end else
  if Notebook.ActivePage='SessionType' then
  begin
    if DPlay=nil then InitDirectPlay;

    if NewGame.Checked then
      Notebook.ActivePage := 'SessionNew'
    else
    begin
      for i:=0 to JoinGameSessionList.Items.Count-1 do
        Dispose(PGUID(JoinGameSessionList.Items.Objects[i]));
      JoinGameSessionList.Items.Clear;

      FillChar(dpDesc, SizeOf(dpDesc), 0);
      dpDesc.dwSize := SizeOf(dpDesc);
      dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);

      hr := DPlay.EnumSessions(dpDesc, 0, @EnumSessionsCallback, Self, DPENUMSESSIONS_AVAILABLE);
      if hr=DPERR_USERCANCEL then Exit;
      if hr<>0 then
        raise EDXPlayError.Create(SDXPlaySessionListCannotBeAcquired);

      Notebook.ActivePage := 'SessionJoin';
    end;
  end else if Notebook.ActivePage='SessionNew' then
  begin
    if DPlay=nil then InitDirectPlay;

    {  Session making  }
    StrLCopy(@c, PChar(NewGameSessionName.Text), SizeOf(c));

    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;
    dpDesc.lpszSessionNameA := @c;
    dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);
    dpDesc.dwMaxPlayers := DXPlay.MaxPlayers;

    hr := DPlay.Open(dpDesc, DPOPEN_CREATE);
    if hr=DPERR_USERCANCEL then Exit;
    if hr<>0 then
    begin
      DPlay := nil;
      raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [NewGameSessionName.Text]);
    end;

    PlayerName := NewGamePlayerName.Text;
    ProviderName := ProviderList.Items[ProviderList.ItemIndex];
    SessionName := NewGameSessionName.Text;

    Tag := 1;
    Close;
  end else if Notebook.ActivePage='SessionJoin' then
  begin
    if DPlay=nil then InitDirectPlay;

    {  Session connection  }
    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.guidInstance := PGUID(JoinGameSessionList.Items.Objects[JoinGameSessionList.ItemIndex])^;
    dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);

    hr := DPlay.Open(dpDesc, DPOPEN_JOIN);
    if hr=DPERR_USERCANCEL then Exit;
    if hr<>0 then
    begin
      DPlay := nil;
      raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [NewGameSessionName.Text]);
    end;

    PlayerName := JoinGamePlayerName.Text;
    ProviderName := ProviderList.Items[ProviderList.ItemIndex];
    SessionName := JoinGameSessionList.Items[JoinGameSessionList.ItemIndex];

    Tag := 1;
    Close;
  end else
    Notebook.PageIndex := Notebook.PageIndex + 1;
end;

procedure TDelphiXDXPlayForm.CancelButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TDelphiXDXPlayForm.NotebookPageChanged(Sender: TObject);
begin
  if Notebook.ActivePage='SelectProvider' then
  begin
    BackButton.Enabled := False;
    NextButton.Enabled := ProviderList.ItemIndex<>-1;
    NextButton.Caption := DXPlayFormNext;
  end else if Notebook.ActivePage='SessionType' then
  begin
    BackButton.Enabled := True;
    NextButton.Enabled := NewGame.Checked or JoinGame.Checked;
    NextButton.Caption := DXPlayFormNext;
  end else if Notebook.ActivePage='SessionNew' then
  begin
    BackButton.Enabled := True;
    NextButton.Enabled := (NewGameSessionName.Text<>'') and (NewGamePlayerName.Text<>'');
    NextButton.Caption := DXPlayFormComplete;
  end else if Notebook.ActivePage='SessionJoin' then
  begin
    BackButton.Enabled := True;
    NextButton.Enabled := (JoinGameSessionList.ItemIndex<>-1) and (JoinGamePlayerName.Text<>'');
    NextButton.Caption := DXPlayFormComplete;
  end;
end;

procedure TDelphiXDXPlayForm.ProviderListClick(Sender: TObject);
begin
  NotebookPageChanged(nil);
end;

procedure TDelphiXDXPlayForm.NewGameClick(Sender: TObject);
begin
  NotebookPageChanged(nil);
end;

procedure TDelphiXDXPlayForm.EditKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if (Key=VK_RETURN) and (NextButton.Enabled) then
  begin
    NextButtonClick(nil);
    Key := 0;
  end;
end;

procedure TDelphiXDXPlayForm.NewGameSessionNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if NewGameSessionName.Text='' then Exit;

  if Key=VK_RETURN then
  begin
    if NextButton.Enabled then
    begin
      NextButtonClick(nil);
      Key := 0;
    end else if NewGamePlayerName.Text='' then
    begin
      NewGamePlayerName.SetFocus;
      Key := 0;
    end;
  end;
end;

procedure TDelphiXDXPlayForm.NewGamePlayerNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if NewGamePlayerName.Text='' then Exit;

  if Key=VK_RETURN then
  begin
    if NextButton.Enabled then
    begin
      NextButtonClick(nil);
      Key := 0;
    end else if NewGameSessionName.Text='' then
    begin
      NewGameSessionName.SetFocus;
      Key := 0;
    end;
  end;
end;

procedure TDelphiXDXPlayForm.JoinGameSessionListKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if JoinGameSessionList.ItemIndex=-1 then Exit;

  if Key=VK_RETURN then
  begin
    if NextButton.Enabled then
    begin
      NextButtonClick(nil);
      Key := 0;
    end else if JoinGamePlayerName.Text='' then
    begin
      JoinGamePlayerName.SetFocus;
      Key := 0;
    end;
  end;
end;

procedure TDelphiXDXPlayForm.JoinGamePlayerNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if JoinGamePlayerName.Text='' then Exit;

  if Key=VK_RETURN then
  begin
    if NextButton.Enabled then
    begin
      NextButtonClick(nil);
      Key := 0;
    end else if JoinGameSessionList.ItemIndex=-1 then
    begin
      JoinGameSessionList.SetFocus;
      Key := 0;
    end;
  end;
end;

end.