Subversion Repositories spacemission

Rev

Rev 1 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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