Subversion Repositories spacemission

Rev

Rev 4 | Details | Compare with Previous | Last modification | View Log | RSS feed

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