Тема: Физика.
Показать сообщение отдельно
Старый 02.03.2012, 18:41   #3
Nikich
Бывалый
 
Регистрация: 22.12.2011
Сообщений: 844
Написано 150 полезных сообщений
(для 275 пользователей)
Ответ: Физика.

Всё таки тему удалять не нужно. Я сюда ещё вопросы скидывать буду, по этому переименуйте тему, пожалуйста, в "BiPlanes". Это не то что бы проект, просто немного другое направление для самообучения. И вопрос у меня возник касательно интернета:

Graphics 1280,1024,32,2
SetBuffer BackBuffer()




SeedRnd MilliSecs()


TFormFilter 0
Global bp1im=LoadImage("bp1.bmp")

MaskImage bp1im,255,255,255
MidHandle bp1im

Dim bp1i(360)
For i=0 To 360
bp1i(i)=CopyImage(bp1im)
RotateImage bp1i(i),i
Next
Global fnt1=LoadFont("Arial",24,True,False,False)
SetFont fnt1

Global ground=LoadImage("ground.bmp")
Global sky=LoadImage("sky.bmp")
Global cloud1=LoadImage("cloud1.bmp")
Global cloud2=LoadImage("cloud2.bmp")
Global cloud3=LoadImage("cloud3.bmp")
MaskImage cloud3,255,255,255
MaskImage cloud2,255,255,255
MaskImage cloud1,255,255,255
MaskImage ground,255,255,255
Const g=9.81
Type biplane
Field x#,y#,angle#,px#,py#,ft#,m#,fl,id
End Type
StartNetGame()
bp1.biplane=New biplane
bp1\x=64
bp1\y=816
bp1\m=1
bp1\angle=11
bp1\id=CreateNetPlayer(1)







Function UpdateGround()
DrawImage sky,0,0
DrawImage ground,0,824
DrawImage cloud1,100,400
DrawImage cloud2,500,20
DrawImage cloud3,600,200
End Function

Function UpdateBiplane()
bp1.biplane=First biplane

If KeyDown(17) Then
bp1\ft=bp1\ft+0.2
Else
bp1\ft=bp1\ft-0.2
EndIf

If bp1\ft>20 Then bp1\ft=20
If bp1\ft<0 Then bp1\ft=0



If KeyDown(30) And bp1\fl=1 Then
bp1\angle=bp1\angle+1
EndIf

If KeyDown(32) And bp1\fl=1 Then
bp1\angle=bp1\angle-1
EndIf

If bp1\angle<0 Then bp1\angle=360
If bp1\angle>360 Then bp1\angle=0

If bp1\angle#<90 Or bp1\angle#>270 Then
bp1\py#=bp1\y#+bp1\m#*g-Sin(bp1\angle#+22)*bp1\ft#
EndIf

If bp1\angle#>89 And bp1\angle#<271 Then
bp1\py#=bp1\y#+bp1\m#*g-Sin(bp1\angle#-32)*bp1\ft#
EndIf
bp1\px#=bp1\x#+Cos(bp1\angle#)*bp1\ft#

If bp1\px>1280 Then bp1\px=0
If bp1\px<0 Then bp1\px=1280

bp1\x=bp1\px
Color 0,0,0
Text 0,0,bp1\x
Text 0,30,bp1\y
Text 0,60,bp1\ft
Text 0,90,bp1\angle

If Not bp1\py#>816 Then
bp1\y#=bp1\py#
EndIf

If bp1\y#<810 Then
bp1\fl=1
EndIf




If ImagesCollide(bp1im,bp1\px,bp1\py,0,ground,0,824,0 ) And bp1\fl=1 Then
Delete bp1
EndIf

SendNetMsg 2,bp1\x,2,1
SendNetMsg 3,bp1\y,2,1
SendNetMsg 4,bp1\angle,2,1

For bp1.biplane=Each biplane

DrawImage bp1i(360-Int(bp1\angle)),bp1\x,bp1\y

Next

End Function

Function UpdateNetwork()
While RecvNetMsg()
Select NetMsgType()
Case 100
bp1.biplane=New biplane
bp1\x=512
bp1\y=816
bp1\m=1
bp1\angle=11
bp1\id=2
Case 2
bp1.biplane=Last biplane
bp1\x=NetMsgData()
Case 3
bp1.biplane=Last biplane
bp1\y=NetMsgData()
Case 4
bp1.biplane=Last biplane
bp1\angle=NetMsgData()

End Select
Wend
End Function


While Not KeyHit(1)
UpdateGround()
UpdateBiplane()
UpdateNetwork()

Flip
Cls
Wend


И


Graphics 1280,1024,32,2
SetBuffer BackBuffer()




SeedRnd MilliSecs()


TFormFilter 0
Global bp1im=LoadImage("bp1.bmp")

MaskImage bp1im,255,255,255
MidHandle bp1im

Dim bp1i(360)
For i=0 To 360
bp1i(i)=CopyImage(bp1im)
RotateImage bp1i(i),i
Next
Global fnt1=LoadFont("Arial",24,True,False,False)
SetFont fnt1

Global ground=LoadImage("ground.bmp")
Global sky=LoadImage("sky.bmp")
Global cloud1=LoadImage("cloud1.bmp")
Global cloud2=LoadImage("cloud2.bmp")
Global cloud3=LoadImage("cloud3.bmp")
MaskImage cloud3,255,255,255
MaskImage cloud2,255,255,255
MaskImage cloud1,255,255,255
MaskImage ground,255,255,255
Const g=9.81
Type biplane
Field x#,y#,angle#,px#,py#,ft#,m#,fl,id
End Type

StartNetGame()

bp1.biplane=New biplane
bp1\x=512
bp1\y=816
bp1\m=1
bp1\angle=11
bp1\id=CreateNetPlayer(2)



Function UpdateGround()
DrawImage sky,0,0
DrawImage ground,0,824
DrawImage cloud1,100,400
DrawImage cloud2,500,20
DrawImage cloud3,600,200
End Function

Function UpdateBiplane()

bp1.biplane=Last biplane

If KeyDown(17) Then
bp1\ft=bp1\ft+0.2
Else
bp1\ft=bp1\ft-0.2
EndIf

If bp1\ft>20 Then bp1\ft=20
If bp1\ft<0 Then bp1\ft=0



If KeyDown(30) And bp1\fl=1 Then
bp1\angle=bp1\angle+1
EndIf

If KeyDown(32) And bp1\fl=1 Then
bp1\angle=bp1\angle-1
EndIf

If bp1\angle<0 Then bp1\angle=360
If bp1\angle>360 Then bp1\angle=0

If bp1\angle#<90 Or bp1\angle#>270 Then
bp1\py#=bp1\y#+bp1\m#*g-Sin(bp1\angle#+22)*bp1\ft#
EndIf

If bp1\angle#>89 And bp1\angle#<271 Then
bp1\py#=bp1\y#+bp1\m#*g-Sin(bp1\angle#-32)*bp1\ft#
EndIf
bp1\px#=bp1\x#+Cos(bp1\angle#)*bp1\ft#

If bp1\px>1280 Then bp1\px=0
If bp1\px<0 Then bp1\px=1280

bp1\x=bp1\px
Color 0,0,0
Text 0,0,bp1\x
Text 0,30,bp1\y
Text 0,60,bp1\ft
Text 0,90,bp1\angle

If Not bp1\py#>816 Then
bp1\y#=bp1\py#
EndIf

If bp1\y#<810 Then
bp1\fl=1
EndIf



DrawImage bp1i(360-Int(bp1\angle)),bp1\x,bp1\y

If ImagesCollide(bp1im,bp1\px,bp1\py,0,ground,0,824,0 ) And bp1\fl=1 Then
Delete bp1
EndIf

SendNetMsg 2,bp1\x,2,1
SendNetMsg 3,bp1\y,2,1
SendNetMsg 4,bp1\angle,2,1



For bp1.biplane=Each biplane

DrawImage bp1i(360-Int(bp1\angle)),bp1\x,bp1\y
Next

End Function

Function UpdateNetwork()
While RecvNetMsg()
Select NetMsgType()
Case 100
bp1.biplane=New biplane
bp1\x=512
bp1\y=816
bp1\m=1
bp1\angle=11
bp1\id=2
Case 2
bp1.biplane=First biplane
bp1\x=NetMsgData()
Case 3
bp1.biplane=First biplane
bp1\y=NetMsgData()
Case 4
bp1.biplane=First biplane
bp1\angle=NetMsgData()

End Select
Wend
End Function

While Not KeyHit(1)
UpdateGround()
UpdateBiplane()
UpdateNetwork()

Flip
Cls
Wend

Первый код это хост, второй клиент. Его я написал прочитав справку, и конечно же ничего не заработало Так что будьте добры, обучите меня бедного премудростям DirectPlay, или найдите ошибку.
Вложения
Тип файла: rar bp.rar (612.9 Кб, 634 просмотров)

Последний раз редактировалось Nikich, 02.03.2012 в 21:53.
(Offline)
 
Ответить с цитированием