vbgood的acmepjz大神做的例子
镇楼
，本来想放原帖地址，实在找不到了。。。。
还有度娘啊我这不是广告贴，跪求别删了好么。。。。

自己做的一个简单的例子，顶点被我搞乱了，大家凑活着看看吧。。。。

看大家都用了dx9了，不用hlsl effect这种简单而且极其强大的东西实在是比较可惜的，看吧里似乎没有发过。。。。

有人看木有 @《顾名思义》 @hhyjq007

ding

其实实现起来是很简单的，唯一需要注意的就是hlsl不要用ps_input或者output结构，否则没法显示
Dim inputdata As String
Dim s2 As String
Dim ret As Long
Dim buf As D3DXBuffer
Open filename For Input As #1
inputdata = StrConv(InputB(LOF(1), 1), vbUnicode)
Close #1
If Len(inputdata) = 0 Then
MsgBox "readfailed"
End
End If
Dim s As String
s = inputdata
s = StrConv(s, vbFromUnicode)
ret = D3DXCreateEffect(d3dd9, ByVal StrPtr(s), LenB(s), ByVal 0, ByVal 0, 0, Nothing, d3dxe, buf)
If ret < 0 Then
s2 = "Can't create D3DXEffect!! &H" + Hex(ret)
If Not buf Is Nothing Then
ret = buf.GetBufferSize
s = Space(ret)
CopyMemory ByVal StrPtr(s), ByVal buf.GetBufferPointer, ret
s = StrConv(s, vbUnicode)
ret = InStr(1, s, vbNullChar)
If ret > 0 Then s = Left(s, ret - 1)
s2 = s2 + vbCr + s
End If
MsgBox s2, vbCritical, "Fatal Error"
'end
Form_Unload 0
End
End If
然后在绘制的时候指定technology和pass就可以了

直接把代码放上来吧
Private d3d9 As Direct3D9
Private d3dd9 As Direct3DDevice9
Private d3dxe As D3DXEffect
Const Pi As Single = 3.1415926
Private sResultTech As String
Private texa0 As Direct3DTexture9
Private texa1 As Direct3DTexture9
Dim quadvb As Direct3DVertexBuffer9
Private d3dpp As D3DPRESENT_PARAMETERS
Private d3ddm As D3DDISPLAYMODE
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Dim a(3) As pointstruct
Private Sub LoadPic(ByVal PicName As String, Tex As Direct3DTexture9)
Dim DXInfo As D3DXIMAGE_INFO
D3DXCreateTextureFromFileExW d3dd9, PicName, D3DX_DEFAULT_NONPOW2, D3DX_DEFAULT_NONPOW2, 1, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, D3DX_DEFAULT, D3DX_DEFAULT, 0, DXInfo, ByVal 0, Tex
End Sub
Private Sub Form_Load()
Set d3d9 = Direct3DCreate9(D3D_SDK_VERSION)
If d3d9 Is Nothing Then
MsgBox "Can't create D3D9!!!", vbCritical, "Fatal Error"
Form_Unload 0
End
End If
d3d9.GetAdapterDisplayMode 0, d3ddm
With d3dpp
.hDeviceWindow = Me.hWnd
.SwapEffect = D3DSWAPEFFECT_DISCARD
'.BackBufferCount = 1
.BackBufferFormat = D3DFMT_UNKNOWN
'.BackBufferWidth = w
' .BackBufferHeight = h
.Windowed = 1
.EnableAutoDepthStencil = 1
.AutoDepthStencilFormat = D3DFMT_D16
End With
'create device
Set d3dd9 = d3d9.CreateDevice(0, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
If d3dd9 Is Nothing Then
MsgBox "Can't create D3D9 device!!!", vbCritical, "Fatal Error"
Form_Unload 0
End
End If
d3dd9.SetFVF D3DFVF_XYZRHW Or D3DFVF_TEX2
' create texture
LoadPic "Bleach.jpg", texa0
LoadPic "chopper.bmp", texa1
If texa0 Is Nothing Then MsgBox "create texture failed"
vertexarray
initgeograpy
createEffect "Effect.txt"
End Sub
Public Sub createEffect(ByVal filename As String)
Dim inputdata As String
Dim s2 As String
Dim ret As Long
Dim buf As D3DXBuffer
Open filename For Input As #1
inputdata = StrConv(InputB(LOF(1), 1), vbUnicode)
Close #1
If Len(inputdata) = 0 Then
MsgBox "readfailed"
End
End If
Dim s As String
s = inputdata
s = StrConv(s, vbFromUnicode)
ret = D3DXCreateEffect(d3dd9, ByVal StrPtr(s), LenB(s), ByVal 0, ByVal 0, 0, Nothing, d3dxe, buf)
If ret < 0 Then
s2 = "Can't create D3DXEffect!! &H" + Hex(ret)
If Not buf Is Nothing Then
ret = buf.GetBufferSize
s = Space(ret)
CopyMemory ByVal StrPtr(s), ByVal buf.GetBufferPointer, ret
s = StrConv(s, vbUnicode)
ret = InStr(1, s, vbNullChar)
If ret > 0 Then s = Left(s, ret - 1)
s2 = s2 + vbCr + s
End If
MsgBox s2, vbCritical, "Fatal Error"
'end
Form_Unload 0
End
End If
'MsgBox "create effect no error."
d3dxe.SetTexture StrPtr(StrConv("Tex0", vbFromUnicode)), texa0
d3dxe.SetTexture StrPtr(StrConv("Tex1", vbFromUnicode)), texa1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set tex_scrn = Nothing
Set tex_wave = Nothing
'Set tex_wave_old = Nothing
'Set tex_wave_temp = Nothing
Set d3dxe = Nothing
Set d3dd9 = Nothing
Set d3d9 = Nothing
End Sub
Private Sub Timer1_Timer()
pRender
End Sub
Private Sub pRender()
Dim numpass As Long
'prepare
Dim matv As D3DMATRIX
Dim matproj As D3DMATRIX, matworld As D3DMATRIX, matview As D3DMATRIX
d3dd9.GetTransform D3DTS_PROJECTION, matproj
d3dd9.GetTransform D3DTS_WORLD, matworld
d3dd9.GetTransform D3DTS_VIEW, matview
'matv = matproj * matworld * matview
D3DXMatrixMultiply matv, matproj, matworld
D3DXMatrixMultiply matv, matv, matview
d3dxe.SetMatrix StrPtr(StrConv("WVPMatrix", vbFromUnicode)), matv
Dim sch As D3DXVECTOR4
sch.X = 0.5
sch.Y = 0.5
sch.Z = 0#
sch.w = 1#
d3dxe.SetVector StrPtr(StrConv("Scalar", vbFromUnicode)), sch
d3dxe.SetTechnique StrPtr(StrConv("T0", vbFromUnicode))
'render
d3dd9.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
d3dd9.BeginScene
d3dxe.Begin 0, 0
d3dxe.BeginPass 0
d3dd9.DrawPrimitiveUP D3DPT_TRIANGLEFAN, 2, ByVal a(0), Len(a(0))
d3dxe.EndPass
d3dxe.End
'DXline 100, 100, 300, 300, CWColorARGB(200, 255, 0, 0), CWColorARGB(0, 255, 255, 0)
'''
'''
Call vertex2dx
d3dxe.SetTechnique StrPtr(StrConv("T1", vbFromUnicode))
d3dxe.Begin 0, 0
d3dxe.BeginPass 0
d3dd9.DrawPrimitiveUP D3DPT_TRIANGLEFAN, 2, ByVal a(0), Len(a(0))
d3dxe.EndPass
d3dxe.End
'''
'''
d3dd9.EndScene
d3dd9.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Private Sub vertexarray()
With a(0)
.X = -3#
.Y = -3#
.Z = 10#
.w = 1#
.u0 = 0#
.u1 = 1#
.v0 = 0#
.v1 = 1#
End With
With a(1)
.X = -3#
.Y = 3#
.Z = 10#
.w = 1#
.u0 = 0#
.u1 = 0#
.v0 = 0#
.v1 = 0#
End With
With a(2)
.X = 3#
.Y = -3#
.Z = 10#
.w = 1#
.u0 = 1#
.u1 = 1#
.v0 = 1#
.v1 = 1#
End With
With a(3)
.X = 3#
.Y = 3#
.Z = 10#
.w = 1#
.u0 = 1#
.u1 = 0#
.v0 = 1#
.v1 = 0#
End With
'd3dd9.CreateVertexBuffer Len(a(0)), D3DUSAGE_WRITEONLY, D3DFVF_XYZRHW Or D3DFVF_TEX2, D3DPOOL_MANAGED, quadvb, ByVal 0
'If quadvb Is Nothing Then MsgBox "create vertex buffer failed"
'quadvb.Lock
End Sub
Private Sub initgeograpy()
Dim eye As D3DVECTOR
Dim at As D3DVECTOR
Dim up As D3DVECTOR
Dim view As D3DMATRIX
Dim world As D3DMATRIX
With eye
.X = 0#
.Y = 0#
.Z = -1#
End With
With at
.X = 0#
.Y = 0#
.Z = 0#
End With
With up
.X = 0#
.Y = 1#
.Z = 0#
End With
D3DXMatrixLookAtLH view, eye, at, up
d3dd9.SetTransform D3DTS_VIEW, view
D3DXMatrixPerspectiveFovLH world, Pi / 4, 4
# / 3#
, 1, 1000
d3dd9.SetTransform D3DTS_PROJECTION, world
End Sub
Public Sub DXline(ByVal CX As Single, ByVal CY As Single, ByVal OX As Single, ByVal OY As Single, ByVal OColor As Long, ByVal CColor As Long)
Dim CreateTLVertex2D(2) As TLVERTEX
CreateTLVertex2D(0).X = OX
CreateTLVertex2D(0).Y = OY
CreateTLVertex2D(1).X = CX
CreateTLVertex2D(1).Y = CY
CreateTLVertex2D(0).Color = OColor
CreateTLVertex2D(1).Color = CColor
CreateTLVertex2D(0).rhw = 1
CreateTLVertex2D(1).rhw = 1
CreateTLVertex2D(2).X = OX
CreateTLVertex2D(2).Y = CY
CreateTLVertex2D(2).rhw = 1
CreateTLVertex2D(2).Color = CColor
d3dd9.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, CreateTLVertex2D(0), Len(CreateTLVertex2D(0))
'd3dd9.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, a(0), Len(a(0))
End Sub
Public Function CWColorARGB(ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As Long
If a < &H80& Then
CWColorARGB = b Or (g * &H100&) Or (r * &H10000) Or (a * &H1000000)
Else
CWColorARGB = &H80000000 Or b Or (g * &H100&) Or (r * &H10000) Or ((a Xor &H80&) * &H1000000)
End If
End Function
Private Sub vertex2dx()
With a(0)
.X = 100
.Y = 100
.Z = 0
.w = 1#
.u0 = 0#
.u1 = 1#
.v0 = 0#
.v1 = 1#
End With
With a(1)
.X = 100
.Y = 200
.Z = 0
.w = 1#
.u0 = 0#
.u1 = 0#
.v0 = 0#
.v1 = 0#
End With
With a(2)
.X = 200
.Y = 100
.Z = 0
.w = 1#
.u0 = 1#
.u1 = 1#
.v0 = 1#
.v1 = 1#
End With
With a(3)
.X = 200
.Y = 200
.Z = 0
.w = 1#
.u0 = 1#
.u1 = 0#
.v0 = 1#
.v1 = 0#
End With
End Sub

把这个保存成effect.txt
//---------------------------------------------
// VS
//---------------------------------------------
float4x4 WVPMatrix;
struct VS_INPUT
{
vector position : POSITION;
float2 uvCoords0 : TEXCOORD0;
float2 uvCoords1 : TEXCOORD1;
};
struct VS_OUTPUT
{
vector position : POSITION;
float2 uvCoords0 : TEXCOORD0;
float2 uvCoords1 : TEXCOORD1;
};
VS_OUTPUT VS_Main(VS_INPUT input)
{
VS_OUTPUT output = (VS_OUTPUT)0;
output.position = mul(input.position, WVPMatrix);
output.uvCoords0 = input.uvCoords0;
output.uvCoords1 = input.uvCoords1;
return output;
}
//---------------------------------------------
// PS
//---------------------------------------------
vector Scalar;
texture Tex0;
texture Tex1;
sampler Samp0 =
sampler_state
{
Texture = <Tex0>;
MipFilter = LINEAR;
MinFilter = LINEAR;
MagFilter = LINEAR;
};
sampler Samp1 =
sampler_state
{
Texture = <Tex1>;
MipFilter = LINEAR;
MinFilter = LINEAR;
MagFilter = LINEAR;
};
struct PS_INPUT
{
float2 uvCoords0 : TEXCOORD0;
float2 uvCoords1 : TEXCOORD1;
};
struct PS_OUTPUT
{
float4 Color : COLOR0;
};
PS_OUTPUT PS_Main(PS_INPUT input)
{
PS_OUTPUT output = (PS_OUTPUT)0;
output.Color = tex2D(Samp0, input.uvCoords0)*Scalar.x + tex2D(Samp1, input.uvCoords1)*Scalar.y;
return output;
}
float4 thiscall(float2 p:TEXCOORD0):COLOR0{
float4 rr=tex2D(Samp0,float2(p.x,p.y))*float4(1.0,1.0,0.0,0.0);
return rr;
}
//---------------------------------------------
// effect
//---------------------------------------------
technique T0
{
pass P0
{
//vertexShader = compile vs_2_0 VS_Main();
pixelShader = compile ps_2_0 PS_Main();
}
}
technique T1
{
pass P1
{
pixelShader = compile ps_2_0 thiscall();
}
}

支持一下楼主的研究精神！你说的那个示例是指那个dx9水波吗？

能读取Txt文档当C++文件使用？

时隔七年，我又回来了，看了一下你的代码，发现这里没有用到顶点单元，应该是为了做3D旋转显示用的，被你注释掉了
这里有个小提示，如果你只用了多个贴图但是他们的UV值一样时，你可以考虑只传一个UV,，只要让像素单元只读
texcoord0就可以了
这里附上报错的结构体

哦，顺便说一下，这里的矩阵在VB6中便用要转换一下，不然会是错的，这也是我找了一个星期才找到的坑，要转换成T矩阵

这是这几个地方的修改，第一张图是修改了顶点的数据，主要是删了多出来的代码