Subversion Repositories spacemission

Rev

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

  1. unit DXPlayFm;
  2.  
  3. {$INCLUDE DelphiXcfg.inc}
  4.  
  5. {$IFNDEF UseDirectPlay}
  6. // If you want to use DXPlayFm.pas, please enable the IFDEF UseDirectPlay in DelphiXcfg.inc
  7. interface
  8. implementation
  9. {$ELSE} // !UseDirectPlay
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  15.   StdCtrls, ExtCtrls, DXPlay, ActiveX, DXETable, DIB,
  16. {$IfDef StandardDX}
  17.   DirectDraw, DirectPlay;
  18. {$Else}
  19.   DirectX;
  20. {$EndIf}
  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
  70.     DPlay: //{$IfDef DX7}
  71.       IDirectPlay4A;
  72.       //{$Else}IDirectPlay8Address{$EndIf};
  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
  122.     DPlay1: //{$IfDef DX7}
  123.       IDirectPlay;
  124.       //{$Else}IDirectPlay8Server{$EndIf};
  125.   begin
  126.     if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
  127.       raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  128.  
  129.     DPlay := DPlay1 as //{$IfDef DX7}
  130.       IDirectPlay4A//{$Else}IDirectPlay8Address{$EndIf}
  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));
  146.     {$IFDEF UNICODE}
  147.     TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameW, Pointer(Guid));
  148.     {$ELSE}
  149.     TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));
  150.     {$ENDIF}
  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
  256.         {$IFDEF UNICODE}
  257.         TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameW);
  258.         {$ELSE}
  259.         TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameA);
  260.         {$ENDIF}
  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
  292.       TempDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
  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.  
  439. {$ENDIF} // UseDirectPlay
  440.  
  441. end.
  442.  
  443.