Subversion Repositories spacemission

Rev

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

  1. unit DXPlayFm;
  2.  
  3. interface
  4. {$INCLUDE DelphiXcfg.inc}
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, DXPlay, ActiveX, DXETable, DIB,
  8. {$IfDef StandardDX}
  9.   DirectDraw, DirectPlay;
  10. {$Else}
  11.   DirectX;
  12. {$EndIf}
  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
  62.     DPlay: //{$IfDef DX7}
  63.       IDirectPlay4A;
  64.       //{$Else}IDirectPlay8Address{$EndIf};
  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
  114.     DPlay1: //{$IfDef DX7}
  115.       IDirectPlay;
  116.       //{$Else}IDirectPlay8Server{$EndIf};
  117.   begin
  118.     if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
  119.       raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  120.  
  121.     DPlay := DPlay1 as //{$IfDef DX7}
  122.       IDirectPlay4A//{$Else}IDirectPlay8Address{$EndIf}
  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));
  138.     {$IFDEF UNICODE}
  139.     TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameW, Pointer(Guid));
  140.     {$ELSE}
  141.     TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));
  142.     {$ENDIF}
  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
  248.         {$IFDEF UNICODE}
  249.         TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameW);
  250.         {$ELSE}
  251.         TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameA);
  252.         {$ENDIF}
  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
  284.       TempDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
  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.  
  433.