Menu

反射技术

用Delphi开发DirectX控件
整理编辑:China ASP

 

  Microsoft推出的DirectX使我们在Windows9x下开发游戏软件便利了许多。一般在介绍DirectX
的资料里都讲的是如何用VC++来开发,其实inprise公司的语言也可以用来开发基于DirectX的游戏软件。我们这里用的是DirectX控件,它有Delphi3和Delphi4不同的版本。在

处你可以download,是由一个日本人写的,而且,这套控件是完全免费的,你可以自由使用。在这套控件里有DirectX的各种范例程序,我们今天来讨论一下其中基于DirectX的网络通信程序如何开发。

[delphi] view
plain copy

  想必大家都看到过那些硝烟纷飞的即时战略游戏,这些游戏中一个很诱人的买点就是可以几个人同时加入战斗,各自扮演一方高手,杀它个你死我活。那么这些即时战略游戏中的网络对战部分是怎么写的呢?其实在Microsoft的DirectX中专门有一类API就是负责网络通信的,不管是基于IPX,还是TCP/IP,或者是Modem,它都可以圆满解决。而作为程序设计的我们一般来说不用操心这些连接方式不同而带来的代码的不同,我们可以一视同仁,只要写一套统一的代码就可以了,各种连接方式的细节问题我们就交给DirectX去处理了。

 

  下面我们具体分析一下一个chat聊天程序的构造。运行samples
etworkchat.dpr,我们就看到了一个最简单的聊天程序了。首先程序会让你选择连接的方式:IPX连接、Internet
TCP/IP连接、调制解调器连接和串行连接;选择好连接方式后(下面假设你是选择用TCP/IP方式连接),你可以选择是创建一个新游戏还是进入一个已经存在的游戏(当然现在这里的游戏就是指一个聊天程序!);如果你是选择建立一个新游戏,那么接下来要你输入游戏的名字和你的名字,然后聊天就开始了;如果你是选择加入一个已经存在的游戏的话,那么你可以通过输入指定的IP地址来连接或者索性让程序去搜索有哪些已经存在的游戏名字。如果你在连接方式中选择的是调制解调器连接的话,就稍微复杂一些,需要选择调制解调器,并准备拨号和应答等。有没有发现这些连接的方式和过程和我们通常在游戏中看到的很相似?由于这些关于连接的对话框都是由DirectX提供的,因而会有一点语言上的问题。如果你安装的是DirectX的中文版本的话,那么你看见的将全部是中文。(顺便说一句,这套Delphi
控件所支持的DirectX必须在5.0版本以上。)
  这个程序本身并不复杂,下面是其主要的几个过程,我们已经加上了较为详细的注释:

  1. unit Unit_main;  
  2.   
  3. interface  
  4.   
  5. uses  
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  7.   Dialogs, StdCtrls, TypInfo;  
  8.   
  9. type  
  10.   TForm_main = class(TForm)  
  11.     Button1: TButton;  
  12.     Memo1: TMemo;  
  13.     Memo2: TMemo;  
  14.     Button2: TButton;  
  15.     Button3: TButton;  
  16.     Button4: TButton;  
  17.     Button5: TButton;  
  18.     Button6: TButton;  
  19.     Button7: TButton;  
  20.     Button8: TButton;  
  21.     Button9: TButton;  
  22.     Button10: TButton;  
  23.     Button11: TButton;  
  24.     Button12: TButton;  
  25.     Button13: TButton;  
  26.     procedure Button1Click(Sender: TObject);  
  27.     procedure Button2Click(Sender: TObject);  
  28.     procedure Button3Click(Sender: TObject);  
  29.     procedure Button4Click(Sender: TObject);  
  30.     procedure Button5Click(Sender: TObject);  
  31.     procedure Button6Click(Sender: TObject);  
  32.     procedure Button7Click(Sender: TObject);  
  33.     procedure Button8Click(Sender: TObject);  
  34.     procedure Button9Click(Sender: TObject);  
  35.     procedure Button10Click(Sender: TObject);  
  36.     procedure Button11Click(Sender: TObject);  
  37.     procedure Button12Click(Sender: TObject);  
  38.     procedure Button13Click(Sender: TObject);  
  39.   private  
  40.     { Private declarations }  
  41.   public  
  42.     { Public declarations }  
  43.   end;  
  44.   
  45.   PTKeyDog = ^TKeyDog;  
  46.   
  47.   TKeyDog = record  
  48.     id: Integer;  
  49.     projectname: string;  
  50.     city: string;  
  51.     letter: string;  
  52.     hash: string;  
  53.     code: string;  
  54.     note: string;  
  55.     filepath: string;  
  56.     userid: Integer;  
  57.   end;  
  58.   
  59.   { 自定义的类 }  
  60.   TMyClass = class(TComponent)  
  61.   public  
  62.     procedure msg(const str: string);  
  63.     function Add(const a, b: Integer): Integer;  
  64.   end;  
  65.   
  66.   
  67.   // 编译指令 Methodinfo 是 Delphi 2009 新增的, 只有它打开了, ObjAuto 才可以获取 public 区的信息.  
  68.   // 这样, ObjAuto 可以获取 TClass3 的 public、published 和默认区域的信息.  
  69. {$M+}  
  70. {$METHODINFO ON}  
  71.   
  72.   TClass3 = class  
  73.     function Fun3: string;  
  74.   private  
  75.     function Fun3Private: string;  
  76.   protected  
  77.     function Fun3Protected: string;  
  78.   public  
  79.     function Fun3Public: string;  
  80.   published  
  81.     function Fun3Published: string;  
  82.   end;  
  83. {$METHODINFO OFF}  
  84. {$M-}  
  85.   
  86. var  
  87.   Form_main: TForm_main;  
  88.   
  89. implementation  
  90.   
  91. uses  
  92.   Rtti, ObjAuto;  
  93. {$R *.dfm}  
  94.   
  95. // 获取对象的 RTTI 属性与事件的函数  
  96. function GetPropertyAndEventList(obj: TObject;  
  97.   pList, eList: TStringList): Boolean;  
  98. var  
  99.   ClassTypeInfo: PTypeInfo; { 类的信息结构指针 }  
  100.   ClassDataInfo: PTypeData; { 类的数据结构指针 }  
  101.   propertyList: PPropList; { TPropInfo 是属性的数据结构; 
  102.     PPropList 是其指针; 
  103.     TPropList 是属性结构指针的列表数组; 
  104.     PPropList 是指向这个数组的指针 }  
  105.   
  106.   num: Integer; { 记录属性的总数 }  
  107.   size: Integer; { 记录属性结构的大小 }  
  108.   i: Integer;  
  109. begin  
  110.   ClassTypeInfo := obj.ClassInfo; { 先获取: 类的信息结构指针 }  
  111.   ClassDataInfo := GetTypeData(ClassTypeInfo); { 再获取: 类的数据结构指针 }  
  112.   num := ClassDataInfo.PropCount; { 属性总数 }  
  113.   size := SizeOf(TPropInfo); { 属性结构大小 }  
  114.   
  115.   GetMem(propertyList, size * num); { 给属性数组分配内存 }  
  116.   
  117.   GetPropInfos(ClassTypeInfo, propertyList); { 获取属性列表 }  
  118.   
  119.   for i := 0 to num – 1 do  
  120.   begin  
  121.     if propertyList[i].PropType^.Kind = tkMethod then { 如果是事件; 事件也是属性吗, 给分出来 }  
  122.       eList.Add(propertyList[i].Name)  
  123.     else  
  124.       pList.Add(propertyList[i].Name);  
  125.   end;  
  126.   
  127.   pList.Sort;  
  128.   eList.Sort; { 排序 }  
  129.   
  130.   FreeMem(propertyList); { 释放属性数组的内存 }  
  131.   
  132.   Result := True;  
  133. end;  
  134.   
  135. procedure TForm_main.Button10Click(Sender: TObject);  
  136. var  
  137.   obj: TMyClass;  
  138.   t: TRttiType;  
  139.   m1, m2: TRttiMethod;  
  140.   r: TValue; // TRttiMethod.Invoke 的返回类型  
  141. begin  
  142.   t := TRttiContext.Create.GetType(TMyClass);  
  143.   { 获取 TMyClass 类的两个方法 }  
  144.   m1 := t.GetMethod(‘msg’); { procedure }  
  145.   m2 := t.GetMethod(‘Add’); { function }  
  146.   
  147.   obj := TMyClass.Create(Self); { 调用需要依赖一个已存在的对象 }  
  148.   
  149.   { 调用 msg 过程 }  
  150.   m1.Invoke(obj, [‘Delphi 2010’]); { 将弹出信息框 }  
  151.   
  152.   { 调用 Add 函数 }  
  153.   r := m2.Invoke(obj, [1, 2]); { 其返回值是个 TValue 类型的结构 }  
  154.   ShowMessage(IntToStr(r.AsInteger)); { 3 }  
  155.   
  156.   obj.Free;  
  157. end;  
  158.   
  159. procedure TForm_main.Button11Click(Sender: TObject);  
  160. var  
  161.   obj: TMyClass;  
  162.   t: TRttiType;  
  163.   p: TRttiProperty;  
  164.   r: TValue;  
  165. begin  
  166.   obj := TMyClass.Create(Self);  
  167.   t := TRttiContext.Create.GetType(TMyClass);  
  168.   
  169.   p := t.GetProperty(‘Name’); // 继承自TComponent的name  
  170.   
  171.   r := p.GetValue(obj);  
  172.   ShowMessage(r.AsString); { 原来的 }  
  173.   
  174.   p.SetValue(obj, ‘NewName’);  
  175.   r := p.GetValue(obj);  
  176.   ShowMessage(r.AsString); { NewName }  
  177.   
  178.   obj.Free;  
  179. end;  
  180.   
  181. procedure TForm_main.Button12Click(Sender: TObject);  
  182. var  
  183.   t: TRttiType;  
  184.   p: TRttiProperty;  
  185.   r: TValue;  
  186. begin  
  187.   t := TRttiContext.Create.GetType(TButton);  
  188.   
  189.   p := t.GetProperty(‘Align’);  
  190.   p.SetValue(Button1, TValue.FromOrdinal(TypeInfo(TAlign), Ord(alLeft)));  
  191.   
  192.   r := p.GetValue(Button1);  
  193.   ShowMessage(IntToStr(r.AsOrdinal)); { 3 }  
  194. end;  
  195.   
  196. procedure TForm_main.Button13Click(Sender: TObject);  
  197. var  
  198.   MiArr: TMethodInfoArray;  
  199.   Mi: PMethodInfoHeader;  
  200.   obj: TClass3;  
  201. begin  
  202.   obj := TClass3.Create;  
  203.   MiArr := GetMethods(obj.ClassType);  
  204.   
  205.   Memo1.Clear;  
  206.   for Mi in MiArr do  
  207.     Memo1.Lines.Add(string(Mi.Name));  
  208.   
  209.   obj.Free;  
  210. end;  
  211.   
  212. procedure TForm_main.Button1Click(Sender: TObject);  
  213. var  
  214.   propertyL, EventL: TStringList;  
  215. begin  
  216.   // 属性  
  217.   propertyL := TStringList.Create;  
  218.   // 事件  
  219.   EventL := TStringList.Create;  
  220.   
  221.   Memo1.Clear;  
  222.   Memo2.Clear;  
  223.   
  224.   GetPropertyAndEventList(Self, propertyL, EventL); { 调用函数, 第一个参数是对象名 }  
  225.   Memo1.Lines := propertyL;  
  226.   Memo2.Lines := EventL;  
  227.   
  228.   propertyL.Free;  
  229.   EventL.Free;  
  230. end;  
  231.   
  232. procedure TForm_main.Button2Click(Sender: TObject);  
  233. var  
  234.   ctx: TRttiContext;  
  235.   t: TRttiType;  
  236. begin  
  237.   Memo1.Clear;  
  238.   for t in ctx.GetTypes do  
  239.     Memo1.Lines.Add(t.Name);  
  240. end;  
  241.   
  242. procedure TForm_main.Button3Click(Sender: TObject);  
  243. var  
  244.   ctx: TRttiContext;  
  245.   t: TRttiType;  
  246.   m: TRttiMethod;  
  247. begin  
  248.   Memo1.Clear;  
  249.   t := ctx.GetType(TButton);  
  250.   // for m in t.GetMethods do Memo1.Lines.Add(m.Name);  
  251.   for m in t.GetMethods do  
  252.     Memo1.Lines.Add(m.ToString);  
  253. end;  
  254.   
  255. procedure TForm_main.Button4Click(Sender: TObject);  
  256. var  
  257.   ctx: TRttiContext;  
  258.   t: TRttiType;  
  259.   p: TRttiProperty;  
  260. begin  
  261.   Memo1.Clear;  
  262.   t := ctx.GetType(TButton);  
  263.   // for p in t.GetProperties do Memo1.Lines.Add(p.Name);  
  264.   for p in t.GetProperties do  
  265.     Memo1.Lines.Add(p.ToString);  
  266. end;  
  267.   
  268. procedure TForm_main.Button5Click(Sender: TObject);  
  269. var  
  270.   ctx: TRttiContext;  
  271.   t: TRttiType;  
  272.   f: TRttiField;  
  273. begin  
  274.   Memo1.Clear;  
  275.   t := ctx.GetType(TButton);  
  276.   // for f in t.GetFields do Memo1.Lines.Add(f.Name);  
  277.   for f in t.GetFields do  
  278.     Memo1.Lines.Add(f.ToString);  
  279. end;  
  280.   
  281. //   
  282. procedure TForm_main.Button6Click(Sender: TObject);  
  283. var  
  284.   ctx: TRttiContext;  
  285.   t: TRttiType;  
  286.   ms: TArray<TRttiMethod>;  
  287.   ps: TArray<TRttiProperty>;  
  288.   fs: TArray<TRttiField>;  
  289. begin  
  290.   Memo1.Clear;  
  291.   t := ctx.GetType(TButton);  
  292.   
  293.   ms := t.GetMethods;  
  294.   ps := t.GetProperties;  
  295.   fs := t.GetFields;  
  296.   
  297.   Memo1.Lines.Add(Format(‘%s 类共有 %d 个方法’, [t.Name, Length(ms)]));  
  298.   Memo1.Lines.Add(Format(‘%s 类共有 %d 个属性’, [t.Name, Length(ps)]));  
  299.   Memo1.Lines.Add(Format(‘%s 类共有 %d 个字段’, [t.Name, Length(fs)]));  
  300. end;  
  301.   
  302. procedure TForm_main.Button7Click(Sender: TObject);  
  303. var  
  304.   t: TRttiRecordType;  
  305.   f: TRttiField;  
  306. begin  
  307.   Memo1.Clear;  
  308.   t := TRttiContext.Create.GetType(TypeInfo(TPoint)).AsRecord;  
  309.   Memo1.Lines.Add(t.QualifiedName);  
  310.   Memo1.Lines.Add(Format(‘Size: %d’, [t.TypeSize]));  
  311.   Memo1.Lines.Add(EmptyStr);  
  312.   
  313.   Memo1.Lines.Add(Format(‘字段数: %d’, [Length(t.GetFields)]));  
  314.   Memo1.Lines.Add(Format(‘方法数: %d’, [Length(t.GetMethods)]));  
  315.   Memo1.Lines.Add(Format(‘属性数: %d’, [Length(t.GetProperties)]));  
  316.   Memo1.Lines.Add(EmptyStr);  
  317.   
  318.   Memo1.Lines.Add(‘全部字段:’);  
  319.   for f in t.GetFields do  
  320.     Memo1.Lines.Add(f.ToString);  
  321. end;  
  322.   
  323. procedure TForm_main.Button8Click(Sender: TObject);  
  324. var  
  325.   t: TRttiRecordType;  
  326.   f: TRttiField;  
  327. begin  
  328.   Memo1.Clear;  
  329.   t := TRttiContext.Create.GetType(TypeInfo(TKeyDog)).AsRecord;  
  330.   Memo1.Lines.Add(t.QualifiedName);  
  331.   Memo1.Lines.Add(Format(‘Size: %d’, [t.TypeSize]));  
  332.   Memo1.Lines.Add(EmptyStr);  
  333.   
  334.   Memo1.Lines.Add(Format(‘字段数: %d’, [Length(t.GetFields)]));  
  335.   Memo1.Lines.Add(Format(‘方法数: %d’, [Length(t.GetMethods)]));  
  336.   Memo1.Lines.Add(Format(‘属性数: %d’, [Length(t.GetProperties)]));  
  337.   Memo1.Lines.Add(EmptyStr);  
  338.   
  339.   Memo1.Lines.Add(‘全部字段:’);  
  340.   for f in t.GetFields do  
  341.     Memo1.Lines.Add(f.ToString);  
  342. end;  
  343.   
  344. procedure TForm_main.Button9Click(Sender: TObject);  
  345. var  
  346.   t: TRttiOrdinalType;  
  347. begin  
  348.   Memo1.Clear;  
  349.   
  350.   // 先从类型名获取类型信息对象  
  351.   t := TRttiContext.Create.GetType(TypeInfo(Byte)) as TRttiOrdinalType;  
  352.   Memo1.Lines.Add(Format(‘%s – %s’, [t.Name, t.QualifiedName]));  
  353.   Memo1.Lines.Add(Format(‘Size: %d’, [t.TypeSize]));  
  354.   Memo1.Lines.Add(‘QualifiedName: ‘ + t.QualifiedName);  
  355.   Memo1.Lines.Add(Format(‘Min,Max: %d , %d’, [t.MinValue, t.MaxValue]));  
  356.   Memo1.Lines.Add(EmptyStr); // 空字串  
  357.   
  358.   // 可以用 AsOrdinal 方法代替前面的 as TRttiOrdinalType  
  359.   t := TRttiContext.Create.GetType(TypeInfo(Word)).AsOrdinal;  
  360.   Memo1.Lines.Add(Format(‘%s: %s’, [t.Name, t.QualifiedName]));  
  361.   Memo1.Lines.Add(Format(‘Size: %d’, [t.TypeSize]));  
  362.   Memo1.Lines.Add(Format(‘Min,Max: %d , %d’, [t.MinValue, t.MaxValue]));  
  363.   Memo1.Lines.Add(EmptyStr);  
  364.   
  365.   // 也可以直接强制转换  
  366.   t := TRttiOrdinalType(TRttiContext.Create.GetType(TypeInfo(Integer)));  
  367.   Memo1.Lines.Add(Format(‘%s: %s’, [t.Name, t.QualifiedName]));  
  368.   Memo1.Lines.Add(Format(‘Size: %d’, [t.TypeSize]));  
  369.   Memo1.Lines.Add(Format(‘Min,Max: %d , %d’, [t.MinValue, t.MaxValue]));  
  370.   Memo1.Lines.Add(EmptyStr);  
  371. end;  
  372.   
  373. { TMyClass }  
  374.   
  375. function TMyClass.Add(const a, b: Integer): Integer;  
  376. begin  
  377.   Result := a + b;  
  378. end;  
  379.   
  380. procedure TMyClass.msg(const str: string);  
  381. begin  
  382.   MessageDlg(str, mtInformation, [mbYes], 0);  
  383. end;  
  384.   
  385. 美高梅开户,{ TClass3 }  
  386.   
  387. function TClass3.Fun3: string;  
  388. begin  
  389.   Result := ‘Fun3’;  
  390. end;  
  391.   
  392. function TClass3.Fun3Private: string;  
  393. begin  
  394.   Result := ‘Fun3Private’;  
  395. end;  
  396.   
  397. function TClass3.Fun3Protected: string;  
  398. begin  
  399.   Result := ‘Fun3Protected’;  
  400. end;  
  401.   
  402. function TClass3.Fun3Public: string;  
  403. begin  
  404.   Result := ‘Fun3Public’;  
  405. end;  
  406.   
  407. function TClass3.Fun3Published: string;  
  408. begin  
  409.   Result := ‘Fun3Published’;  
  410. end;  
  411.   
  412. end.  

  //增加游戏者
  procedure TMainForm.DXPlay1AddPlayer(Sender: TObject; Player:
TDXPlayPlayer);
  begin
     Memo1.Lines.Add(Format( %s entered a room., [Player.Name]));
  end;

 

  //游戏者离开
  procedure TMainForm.DXPlay1DeletePlayer(Sender: TObject;Player:
TDXPlayPlayer);
  begin
     Memo1.Lines.Add(Format( %s left a room., [Player.Name]));
  end;

  
  //DirectPlay打开
  procedure TMainForm.DXPlay1Open(Sender: TObject);
  var
     i: Integer;
  begin
     for i:=0 to DXPlay1.Players.Count-1 do
          if DXPlay1.Players[i].RemotePlayer then
            Memo1.Lines.Add(Format( %s is entering a room.,
[DXPlay1.Players[i].Name]));
    end;

   procedure TMainForm.FormDestroy(Sender: TObject);
  begin
     DXPlay1.Close;
  end;

  //窗口创建执行事件
  procedure TMainForm.FormCreate(Sender: TObject);
  begin
   try
      //DirectPlay 打开
        DXPlay1.Open;
   except
     //防错处理
        on E: Exception do
        begin
          Application.ShowMainForm := False;
          Application.HandleException(E);
          Application.Terminate;
        end;
   end;

   //显示有关信息在窗口的caption
   MainForm.Caption := Format(%s : %s, [DXPlay1.ProviderName,
DXPlay1.SessionName]);
  end;

  //当有消息发送时
  procedure TMainForm.DXPlay1Message(Sender: TObject; Player:
TDXPlayPlayer; Data: Pointer;DataSize: Integer);
  var
     s: string;
  begin
   case DXPlayMessageType(Data) of
      DXCHAT_MESSAGE:
      begin
          if TDXChatMessage(Data^).Len<=0 then
            s :=
          else begin
            //计算字符串长度和内容
            SetLength(s, TDXChatMessage(Data^).Len);
            StrLCopy(PChar(s), @TDXChatMessage(Data^).c, Length(s));
          end;

          //显示收到的消息
          Memo1.Lines.Add(Format(%s> %s, [Player.Name, s]));
      end;
   end;
  end;

  //发送按钮
  procedure TMainForm.Button1Click(Sender: TObject);
  var
   Msg: ^TDXChatMessage;
   MsgSize: Integer;
  begin
     MsgSize := SizeOf(TDXChatMessage)+Length(Edit1.Text);
     GetMem(Msg, MsgSize);
     try
        Msg.dwType := DXCHAT_MESSAGE;
        Msg.Len := Length(Edit1.Text);
        StrLCopy(@Msg^.c, PChar(Edit1.Text), Length(Edit1.Text));
     
        //发送消息到所有的人
        DXPlay1.SendMessage(DPID_ALLPLAYERS, Msg, MsgSize);

        //发送消息到自己
        DXPlay1.SendMessage(DXPlay1.LocalPlayer.ID, Msg, MsgSize);
        Edit1.Text := ;
   finally
     FreeMem(Msg);
   end;
  end;

  TDXPlay控件是写这类程序的关键,其属性、事件和方法并不多。GUID属性用来程序的自我识别,具有相同GUID的程序互相之间就能识别,所以你可以看到GUID是一个很长的数字;Open方法用来打开通讯端口,Close用来关闭通讯端口;SendMessage方法是用来发送消息到所有的游戏者,当你的程序收到消息的时候,会产生OnMessage
事件。

  这个程序的代码应该是相当简练了,但是却完成了点对点的多点聊天功能。如果你在自己的程序里约定好一套规则,那么你的程序也就具备了互相的通信能力,是不是感觉很简单?可以说,利用DirectX来写这方面的通信程序是最佳的选择,你可以对网络的知识完全不懂,因为这一切已经由Microsoft花费了大量人力物力进行优化的代码来完成了。如果说有什么缺点,就是要求用户的电脑上一定要安装上DirectX,这在现在win98越来越普及的情况下,并不是一件难事。再说,Microsoft的DirectX也是一套完全免费的软件。利用DirectX优秀的性能加上功能强大的
Delphi语言,相信你一定能写出一套优秀的游戏软件(当然拥有设计良好的对战功能)。

Copyright © 上海聚声计算机系统工程有限责任公司 1999-2000, All
Rights Reserved

标签:,

发表评论

电子邮件地址不会被公开。 必填项已用*标注

相关文章

网站地图xml地图