游戏开发论坛

 找回密码
 立即注册
搜索
查看: 5155|回复: 2

tv3d 6.5 for delphi 7 修改for vb6的一个例子

[复制链接]

5

主题

12

帖子

16

积分

新手上路

Rank: 1

积分
16
发表于 2009-6-8 06:59:00 | 显示全部楼层 |阅读模式
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,TV3D65_TLB ,Math;

type
      D3DVECTOR=record
      xouble;
      y:Double ;
      z:Double ;
end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    TV:TVEngine ;
    Scene:TVScene ;
    Input:TVInputEngine ;
    Globals:TVGlobals ;

    Mesh:TVMesh ;
    Atmos:TVAtmosphere ;
    TextureFactory :TVTextureFactory ;

    Position :D3DVECTOR;
    Lookat:D3DVECTOR ;
    Angle:D3DVECTOR ;

    Walk :Double ;
    Strafe:Double ;
    Procedure AppIdle(sender : TObject; var done : boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    TV := CoTVEngine.Create ;
    TV.SetDebugMode(True ,true ,True ,True);
    TV.SetDebugFile(ExtractFilePath(Application .ExeName ) + 'ErrLog.Log');

    TV.Init3DWindowed(Form1 .Handle ,True );
    TV.GetViewport.SetAutoResize(True );
    TV.DisplayFPS(True,-1);
    TV.SetAngleSystem(TV_ANGLE_DEGREE );
    TV.SetAntialiasing(True,0);

    Scene := CoTVScene.Create ;
    Globals := CoTVGlobals.Create ;
    Input := CoTVInputEngine.Create ;
    Input.Initialize(True ,True );

    TextureFactory := CoTVTextureFactory.Create ;
    Atmos := CoTVAtmosphere.Create ;
    Mesh := Scene.CreateMeshBuilder('MyMesh');

    Scene.SetBackgroundColor(0,0,0,0);

    TextureFactory.LoadTexture('.\media\top.bmp','stop',0,0,0,True);
    TextureFactory.LoadTexture('.\media\bottom.bmp','sbottom',0,0,0,True);
    TextureFactory.LoadTexture('.\media\left.bmp','sleft',0,0,0,True);
    TextureFactory.LoadTexture('.\media\right.bmp','sright',0,0,0,True);
    TextureFactory.LoadTexture('.\media\front.bmp','sfront',0,0,0,True);
    TextureFactory.LoadTexture('.\media\back.bmp','sback',0,0,0,True);

    Atmos.SkyBox_SetTexture(Globals.GetTex('sfront'), Globals.GetTex('sback'), Globals.GetTex('sleft'), Globals.GetTex('sright'), Globals.GetTex('stop'), Globals.GetTex('sbottom'));
    Atmos.SkyBox_Enable(True);

    TextureFactory.LoadTexture( '.\media\fieldstone.tga', 'floor',0,0,0,True);
    TextureFactory.LoadTexture( '.\media\roof1.bmp', 'wall',0,0,0,True);

    Mesh.AddWall(Globals.GetTex('wall'),500, -500, -500, -500, 100, 0, 3, 1,True);
    Mesh.AddWall(Globals.GetTex('wall'),-500, -500, -500, 500, 100, 0, 3, 1,True);
    Mesh.AddWall(Globals.GetTex('wall'),-500, 500, 500, 500, 100, 0, 3, 1,True);
    Mesh.AddWall(Globals.GetTex('wall'),500, 500, 500, -500, 100, 0, 3, 1,True);

    Mesh.AddFloor(Globals.GetTex('floor'),-500, -500, 500, 500, 0, 10, 10,true) ;


    Position.x :=1;
    Position.x := 0;
    Position.y := 40;
    Position.z := 0;
    LookAt.x := 50;
    LookAt.y := 20;
    LookAt.z := 50;
    Walk := 0;
    Strafe := 0;


    Scene.SetViewFrustum(60,10000);

    Form1.Show;

    Application.OnIdle := AppIdle;

end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TV := nil;

end;


procedure TForm1.AppIdle(sender : TObject; var done : boolean);
var
  mx,my:Integer;
begin
  mx:=0;
  my:=0;
  if Form1.Focused then begin
     repeat
        Application.ProcessMessages;

       // if Input.IsKeyPressed(TV_KEY_W) then ShowMessage('OK');
        if Input.IsKeyPressed(TV_KEY_UP) then Walk := 1;

        if Input.IsKeyPressed(TV_KEY_DOWN) then Walk := -1;
        if input.IsKeyPressed(TV_KEY_LEFT) then Strafe := 1;
        if input.IsKeyPressed(TV_KEY_RIGHT) then Strafe := -1;

        //input.GetMousePosition(mx,my);

        Angle.x := Angle.x - MY div 100;
        Angle.y := Angle.y - MX div 100;

       If Angle.x > 1.3 Then Angle.x := 1.3;
       If Angle.x < -1.3 Then Angle.x := -1.3;

       if Walk >0 then begin
         Walk :=Walk - 0.05;
         if Walk <0 then Walk := 0;
         end;

        if Walk <0 then begin
         Walk :=Walk + 0.05;
         if Walk >0 then Walk := 0;
        end;

        if Strafe >0 then begin
          Strafe := Strafe - 0.05;
          if Strafe <0 then Strafe := 0;
        end;

        if Strafe <0 then begin
          Strafe := Strafe + 0.05;
          if Strafe >0 then Strafe := 0;
        end;

         Position.x := Position.x + (Cos(Angle.y) * Walk * TV.TimeElapsed) + (Cos(Angle.y + 1) * Strafe * TV.TimeElapsed);
         Position.z := Position.z + (Sin(Angle.y) * Walk * TV.TimeElapsed) + (Sin(Angle.y + 1) * Strafe * TV.TimeElapsed);

         LookAt.x := Position.x + Cos(Angle.y);
         LookAt.y := Position.y + Tan(Angle.x);
         LookAt.z := Position.z + Sin(Angle.y);


        Scene.SetCamera(Position.x,Position.y, Position.z, LookAt.x, LookAt.y, LookAt.z);
        TV.Clear(False);
        Atmos.Atmosphere_Render;
        Atmos.Fog_Enable(true);
        Mesh.Render;
        Scene.RenderAll(True,True );
        TV.RenderToScreen ;


   until  Input.IsKeyPressed(TV_KEY_ESCAPE);

     Close();



  end;

end;

end.

5

主题

12

帖子

16

积分

新手上路

Rank: 1

积分
16
 楼主| 发表于 2009-6-8 07:02:00 | 显示全部楼层

Re:tv3d 6.5 for delphi 7 修改for vb6的一个例子

为了学习delphi下作tv3d ,不想使用老的,所以琢磨了一个晚上没休息。
首先用delphi导入dll 会在目录下import产生一个pas,就是调用这个pas。
然后创建一个结构体
D3DVECTOR
找了下,不用安装dx

本来这段需要switch但delphi的限制多都,只好写成笨的方式。
if Walk >0 then begin
         Walk :=Walk - 0.05;
         if Walk <0 then Walk := 0;
         end;

        if Walk <0 then begin
         Walk :=Walk + 0.05;
         if Walk >0 then Walk := 0;
        end;

        if Strafe >0 then begin
          Strafe := Strafe - 0.05;
          if Strafe <0 then Strafe := 0;
        end;

        if Strafe <0 then begin
          Strafe := Strafe + 0.05;
          if Strafe >0 then Strafe := 0;
        end;
。。
很多函数参数都增加了,不会的,直接0跳过。。

0

主题

1

帖子

6

积分

禁止发言

积分
6
发表于 2013-10-27 17:59:01 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

作品发布|文章投稿|广告合作|关于本站|游戏开发论坛 ( 闽ICP备17032699号-3 )

GMT+8, 2025-2-26 08:12

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表