Subversion Repositories spacemission

Rev

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

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