トップページ⇒tech
16コメント8KB

VBとDXとゲームdev愛好者雑談*RpgDIY CODE(部分)

■ このスレッドは過去ログ倉庫に格納されています
0001instemast2006/07/19(水) 16:29:04
VBとDXとゲームdev愛好者雑談

また、僕がつくったこれ:
RpgDIY CODE(部分)
0002instemast2006/07/19(水) 16:35:58
Public Sub MainTimer()
On Error Resume Next
Dim i As Integer
Dim tmpr%(), tmpu%(), tmpi%()
Dim dltx As Double, dlty As Double, dx As Double, dy As Double, oldx As Integer, oldy As Integer
Dim sina As Double
For i = 1 To UBound(player)
If player(i).state = STATE_MOVE Then
dltx = player(i).tox - player(i).left
dlty = player(i).toy - player(i).top
ElseIf player(i).state = STATE_TOOBJECT Or player(i).state = STATE_TOCLICK Then
If player(i).toobjecttype = OBJECT_PLAYER Then
If player(i).plc = player(player(i).toobjectindex).plc Then
dltx = player(player(i).toobjectindex).left + player(player(i).toobjectindex).width * 0.5 - player(i).left - player(i).width * 0.5
dlty = player(player(i).toobjectindex).top + player(i).oy - player(i).top - player(i).oy
Else
player(i).state = STATE_STOP
End If
0003instemast2006/07/19(水) 16:36:58
ElseIf player(i).toobjecttype = OBJECT_NPC Then
If player(i).plc = map.mapindex Then
dltx = npc(player(i).toobjectindex).left + npc(player(i).toobjectindex).width * 0.5 - player(i).left - player(i).width * 0.5
dlty = npc(player(i).toobjectindex).top + npc(i).oy - player(i).top - player(i).oy

Else
player(i).state = STATE_STOP
End If
ElseIf player(i).toobjecttype = OBJECT_MOVEPOINT Then
If player(i).plc = map.mapindex Then
dltx = movepoint(player(i).toobjectindex).left + movepoint(player(i).toobjectindex).width * 0.5 - player(i).left - player(i).width * 0.5
dlty = movepoint(player(i).toobjectindex).top + movepoint(i).oy - player(i).top - player(i).oy


Else
player(i).state = STATE_STOP
End If
End If
End If
0004instemast2006/07/19(水) 16:37:32
If player(i).state <> STATE_STOP Then
dx = (dltx * player(i).vp) / (Sqr(dltx ^ 2 + dlty ^ 2))
dy = (dlty * player(i).vp) / (Sqr(dltx ^ 2 + dlty ^ 2))
oldleft = player(i).left
oldtop = player(i).top
player(i).left = player(i).left + dx
player(i).top = player(i).top + dy
If Sqr(dltx ^ 2 + dlty ^ 2) < player(i).vp + 2 Then '与目标的差很小很小时
If player(i).state = STATE_TOCLICK Then '有对象要点击,且与目标的差很小
player(i).state = STATE_STOP '到达了目标停止
Call clickobject(i, player(i).toobjecttype, player(i).toobjectindex, 1)
Else
player(i).state = STATE_STOP '到达了目标停止
End If
ElseIf istouch(i) Then
player(i).state = STATE_STOP '碰撞后停止
player(i).left = oldleft '碰撞后还原坐标
player(i).top = oldtop
ElseIf player(i).state = STATE_TOCLICK Then
If istouchobject(i, player(i).toobjecttype, player(i).toobjectindex) Then '有对象要点击,且碰撞
player(i).state = STATE_STOP '碰撞后停止
player(i).left = oldleft '碰撞后还原坐标
player(i).top = oldtop
Call clickobject(i, player(i).toobjecttype, player(i).toobjectindex, 1)
End If
End If
End If
0005instemast2006/07/19(水) 16:39:36
DXの部分をよくみて
Private Sub DDrawReset()
Set NormalFont = New StdFont
Set TalkFont = New StdFont
Set PropFontA = New StdFont
Set PropFontB = New StdFont
NormalFont.Size = 8
PropFontB.Size = 12
PropFontA.Size = 9
TalkFont.Bold = True
TalkFont.Size = 16
ckey.low = 0
ckey.high = 0
Set dd = dx.DirectDrawCreate(vbNullString)
If settings.FullScreened <> 0 Then
dd.SetCooperativeLevel Form1.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_ALLOWREBOOT
dd.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
ddmsurf_d.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddmsurf_d.lBackBufferCount = 1
ddmsurf_d.ddsCaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE
Set ddmsurf = dd.CreateSurface(ddmsurf_d)
ddbbuf_d.ddsCaps.lCaps = DDSCAPS_BACKBUFFER
Set ddbbuf = ddmsurf.GetAttachedSurface(ddbbuf_d.ddsCaps)
0006instemast2006/07/19(水) 16:40:12
Else
dd.SetCooperativeLevel 0, DDSCL_NORMAL
ddmsurf_d.lFlags = DDSD_CAPS
ddmsurf_d.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
Set ddmsurf = dd.CreateSurface(ddmsurf_d)
ddbbuf_d.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
ddbbuf_d.lWidth = 640
ddbbuf_d.lHeight = 480
ddbbuf_d.ddsCaps.lCaps = settings.offcaps
Set ddbbuf = dd.CreateSurfaceFromFile(skin + "\tmp.bmp", ddbbuf_d)
aaa = aaa
End If
ReDim offplayer(0)
ReDim offnpc(0)
ReDim offmovepoint(0)
ReDim offthing(0)
End Sub
0007デフォルトの名無しさん2006/07/19(水) 16:48:44
↓もう夏休みか。厨乙
0008instemast2006/07/19(水) 16:52:18
なっ。。。夏休みだけど。。。
0009デフォルトの名無しさん2006/07/19(水) 17:39:59
君は何を求めているんだい？
0010デフォルトの名無しさん2006/07/19(水) 19:55:18
どうでもいいがなぜ中文が混じっている
0011instemast2006/07/21(金) 15:47:10
コードは全部554kB。。。(あんまり大きいね、はっ

コードは内緒だが。やや読ませてもいいのだな。
0012instemast2006/07/21(金) 15:56:22
'//Single-Neuron Perceptron。2つのinput。8つのTraining Series
'//input----p(i)=[p1(i),p2(i)]
'//*.VBSのファイルと保存して！
dim p1(8):dim p2(8):dim t(8)'//Training Series
for i=1 to 8
p1(i)=inputbox("input p1("+cstr(i)+")")
p2(i)=inputbox("input p2("+cstr(i)+")")
t(i)=inputbox("input t("+cstr(i)+")")
next'//start Training:
max=inputbox("最大迭代次数？")
for i=1 to max+1
cnt=cnt+1
if cnt>8 then
cnt=1:tmp=0
end if
'//a=hardlim(wp+b);e=t-a
e=t(cnt)-hardlim(w1*p1(cnt)+w2*p2(cnt)+b)
'//感知机学习规则:w_new=w_old+epT (有点不太好表记，pT是p的转置)
b_new=b_old+e
w1=w1+e*p1(cnt):w2=w2+e*p2(cnt):b=b+e
if e<>0 then tmp=1
if cnt=8 and tmp=0 then exit for
next
if i=max+1 then msgbox("在"+cstr(i)+"次迭代中没有收敛")
msgbox("w=["+cstr(w1)+","+cstr(w2)+"] b="+cstr(b)+" 迭代次数"+cstr(i))
msgbox("by instemast"+chr(10)+"qq544262895"+chr(10)+"[email protected]"+chr(10)+"instemast.tf168.com")
function hardlim(x)
if x>=0 then hardlim=1 else hardlim=0
end function
0013デフォルトの名無しさん2006/07/21(金) 16:01:57
そうか、今日がオナニーの日だからか。
0014instemast2006/07/21(金) 16:03:28
手淫か。。。俺毎晩オナニーするが。。。
0015デフォルトの名無しさん2006/08/01(火) 01:34:02
あげ
0016デフォルトの名無しさん2006/08/01(火) 01:35:03
>>1は外人か
■ このスレッドは過去ログ倉庫に格納されています