WebSVN – spacemission – Diff – /VCL_DELPHIX_D6/DXPlayFm.pas


unit DXPlayFm;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DXPlay, ActiveX, DXETable, DIB,
{$IfDef StandardDX}
  DirectDraw, DirectPlay;
{$Else}
  DirectX;
{$EndIf}
 
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;
    JoinGamePlayerList: TListBox;
    JoinGameGetPlayerListTimer: TTimer;
    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);
    procedure JoinGameGetPlayerListTimerTimer(Sender: TObject);
    procedure JoinGameSessionListClick(Sender: TObject);
  private
    FProviderGUID: TGUID;
  public
    DPlay: //{$IfDef DX7}
      IDirectPlay4A;
      //{$Else}IDirectPlay8Address{$EndIf};
    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
  JoinGameGetPlayerListTimer.Enabled := False;
 
  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: //{$IfDef DX7}
      IDirectPlay;
      //{$Else}IDirectPlay8Server{$EndIf};
  begin
    if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
      raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
 
    DPlay := DPlay1 as //{$IfDef DX7}
      IDirectPlay4A//{$Else}IDirectPlay8Address{$EndIf}
  end;
 
  function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;
      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));
    {$IFDEF UNICODE}
    TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameW, Pointer(Guid));
    {$ELSE}
    TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));
    {$ENDIF}
    Result := True;
  end;
 
var
  dpDesc: TDPSessionDesc2;
  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.JoinGameGetPlayerListTimerTimer(
  Sender: TObject);
     
  function EnumPlayersCallback2(TDPID: TDPID; dwPlayerType: DWORD;
    const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
  begin
    with lpName do
    begin
      if lpszShortNameA<>nil then
        {$IFDEF UNICODE}
        TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameW);
        {$ELSE}
        TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameA);
        {$ENDIF}
    end;
 
    Result := True;
  end;
 
var
  dpDesc: TDPSessionDesc2;
  hr: HRESULT;
  TempDPlay: IDirectPlay4A;
  DPlay1: IDirectPlay;                            
begin
  JoinGameGetPlayerListTimer.Enabled := False;
  JoinGamePlayerList.Items.Clear;
 
  TempDPlay := DPlay;
  if TempDPlay=nil then
  begin
    if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
      Exit;
    TempDPlay := DPlay1 as IDirectPlay4A;
    DPlay1 := nil;
  end;            
  try
    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.guidInstance := PGUID(JoinGameSessionList.Items.Objects[JoinGameSessionList.ItemIndex])^;
    dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);
 
    hr := TempDPlay.Open(dpDesc, DPOPEN_JOIN);
    if hr<>0 then Exit;
    try
      TempDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
    finally
      TempDPlay.Close;
    end;
  finally
    TempDPlay := nil;                          
  end;
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.JoinGameSessionListClick(Sender: TObject);
begin
  NotebookPageChanged(nil);
 
  JoinGamePlayerList.Clear;
  if JoinGameSessionList.ItemIndex<>-1 then
  begin
    JoinGameGetPlayerListTimer.Enabled := False;
    JoinGameGetPlayerListTimer.Enabled := True;
  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.
 
 

Rev 1	Rev 4
1	unit DXPlayFm;	1	unit DXPlayFm;
2		2
3	interface	3	interface
4		-
-		4	{$INCLUDE DelphiXcfg.inc}
5	uses	5	uses
6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7	StdCtrls, ExtCtrls, DirectX, DXPlay, ActiveX, DXETable, DIB;	7	StdCtrls, ExtCtrls, DXPlay, ActiveX, DXETable, DIB,
-		8	{$IfDef StandardDX}
-		9	DirectDraw, DirectPlay;
-		10	{$Else}
-		11	DirectX;
-		12	{$EndIf}
8		13
9	type	14	type
10	TDelphiXDXPlayForm = class(TForm)	15	TDelphiXDXPlayForm = class(TForm)
11	Notebook: TNotebook;	16	Notebook: TNotebook;
12	NextButton: TButton;	17	NextButton: TButton;
13	BackButton: TButton;	18	BackButton: TButton;
14	CancelButton: TButton;	19	CancelButton: TButton;
15	Bevel1: TBevel;	20	Bevel1: TBevel;
16	ProviderList: TListBox;	21	ProviderList: TListBox;
17	Label1: TLabel;	22	Label1: TLabel;
18	Bevel2: TBevel;	23	Bevel2: TBevel;
19	Label2: TLabel;	24	Label2: TLabel;
20	NewGame: TRadioButton;	25	NewGame: TRadioButton;
21	JoinGame: TRadioButton;	26	JoinGame: TRadioButton;
22	Label3: TLabel;	27	Label3: TLabel;
23	Label4: TLabel;	28	Label4: TLabel;
24	Label5: TLabel;	29	Label5: TLabel;
25	NewGameSessionName: TEdit;	30	NewGameSessionName: TEdit;
26	NewGamePlayerName: TEdit;	31	NewGamePlayerName: TEdit;
27	Label7: TLabel;	32	Label7: TLabel;
28	JoinGamePlayerName: TEdit;	33	JoinGamePlayerName: TEdit;
29	Label8: TLabel;	34	Label8: TLabel;
30	JoinGameSessionList: TListBox;	35	JoinGameSessionList: TListBox;
31	DXPaintBox1: TDXPaintBox;	36	DXPaintBox1: TDXPaintBox;
32	JoinGamePlayerList: TListBox;	37	JoinGamePlayerList: TListBox;
33	JoinGameGetPlayerListTimer: TTimer;	38	JoinGameGetPlayerListTimer: TTimer;
34	procedure NotebookPageChanged(Sender: TObject);	39	procedure NotebookPageChanged(Sender: TObject);
35	procedure BackButtonClick(Sender: TObject);	40	procedure BackButtonClick(Sender: TObject);
36	procedure NextButtonClick(Sender: TObject);	41	procedure NextButtonClick(Sender: TObject);
37	procedure CancelButtonClick(Sender: TObject);	42	procedure CancelButtonClick(Sender: TObject);
38	procedure ProviderListClick(Sender: TObject);	43	procedure ProviderListClick(Sender: TObject);
39	procedure NewGameClick(Sender: TObject);	44	procedure NewGameClick(Sender: TObject);
40	procedure FormDestroy(Sender: TObject);	45	procedure FormDestroy(Sender: TObject);
41	procedure FormShow(Sender: TObject);	46	procedure FormShow(Sender: TObject);
42	procedure EditKeyDown(Sender: TObject; var Key: Word;	47	procedure EditKeyDown(Sender: TObject; var Key: Word;
43	Shift: TShiftState);	48	Shift: TShiftState);
44	procedure NewGameSessionNameKeyDown(Sender: TObject; var Key: Word;	49	procedure NewGameSessionNameKeyDown(Sender: TObject; var Key: Word;
45	Shift: TShiftState);	50	Shift: TShiftState);
46	procedure NewGamePlayerNameKeyDown(Sender: TObject; var Key: Word;	51	procedure NewGamePlayerNameKeyDown(Sender: TObject; var Key: Word;
47	Shift: TShiftState);	52	Shift: TShiftState);
48	procedure JoinGameSessionListKeyDown(Sender: TObject; var Key: Word;	53	procedure JoinGameSessionListKeyDown(Sender: TObject; var Key: Word;
49	Shift: TShiftState);	54	Shift: TShiftState);
50	procedure JoinGamePlayerNameKeyDown(Sender: TObject; var Key: Word;	55	procedure JoinGamePlayerNameKeyDown(Sender: TObject; var Key: Word;
51	Shift: TShiftState);	56	Shift: TShiftState);
52	procedure JoinGameGetPlayerListTimerTimer(Sender: TObject);	57	procedure JoinGameGetPlayerListTimerTimer(Sender: TObject);
53	procedure JoinGameSessionListClick(Sender: TObject);	58	procedure JoinGameSessionListClick(Sender: TObject);
54	private	59	private
55	FProviderGUID: TGUID;	60	FProviderGUID: TGUID;
56	public	61	public
-		62	DPlay: //{$IfDef DX7}
57	DPlay: IDirectPlay4A;	63	IDirectPlay4A;
-		64	//{$Else}IDirectPlay8Address{$EndIf};
58	DXPlay: TCustomDXPlay;	65	DXPlay: TCustomDXPlay;
59	PlayerName: string;	66	PlayerName: string;
60	ProviderName: string;	67	ProviderName: string;
61	SessionName: string;	68	SessionName: string;
62	end;	69	end;
63		70
64	var	71	var
65	DelphiXDXPlayForm: TDelphiXDXPlayForm;	72	DelphiXDXPlayForm: TDelphiXDXPlayForm;
66		73
67	implementation	74	implementation
68		75
69	uses DXConsts;	76	uses DXConsts;
70		77
71	{$R *.DFM}	78	{$R *.DFM}
72		79
73	procedure TDelphiXDXPlayForm.FormShow(Sender: TObject);	80	procedure TDelphiXDXPlayForm.FormShow(Sender: TObject);
74	begin	81	begin
75	ProviderList.Items := DXPlay.Providers;	82	ProviderList.Items := DXPlay.Providers;
76	NotebookPageChanged(nil);	83	NotebookPageChanged(nil);
77	end;	84	end;
78		85
79	procedure TDelphiXDXPlayForm.FormDestroy(Sender: TObject);	86	procedure TDelphiXDXPlayForm.FormDestroy(Sender: TObject);
80	var	87	var
81	i: Integer;	88	i: Integer;
82	begin	89	begin
83	for i:=0 to JoinGameSessionList.Items.Count-1 do	90	for i:=0 to JoinGameSessionList.Items.Count-1 do
84	Dispose(PGUID(JoinGameSessionList.Items.Objects[i]));	91	Dispose(PGUID(JoinGameSessionList.Items.Objects[i]));
85	end;	92	end;
86		93
87	procedure TDelphiXDXPlayForm.BackButtonClick(Sender: TObject);	94	procedure TDelphiXDXPlayForm.BackButtonClick(Sender: TObject);
88	begin	95	begin
89	JoinGameGetPlayerListTimer.Enabled := False;	96	JoinGameGetPlayerListTimer.Enabled := False;
90		97
91	if Notebook.ActivePage='SessionNew' then	98	if Notebook.ActivePage='SessionNew' then
92	begin	99	begin
93	DPlay := nil;	100	DPlay := nil;
94	Notebook.ActivePage := 'SessionType'	101	Notebook.ActivePage := 'SessionType'
95	end else if Notebook.ActivePage='SessionJoin' then	102	end else if Notebook.ActivePage='SessionJoin' then
96	begin	103	begin
97	DPlay := nil;	104	DPlay := nil;
98	Notebook.ActivePage := 'SessionType'	105	Notebook.ActivePage := 'SessionType'
99	end else	106	end else
100	Notebook.PageIndex := Notebook.PageIndex - 1;	107	Notebook.PageIndex := Notebook.PageIndex - 1;
101	end;	108	end;
102		109
103	procedure TDelphiXDXPlayForm.NextButtonClick(Sender: TObject);	110	procedure TDelphiXDXPlayForm.NextButtonClick(Sender: TObject);
104		111
105	procedure InitDirectPlay;	112	procedure InitDirectPlay;
106	var	113	var
-		114	DPlay1: //{$IfDef DX7}
107	DPlay1: IDirectPlay;	115	IDirectPlay;
-		116	//{$Else}IDirectPlay8Server{$EndIf};
108	begin	117	begin
109	if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then	118	if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
110	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);	119	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
111		120
112	DPlay := DPlay1 as IDirectPlay4A;	121	DPlay := DPlay1 as //{$IfDef DX7}
-		122	IDirectPlay4A//{$Else}IDirectPlay8Address{$EndIf}
113	end;	123	end;
114		124
115	function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;	125	function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;
116	var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;	126	var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
117	var	127	var
118	Guid: PGUID;	128	Guid: PGUID;
119	begin	129	begin
120	if dwFlags and DPESC_TIMEDOUT<>0 then	130	if dwFlags and DPESC_TIMEDOUT<>0 then
121	begin	131	begin
122	Result := False;	132	Result := False;
123	Exit;	133	Exit;
124	end;	134	end;
125		135
126	Guid := New(PGUID);	136	Guid := New(PGUID);
127	Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));	137	Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
-		138	{$IFDEF UNICODE}
-		139	TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameW, Pointer(Guid));
-		140	{$ELSE}
128	TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));	141	TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));
129		142	{$ENDIF}
130	Result := True;	143	Result := True;
131	end;	144	end;
132		145
133	var	146	var
134	dpDesc: TDPSessionDesc2;	147	dpDesc: TDPSessionDesc2;
135	i: Integer;	148	i: Integer;
136	c: array[0..1023] of Char;	149	c: array[0..1023] of Char;
137	hr: HRESULT;	150	hr: HRESULT;
138	begin	151	begin
139	if Notebook.ActivePage='SelectProvider' then	152	if Notebook.ActivePage='SelectProvider' then
140	begin	153	begin
141	FProviderGUID := PGUID(ProviderList.Items.Objects[ProviderList.ItemIndex])^;	154	FProviderGUID := PGUID(ProviderList.Items.Objects[ProviderList.ItemIndex])^;
142		155
143	InitDirectPlay;	156	InitDirectPlay;
144		157
145	Notebook.ActivePage := 'SessionType';	158	Notebook.ActivePage := 'SessionType';
146	end else	159	end else
147	if Notebook.ActivePage='SessionType' then	160	if Notebook.ActivePage='SessionType' then
148	begin	161	begin
149	if DPlay=nil then InitDirectPlay;	162	if DPlay=nil then InitDirectPlay;
150		163
151	if NewGame.Checked then	164	if NewGame.Checked then
152	Notebook.ActivePage := 'SessionNew'	165	Notebook.ActivePage := 'SessionNew'
153	else	166	else
154	begin	167	begin
155	for i:=0 to JoinGameSessionList.Items.Count-1 do	168	for i:=0 to JoinGameSessionList.Items.Count-1 do
156	Dispose(PGUID(JoinGameSessionList.Items.Objects[i]));	169	Dispose(PGUID(JoinGameSessionList.Items.Objects[i]));
157	JoinGameSessionList.Items.Clear;	170	JoinGameSessionList.Items.Clear;
158		171
159	FillChar(dpDesc, SizeOf(dpDesc), 0);	172	FillChar(dpDesc, SizeOf(dpDesc), 0);
160	dpDesc.dwSize := SizeOf(dpDesc);	173	dpDesc.dwSize := SizeOf(dpDesc);
161	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);	174	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);
162		175
163	hr := DPlay.EnumSessions(dpDesc, 0, @EnumSessionsCallback, Self, DPENUMSESSIONS_AVAILABLE);	176	hr := DPlay.EnumSessions(dpDesc, 0, @EnumSessionsCallback, Self, DPENUMSESSIONS_AVAILABLE);
164	if hr=DPERR_USERCANCEL then Exit;	177	if hr=DPERR_USERCANCEL then Exit;
165	if hr<>0 then	178	if hr<>0 then
166	raise EDXPlayError.Create(SDXPlaySessionListCannotBeAcquired);	179	raise EDXPlayError.Create(SDXPlaySessionListCannotBeAcquired);
167		180
168	Notebook.ActivePage := 'SessionJoin';	181	Notebook.ActivePage := 'SessionJoin';
169	end;	182	end;
170	end else if Notebook.ActivePage='SessionNew' then	183	end else if Notebook.ActivePage='SessionNew' then
171	begin	184	begin
172	if DPlay=nil then InitDirectPlay;	185	if DPlay=nil then InitDirectPlay;
173		186
174	{ Session making }	187	{ Session making }
175	StrLCopy(@c, PChar(NewGameSessionName.Text), SizeOf(c));	188	StrLCopy(@c, PChar(NewGameSessionName.Text), SizeOf(c));
176		189
177	FillChar(dpDesc, SizeOf(dpDesc), 0);	190	FillChar(dpDesc, SizeOf(dpDesc), 0);
178	dpDesc.dwSize := SizeOf(dpDesc);	191	dpDesc.dwSize := SizeOf(dpDesc);
179	dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;	192	dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;
180	dpDesc.lpszSessionNameA := @c;	193	dpDesc.lpszSessionNameA := @c;
181	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);	194	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);
182	dpDesc.dwMaxPlayers := DXPlay.MaxPlayers;	195	dpDesc.dwMaxPlayers := DXPlay.MaxPlayers;
183		196
184	hr := DPlay.Open(dpDesc, DPOPEN_CREATE);	197	hr := DPlay.Open(dpDesc, DPOPEN_CREATE);
185	if hr=DPERR_USERCANCEL then Exit;	198	if hr=DPERR_USERCANCEL then Exit;
186	if hr<>0 then	199	if hr<>0 then
187	begin	200	begin
188	DPlay := nil;	201	DPlay := nil;
189	raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [NewGameSessionName.Text]);	202	raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [NewGameSessionName.Text]);
190	end;	203	end;
191		204
192	PlayerName := NewGamePlayerName.Text;	205	PlayerName := NewGamePlayerName.Text;
193	ProviderName := ProviderList.Items[ProviderList.ItemIndex];	206	ProviderName := ProviderList.Items[ProviderList.ItemIndex];
194	SessionName := NewGameSessionName.Text;	207	SessionName := NewGameSessionName.Text;
195		208
196	Tag := 1;	209	Tag := 1;
197	Close;	210	Close;
198	end else if Notebook.ActivePage='SessionJoin' then	211	end else if Notebook.ActivePage='SessionJoin' then
199	begin	212	begin
200	if DPlay=nil then InitDirectPlay;	213	if DPlay=nil then InitDirectPlay;
201		214
202	{ Session connection }	215	{ Session connection }
203	FillChar(dpDesc, SizeOf(dpDesc), 0);	216	FillChar(dpDesc, SizeOf(dpDesc), 0);
204	dpDesc.dwSize := SizeOf(dpDesc);	217	dpDesc.dwSize := SizeOf(dpDesc);
205	dpDesc.guidInstance := PGUID(JoinGameSessionList.Items.Objects[JoinGameSessionList.ItemIndex])^;	218	dpDesc.guidInstance := PGUID(JoinGameSessionList.Items.Objects[JoinGameSessionList.ItemIndex])^;
206	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);	219	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);
207		220
208	hr := DPlay.Open(dpDesc, DPOPEN_JOIN);	221	hr := DPlay.Open(dpDesc, DPOPEN_JOIN);
209	if hr=DPERR_USERCANCEL then Exit;	222	if hr=DPERR_USERCANCEL then Exit;
210	if hr<>0 then	223	if hr<>0 then
211	begin	224	begin
212	DPlay := nil;	225	DPlay := nil;
213	raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [NewGameSessionName.Text]);	226	raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [NewGameSessionName.Text]);
214	end;	227	end;
215		228
216	PlayerName := JoinGamePlayerName.Text;	229	PlayerName := JoinGamePlayerName.Text;
217	ProviderName := ProviderList.Items[ProviderList.ItemIndex];	230	ProviderName := ProviderList.Items[ProviderList.ItemIndex];
218	SessionName := JoinGameSessionList.Items[JoinGameSessionList.ItemIndex];	231	SessionName := JoinGameSessionList.Items[JoinGameSessionList.ItemIndex];
219		232
220	Tag := 1;	233	Tag := 1;
221	Close;	234	Close;
222	end else	235	end else
223	Notebook.PageIndex := Notebook.PageIndex + 1;	236	Notebook.PageIndex := Notebook.PageIndex + 1;
224	end;	237	end;
225		238
226	procedure TDelphiXDXPlayForm.JoinGameGetPlayerListTimerTimer(	239	procedure TDelphiXDXPlayForm.JoinGameGetPlayerListTimerTimer(
227	Sender: TObject);	240	Sender: TObject);
228		241
229	function EnumPlayersCallback2(TDPID: TDPID; dwPlayerType: DWORD;	242	function EnumPlayersCallback2(TDPID: TDPID; dwPlayerType: DWORD;
230	const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;	243	const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
231	begin	244	begin
232	with lpName do	245	with lpName do
233	begin	246	begin
234	if lpszShortNameA<>nil then	247	if lpszShortNameA<>nil then
-		248	{$IFDEF UNICODE}
-		249	TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameW);
-		250	{$ELSE}
235	TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameA);	251	TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameA);
-		252	{$ENDIF}
236	end;	253	end;
237		254
238	Result := True;	255	Result := True;
239	end;	256	end;
240		257
241	var	258	var
242	dpDesc: TDPSessionDesc2;	259	dpDesc: TDPSessionDesc2;
243	hr: HRESULT;	260	hr: HRESULT;
244	TempDPlay: IDirectPlay4A;	261	TempDPlay: IDirectPlay4A;
245	DPlay1: IDirectPlay;	262	DPlay1: IDirectPlay;
246	begin	263	begin
247	JoinGameGetPlayerListTimer.Enabled := False;	264	JoinGameGetPlayerListTimer.Enabled := False;
248	JoinGamePlayerList.Items.Clear;	265	JoinGamePlayerList.Items.Clear;
249		266
250	TempDPlay := DPlay;	267	TempDPlay := DPlay;
251	if TempDPlay=nil then	268	if TempDPlay=nil then
252	begin	269	begin
253	if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then	270	if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
254	Exit;	271	Exit;
255	TempDPlay := DPlay1 as IDirectPlay4A;	272	TempDPlay := DPlay1 as IDirectPlay4A;
256	DPlay1 := nil;	273	DPlay1 := nil;
257	end;	274	end;
258	try	275	try
259	FillChar(dpDesc, SizeOf(dpDesc), 0);	276	FillChar(dpDesc, SizeOf(dpDesc), 0);
260	dpDesc.dwSize := SizeOf(dpDesc);	277	dpDesc.dwSize := SizeOf(dpDesc);
261	dpDesc.guidInstance := PGUID(JoinGameSessionList.Items.Objects[JoinGameSessionList.ItemIndex])^;	278	dpDesc.guidInstance := PGUID(JoinGameSessionList.Items.Objects[JoinGameSessionList.ItemIndex])^;
262	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);	279	dpDesc.guidApplication := DXPlayStringToGUID(DXPlay.GUID);
263		280
264	hr := TempDPlay.Open(dpDesc, DPOPEN_JOIN);	281	hr := TempDPlay.Open(dpDesc, DPOPEN_JOIN);
265	if hr<>0 then Exit;	282	if hr<>0 then Exit;
266	try	283	try
267	TempDPlay.EnumPlayers(PGUID(nil)^, @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);	284	TempDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
268	finally	285	finally
269	TempDPlay.Close;	286	TempDPlay.Close;
270	end;	287	end;
271	finally	288	finally
272	TempDPlay := nil;	289	TempDPlay := nil;
273	end;	290	end;
274	end;	291	end;
275		292
276	procedure TDelphiXDXPlayForm.CancelButtonClick(Sender: TObject);	293	procedure TDelphiXDXPlayForm.CancelButtonClick(Sender: TObject);
277	begin	294	begin
278	Close;	295	Close;
279	end;	296	end;
280		297
281	procedure TDelphiXDXPlayForm.NotebookPageChanged(Sender: TObject);	298	procedure TDelphiXDXPlayForm.NotebookPageChanged(Sender: TObject);
282	begin	299	begin
283	if Notebook.ActivePage='SelectProvider' then	300	if Notebook.ActivePage='SelectProvider' then
284	begin	301	begin
285	BackButton.Enabled := False;	302	BackButton.Enabled := False;
286	NextButton.Enabled := ProviderList.ItemIndex<>-1;	303	NextButton.Enabled := ProviderList.ItemIndex<>-1;
287	NextButton.Caption := DXPlayFormNext;	304	NextButton.Caption := DXPlayFormNext;
288	end else if Notebook.ActivePage='SessionType' then	305	end else if Notebook.ActivePage='SessionType' then
289	begin	306	begin
290	BackButton.Enabled := True;	307	BackButton.Enabled := True;
291	NextButton.Enabled := NewGame.Checked or JoinGame.Checked;	308	NextButton.Enabled := NewGame.Checked or JoinGame.Checked;
292	NextButton.Caption := DXPlayFormNext;	309	NextButton.Caption := DXPlayFormNext;
293	end else if Notebook.ActivePage='SessionNew' then	310	end else if Notebook.ActivePage='SessionNew' then
294	begin	311	begin
295	BackButton.Enabled := True;	312	BackButton.Enabled := True;
296	NextButton.Enabled := (NewGameSessionName.Text<>'') and (NewGamePlayerName.Text<>'');	313	NextButton.Enabled := (NewGameSessionName.Text<>'') and (NewGamePlayerName.Text<>'');
297	NextButton.Caption := DXPlayFormComplete;	314	NextButton.Caption := DXPlayFormComplete;
298	end else if Notebook.ActivePage='SessionJoin' then	315	end else if Notebook.ActivePage='SessionJoin' then
299	begin	316	begin
300	BackButton.Enabled := True;	317	BackButton.Enabled := True;
301	NextButton.Enabled := (JoinGameSessionList.ItemIndex<>-1) and (JoinGamePlayerName.Text<>'');	318	NextButton.Enabled := (JoinGameSessionList.ItemIndex<>-1) and (JoinGamePlayerName.Text<>'');
302	NextButton.Caption := DXPlayFormComplete;	319	NextButton.Caption := DXPlayFormComplete;
303	end;	320	end;
304	end;	321	end;
305		322
306	procedure TDelphiXDXPlayForm.JoinGameSessionListClick(Sender: TObject);	323	procedure TDelphiXDXPlayForm.JoinGameSessionListClick(Sender: TObject);
307	begin	324	begin
308	NotebookPageChanged(nil);	325	NotebookPageChanged(nil);
309		326
310	JoinGamePlayerList.Clear;	327	JoinGamePlayerList.Clear;
311	if JoinGameSessionList.ItemIndex<>-1 then	328	if JoinGameSessionList.ItemIndex<>-1 then
312	begin	329	begin
313	JoinGameGetPlayerListTimer.Enabled := False;	330	JoinGameGetPlayerListTimer.Enabled := False;
314	JoinGameGetPlayerListTimer.Enabled := True;	331	JoinGameGetPlayerListTimer.Enabled := True;
315	end;	332	end;
316	end;	333	end;
317		334
318	procedure TDelphiXDXPlayForm.ProviderListClick(Sender: TObject);	335	procedure TDelphiXDXPlayForm.ProviderListClick(Sender: TObject);
319	begin	336	begin
320	NotebookPageChanged(nil);	337	NotebookPageChanged(nil);
321	end;	338	end;
322		339
323	procedure TDelphiXDXPlayForm.NewGameClick(Sender: TObject);	340	procedure TDelphiXDXPlayForm.NewGameClick(Sender: TObject);
324	begin	341	begin
325	NotebookPageChanged(nil);	342	NotebookPageChanged(nil);
326	end;	343	end;
327		344
328	procedure TDelphiXDXPlayForm.EditKeyDown(Sender: TObject;	345	procedure TDelphiXDXPlayForm.EditKeyDown(Sender: TObject;
329	var Key: Word; Shift: TShiftState);	346	var Key: Word; Shift: TShiftState);
330	begin	347	begin
331	if (Key=VK_RETURN) and (NextButton.Enabled) then	348	if (Key=VK_RETURN) and (NextButton.Enabled) then
332	begin	349	begin
333	NextButtonClick(nil);	350	NextButtonClick(nil);
334	Key := 0;	351	Key := 0;
335	end;	352	end;
336	end;	353	end;
337		354
338	procedure TDelphiXDXPlayForm.NewGameSessionNameKeyDown(Sender: TObject;	355	procedure TDelphiXDXPlayForm.NewGameSessionNameKeyDown(Sender: TObject;
339	var Key: Word; Shift: TShiftState);	356	var Key: Word; Shift: TShiftState);
340	begin	357	begin
341	if NewGameSessionName.Text='' then Exit;	358	if NewGameSessionName.Text='' then Exit;
342		359
343	if Key=VK_RETURN then	360	if Key=VK_RETURN then
344	begin	361	begin
345	if NextButton.Enabled then	362	if NextButton.Enabled then
346	begin	363	begin
347	NextButtonClick(nil);	364	NextButtonClick(nil);
348	Key := 0;	365	Key := 0;
349	end else if NewGamePlayerName.Text='' then	366	end else if NewGamePlayerName.Text='' then
350	begin	367	begin
351	NewGamePlayerName.SetFocus;	368	NewGamePlayerName.SetFocus;
352	Key := 0;	369	Key := 0;
353	end;	370	end;
354	end;	371	end;
355	end;	372	end;
356		373
357	procedure TDelphiXDXPlayForm.NewGamePlayerNameKeyDown(Sender: TObject;	374	procedure TDelphiXDXPlayForm.NewGamePlayerNameKeyDown(Sender: TObject;
358	var Key: Word; Shift: TShiftState);	375	var Key: Word; Shift: TShiftState);
359	begin	376	begin
360	if NewGamePlayerName.Text='' then Exit;	377	if NewGamePlayerName.Text='' then Exit;
361		378
362	if Key=VK_RETURN then	379	if Key=VK_RETURN then
363	begin	380	begin
364	if NextButton.Enabled then	381	if NextButton.Enabled then
365	begin	382	begin
366	NextButtonClick(nil);	383	NextButtonClick(nil);
367	Key := 0;	384	Key := 0;
368	end else if NewGameSessionName.Text='' then	385	end else if NewGameSessionName.Text='' then
369	begin	386	begin
370	NewGameSessionName.SetFocus;	387	NewGameSessionName.SetFocus;
371	Key := 0;	388	Key := 0;
372	end;	389	end;
373	end;	390	end;
374	end;	391	end;
375		392
376	procedure TDelphiXDXPlayForm.JoinGameSessionListKeyDown(Sender: TObject;	393	procedure TDelphiXDXPlayForm.JoinGameSessionListKeyDown(Sender: TObject;
377	var Key: Word; Shift: TShiftState);	394	var Key: Word; Shift: TShiftState);
378	begin	395	begin
379	if JoinGameSessionList.ItemIndex=-1 then Exit;	396	if JoinGameSessionList.ItemIndex=-1 then Exit;
380		397
381	if Key=VK_RETURN then	398	if Key=VK_RETURN then
382	begin	399	begin
383	if NextButton.Enabled then	400	if NextButton.Enabled then
384	begin	401	begin
385	NextButtonClick(nil);	402	NextButtonClick(nil);
386	Key := 0;	403	Key := 0;
387	end else if JoinGamePlayerName.Text='' then	404	end else if JoinGamePlayerName.Text='' then
388	begin	405	begin
389	JoinGamePlayerName.SetFocus;	406	JoinGamePlayerName.SetFocus;
390	Key := 0;	407	Key := 0;
391	end;	408	end;
392	end;	409	end;
393	end;	410	end;
394		411
395	procedure TDelphiXDXPlayForm.JoinGamePlayerNameKeyDown(Sender: TObject;	412	procedure TDelphiXDXPlayForm.JoinGamePlayerNameKeyDown(Sender: TObject;
396	var Key: Word; Shift: TShiftState);	413	var Key: Word; Shift: TShiftState);
397	begin	414	begin
398	if JoinGamePlayerName.Text='' then Exit;	415	if JoinGamePlayerName.Text='' then Exit;
399		416
400	if Key=VK_RETURN then	417	if Key=VK_RETURN then
401	begin	418	begin
402	if NextButton.Enabled then	419	if NextButton.Enabled then
403	begin	420	begin
404	NextButtonClick(nil);	421	NextButtonClick(nil);
405	Key := 0;	422	Key := 0;
406	end else if JoinGameSessionList.ItemIndex=-1 then	423	end else if JoinGameSessionList.ItemIndex=-1 then
407	begin	424	begin
408	JoinGameSessionList.SetFocus;	425	JoinGameSessionList.SetFocus;
409	Key := 0;	426	Key := 0;
410	end;	427	end;
411	end;	428	end;
412	end;	429	end;
413		430
414	end.	431	end.
415		432
416		433

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXPlayFm.pas – Rev 1 → 4