home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Muscles_Dr2152735192009.psc / Muscles_2D_Ragdoll_V3.1_DirectX / frmPHYS.frm < prev    next >
Text File  |  2009-05-15  |  13KB  |  519 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPHYS 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Muscles Driven 2D Ragdoll Physics"
  5.    ClientHeight    =   7365
  6.    ClientLeft      =   45
  7.    ClientTop       =   435
  8.    ClientWidth     =   10425
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   491
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   695
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   1  'CenterOwner
  17.    Begin VB.CheckBox chLIMIT 
  18.       Caption         =   "Use Muscles Speed Limiter. (More Stable)"
  19.       Height          =   375
  20.       Left            =   6600
  21.       TabIndex        =   16
  22.       Top             =   3360
  23.       Value           =   1  'Checked
  24.       Width           =   1815
  25.    End
  26.    Begin VB.CommandButton cmdExit 
  27.       Caption         =   "EXIT"
  28.       Height          =   495
  29.       Left            =   9360
  30.       TabIndex        =   15
  31.       Top             =   120
  32.       Visible         =   0   'False
  33.       Width           =   735
  34.    End
  35.    Begin VB.PictureBox PIC_S 
  36.       Appearance      =   0  'Flat
  37.       AutoSize        =   -1  'True
  38.       BackColor       =   &H00008000&
  39.       BorderStyle     =   0  'None
  40.       FillStyle       =   0  'Solid
  41.       ForeColor       =   &H80000008&
  42.       Height          =   255
  43.       Left            =   6720
  44.       ScaleHeight     =   17
  45.       ScaleMode       =   3  'Pixel
  46.       ScaleWidth      =   33
  47.       TabIndex        =   14
  48.       Top             =   6480
  49.       Visible         =   0   'False
  50.       Width           =   495
  51.    End
  52.    Begin VB.CheckBox chGravity 
  53.       Caption         =   "Gravity"
  54.       Height          =   255
  55.       Left            =   6600
  56.       TabIndex        =   12
  57.       Top             =   2880
  58.       Value           =   1  'Checked
  59.       Width           =   1455
  60.    End
  61.    Begin VB.CommandButton SavePos 
  62.       Caption         =   "Save Pose"
  63.       Height          =   375
  64.       Left            =   8640
  65.       TabIndex        =   11
  66.       Top             =   1440
  67.       Visible         =   0   'False
  68.       Width           =   1455
  69.    End
  70.    Begin VB.ListBox List1 
  71.       Height          =   1815
  72.       Left            =   8520
  73.       TabIndex        =   10
  74.       ToolTipText     =   "Click to load Pose"
  75.       Top             =   1920
  76.       Width           =   1695
  77.    End
  78.    Begin VB.HScrollBar GlobStrength 
  79.       Height          =   375
  80.       Left            =   6600
  81.       TabIndex        =   9
  82.       Top             =   3840
  83.       Width           =   2655
  84.    End
  85.    Begin VB.HScrollBar MuscleANG 
  86.       Height          =   255
  87.       Index           =   0
  88.       Left            =   6600
  89.       TabIndex        =   7
  90.       Top             =   4440
  91.       Width           =   2655
  92.    End
  93.    Begin VB.CheckBox ApplyMuscle 
  94.       Caption         =   "Use Muscles"
  95.       Height          =   495
  96.       Left            =   6600
  97.       Style           =   1  'Graphical
  98.       TabIndex        =   6
  99.       Top             =   2280
  100.       Value           =   1  'Checked
  101.       Width           =   1455
  102.    End
  103.    Begin VB.OptionButton Option1 
  104.       Caption         =   "Only Lines"
  105.       Height          =   255
  106.       Left            =   6600
  107.       TabIndex        =   5
  108.       Top             =   1920
  109.       Value           =   -1  'True
  110.       Visible         =   0   'False
  111.       Width           =   1575
  112.    End
  113.    Begin VB.OptionButton SLN 
  114.       Caption         =   "Show Point Link Numbers"
  115.       Height          =   375
  116.       Left            =   6600
  117.       TabIndex        =   4
  118.       Top             =   1560
  119.       Visible         =   0   'False
  120.       Width           =   1455
  121.    End
  122.    Begin VB.PictureBox PIC 
  123.       Appearance      =   0  'Flat
  124.       BackColor       =   &H00004000&
  125.       ForeColor       =   &H80000008&
  126.       Height          =   6615
  127.       Left            =   120
  128.       ScaleHeight     =   439
  129.       ScaleMode       =   3  'Pixel
  130.       ScaleWidth      =   423
  131.       TabIndex        =   1
  132.       Top             =   120
  133.       Width           =   6375
  134.    End
  135.    Begin VB.Timer TIMER1 
  136.       Enabled         =   0   'False
  137.       Interval        =   10
  138.       Left            =   8760
  139.       Top             =   840
  140.    End
  141.    Begin VB.CommandButton Command1 
  142.       Caption         =   "RUN"
  143.       Height          =   615
  144.       Left            =   8880
  145.       TabIndex        =   0
  146.       Top             =   120
  147.       Width           =   1215
  148.    End
  149.    Begin VB.Label Label3 
  150.       Caption         =   "Interact with the figure using the mouse, picking it up at the points and tossing it around"
  151.       Height          =   375
  152.       Left            =   120
  153.       TabIndex        =   13
  154.       Top             =   6840
  155.       Width           =   6375
  156.    End
  157.    Begin VB.Label mDESC 
  158.       Caption         =   "Label3"
  159.       Height          =   255
  160.       Index           =   0
  161.       Left            =   9360
  162.       TabIndex        =   8
  163.       Top             =   4440
  164.       Width           =   975
  165.    End
  166.    Begin VB.Label Label2 
  167.       Caption         =   "Muscles Driven 2D Ragdoll Engine based on Verlet physics.  "
  168.       Height          =   1095
  169.       Left            =   6600
  170.       TabIndex        =   3
  171.       Top             =   120
  172.       Width           =   2055
  173.    End
  174.    Begin VB.Label Label1 
  175.       Alignment       =   2  'Center
  176.       Caption         =   "Muscles Strength"
  177.       Height          =   495
  178.       Left            =   9240
  179.       TabIndex        =   2
  180.       Top             =   3840
  181.       Width           =   1095
  182.    End
  183. End
  184. Attribute VB_Name = "frmPHYS"
  185. Attribute VB_GlobalNameSpace = False
  186. Attribute VB_Creatable = False
  187. Attribute VB_PredeclaredId = True
  188. Attribute VB_Exposed = False
  189. 'Author : Creator Roberto Mior
  190. '     reexre@gmail.com
  191. '
  192. 'If you use source code or part of it please cite the author
  193. 'You can use this code however you like providing the above credits remain intact
  194. '
  195. '
  196. '
  197.  
  198. Dim Doll As New OBJphysic
  199.  
  200. Dim doMouse As Boolean
  201. Dim PtoMove As Integer
  202. Dim mouseX As Single
  203. Dim mouseY As Single
  204.  
  205.  
  206.  
  207. Private Sub ApplyMuscle_Click()
  208. If ApplyMuscle.Value = Checked Then
  209.     GlobStrength = GlobStrength.Max
  210. Else
  211.     GlobStrength = GlobStrength.Min
  212. End If
  213.  
  214.  
  215. End Sub
  216.  
  217. Private Sub chGravity_Click()
  218. If chGravity.Value = Checked Then
  219.     Gravity = 0.035 '0.035
  220. Else
  221.     Gravity = 0
  222.     
  223. End If
  224.  
  225. End Sub
  226.  
  227. Private Sub cmdExit_Click()
  228. termina True
  229.  
  230. End Sub
  231.  
  232. Private Sub Command1_Click()
  233. Command1.Visible = False
  234. SavePos.Visible = True
  235. cmdExit.Visible = True
  236.  
  237. MyColor = D3DColorMake(1, 1, 1, 1)
  238.  
  239. creaSchermo2 PIC.Width, PIC.Height, D3DFMT_A8R8G8B8, PIC.hwnd, True, 2, False
  240.  
  241.  
  242.  
  243. AIR = 0.99 '0.99
  244. kMuscleSpeedLimit = 15 '10
  245. chGravity_Click
  246.  
  247.  
  248. S = 0.03 * 1.2 '* 0.9 '* 1.2 '* 0.9
  249. Doll.DefaultStrength = S
  250.  
  251. ''''''''''''''''''''''''''''''''''''''''
  252. 'RagDoll
  253.  
  254. 'DOLL.ADDpoint 100, 200
  255. Doll.ADDpoint 110, 200
  256. Doll.ADDpoint 110, 170
  257. Doll.ADDpoint 120, 140
  258. Doll.ADDpoint 130, 170
  259. Doll.ADDpoint 130, 200
  260. 'DOLL.ADDpoint 140, 200
  261.  
  262. Doll.ADDpoint 120, 110
  263.  
  264. Doll.ADDpoint 100, 110
  265. Doll.ADDpoint 90, 130
  266.  
  267. Doll.ADDpoint 140, 110
  268. Doll.ADDpoint 150, 130
  269.  
  270. Doll.ADDpoint 120, 90 + 5 - 5
  271.  
  272. 'Links
  273. Doll.ADDLink 1, 2
  274. Doll.ADDLink 2, 3
  275. Doll.ADDLink 5, 4
  276. Doll.ADDLink 4, 3
  277. Doll.ADDLink 6, 3
  278.  
  279. Doll.ADDLink 8, 7
  280. Doll.ADDLink 7, 6
  281.  
  282. Doll.ADDLink 10, 9
  283. Doll.ADDLink 9, 6
  284.  
  285. Doll.ADDLink 11, 6
  286.  
  287. 'Muscles
  288. 'S = 0.03 * 1.2
  289. Doll.ADDMuscle 1, 2, S
  290. Doll.ADDMuscle 3, 4, S
  291. Doll.ADDMuscle 2, 5, S
  292. Doll.ADDMuscle 4, 5, S
  293.  
  294.  
  295. Doll.ADDMuscle 6, 7, S
  296. Doll.ADDMuscle 8, 9, S
  297. Doll.ADDMuscle 7, 5, S
  298. Doll.ADDMuscle 9, 5, S
  299.  
  300. Doll.ADDMuscle 10, 5, S * 0.9
  301.  
  302. Doll.Obj_SAVE
  303. Doll.Obj_LOADandPlace "obj.txt", 200, 250
  304.  
  305.  
  306. GlobStrength.Min = 0
  307. GlobStrength.Max = Doll.DefaultStrength * 1000
  308. GlobStrength.Value = GlobStrength.Max
  309.  
  310.  
  311. For M = 2 To Doll.NMuscles
  312.     Load MuscleANG(M - 1)
  313.     MuscleANG(M - 1).Visible = True
  314.     MuscleANG(M - 1).Top = MuscleANG(M - 2).Top + MuscleANG(M - 2).Height
  315.     Load mDESC(M - 1)
  316.     mDESC(M - 1).Top = MuscleANG(M - 1).Top
  317.     mDESC(M - 1).Visible = True
  318. Next
  319.  
  320. For M = 1 To Doll.NMuscles
  321.     MuscleANG(M - 1).Min = -PI * 200
  322.     MuscleANG(M - 1).Max = PI * 200
  323.     MuscleANG(M - 1).Value = Doll.MUSCLE_MainANG(M) * 100
  324. Next
  325.  
  326. 'knee , hip, elbow, shoulder, head
  327. mDESC(0) = "L - Knee"
  328. mDESC(1) = "R - Knee"
  329. mDESC(2) = "L - Hip"
  330. mDESC(3) = "R - Hip"
  331. mDESC(4) = "L - Elbow"
  332. mDESC(5) = "R - Elbow"
  333. mDESC(6) = "L - Shoulder"
  334. mDESC(7) = "R - Shoulder"
  335. mDESC(8) = "Head"
  336.  
  337.  
  338. GetPoses
  339. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  340. ReDim Sprite(Doll.Nlinks)
  341.  
  342. For i = 1 To Doll.Nlinks
  343.     Set Sprite(i).Tex = creaTex(App.Path & "\Texture\T" & i & ".BMP", D3DColorMake(1, 0, 1, 1), True) 'transparent
  344.     PIC_S = LoadPicture(App.Path & "\Texture\T" & i & ".BMP")
  345.     PIC_S.Refresh
  346.     Sprite(i).TexCenter.y = PIC_S.Height / 2
  347.     Sprite(i).TexCenter.x = PIC_S.Width / 2
  348.     Sprite(i).Scala.x = 1
  349.     Sprite(i).Scala.y = 1
  350.     Sprite(i).DrawScala.x = 1
  351.     Sprite(i).DrawScala.y = 1
  352.     
  353. Next
  354. 'Don't know why but had to add this adjustment to do Right positioning in Doll.Draw_DX
  355. Sprite(1).TexCenter.y = Sprite(1).TexCenter.y + 3
  356. Sprite(3).TexCenter.y = Sprite(3).TexCenter.y + 3
  357. Sprite(2).TexCenter.y = Sprite(2).TexCenter.y + 3
  358. Sprite(4).TexCenter.y = Sprite(4).TexCenter.y + 3
  359. Sprite(1).DrawScala.x = 1.1
  360. Sprite(3).DrawScala.x = 1.1
  361. Sprite(2).DrawScala.x = 1.1
  362. Sprite(4).DrawScala.x = 1.1
  363. Sprite(5).TexCenter.y = Sprite(5).TexCenter.y + 6
  364. Sprite(5).DrawScala.y = 1.5
  365. Sprite(6).TexCenter.x = Sprite(6).TexCenter.x + 4
  366. Sprite(8).TexCenter.x = Sprite(8).TexCenter.x + 4
  367. Sprite(6).DrawScala.x = 0.8
  368. Sprite(8).DrawScala.x = 0.8
  369. Sprite(7).DrawScala.x = 0.8
  370. Sprite(9).DrawScala.x = 0.8
  371. 'Sprite(10).TexCenter.x = Sprite(10).TexCenter.x    'This is for SmileFace
  372. 'Sprite(10).TexCenter.y = Sprite(10).TexCenter.y - 2
  373. 'Sprite(10).DrawScala.x = 0.56
  374. 'Sprite(10).DrawScala.y = 0.56
  375. Sprite(10).TexCenter.x = 17 'Sprite(10).TexCenter.x
  376. Sprite(10).TexCenter.y = 12 'Sprite(10).TexCenter.y - 2
  377. Sprite(10).DrawScala.x = 0.15 * 0.85
  378. Sprite(10).DrawScala.y = 0.1 * 0.85
  379.  
  380.  
  381.  
  382. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  383. TIMER1.Enabled = True
  384.  
  385. End Sub
  386.  
  387.  
  388.  
  389. Private Sub Form_Load()
  390. Me.Caption = Me.Caption & "  V" & App.Major & "." & App.Minor & "   [ DirectX ]"
  391.  
  392.  
  393. End Sub
  394.  
  395. Private Sub GlobStrength_Change()
  396.  
  397. For M = 1 To Doll.NMuscles
  398.     Doll.MUSCLE_SetStrength(M) = GlobStrength.Value / 1000
  399. Next
  400.  
  401. End Sub
  402.  
  403. Private Sub GlobStrength_Scroll()
  404. For M = 1 To Doll.NMuscles
  405.     Doll.MUSCLE_SetStrength(M) = GlobStrength.Value / 1000
  406. Next
  407.  
  408. End Sub
  409.  
  410. Private Sub List1_Click()
  411. Doll.OBJ_LoadPose (List1)
  412. For M = 1 To Doll.NMuscles
  413.     MuscleANG(M - 1).Value = Doll.MUSCLE_MainANG(M) * 100
  414. Next M
  415.  
  416. End Sub
  417.  
  418. Private Sub MuscleANG_Change(Index As Integer)
  419. MUS = Index + 1
  420. Doll.MUSCLE_MainANG(Index + 1) = CDbl(MuscleANG(Index).Value / 100)
  421.  
  422. End Sub
  423.  
  424. Private Sub MuscleANG_Scroll(Index As Integer)
  425. MUS = Index + 1
  426. Doll.MUSCLE_MainANG(Index + 1) = CDbl(MuscleANG(Index).Value / 100)
  427. End Sub
  428.  
  429.  
  430.  
  431. Private Sub PIC_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  432.  
  433. Dim DMin As Single
  434. Dim P1 As tPoint
  435. Dim P2 As tPoint
  436. DMin = 1E+19
  437. P2.x = x
  438. P2.y = y
  439. For i = 1 To Doll.Npoints
  440.     P1.x = Doll.PointX(i)
  441.     P1.y = Doll.PointY(i)
  442.     If Distance(P1, P2) < DMin Then DMin = Distance(P1, P2): PtoMove = i
  443. Next
  444. mouseX = x
  445. mouseY = y
  446. doMouse = True
  447.  
  448.  
  449. End Sub
  450.  
  451. Private Sub PIC_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  452.  
  453. If Button = 1 Then
  454.     mouseX = x
  455.     mouseY = y
  456. End If
  457.  
  458. End Sub
  459.  
  460. Private Sub PIC_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  461. doMouse = False
  462. End Sub
  463.  
  464. Private Sub SavePos_Click()
  465. Doll.OBJ_SavePose ("POS" & List1.ListCount & ".txt")
  466. List1.AddItem "POS" & List1.ListCount & ".txt"
  467.  
  468. End Sub
  469.  
  470. Private Sub Timer1_Timer()
  471.  
  472. 'PIC.Cls
  473. 'Doll.DRAW PIC, SLN
  474.  
  475.  
  476. DollDRAW_DX
  477. 'Doll.DRAW PIC, SLN
  478.  
  479.  
  480. Doll.doPHYSICS
  481. If doMouse Then doMouseForces
  482.  
  483. End Sub
  484.  
  485. Sub GetPoses()
  486. Dim D As String
  487.  
  488. D = Dir(App.Path & "\Pos" & "*.txt")
  489. While D <> ""
  490.     List1.AddItem D
  491.     D = Dir
  492. Wend
  493.  
  494. End Sub
  495.  
  496. Sub doMouseForces()
  497. Doll.PointVX(PtoMove) = Doll.PointVX(PtoMove) - (Doll.PointX(PtoMove) - mouseX) * 0.015
  498. Doll.PointVY(PtoMove) = Doll.PointVY(PtoMove) - (Doll.PointY(PtoMove) - mouseY) * 0.015
  499. PIC.Line (Doll.PointX(PtoMove), Doll.PointY(PtoMove))-(mouseX, mouseY), vbGreen
  500. End Sub
  501.  
  502. Sub DollDRAW_DX()
  503. Device.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, D3DColorRGBA(0, 0, 0, 0), 1#, 0 'pulisce lo schermo
  504. Device.BeginScene 'inizia il rendering
  505. dSprite.Begin
  506. 'Stop
  507.  
  508. Doll.DRAW_DX
  509.  
  510.  
  511. dSprite.End
  512. 'testo.DrawTextW txtSCR & "   " & CAR(BEST).dDISTtot, -1, r, DT_LEFT, D3DColorMake(1, 1, 1, 1)
  513. Device.EndScene 'fa terminare il rendering
  514. Device.Present ByVal 0, ByVal 0, 0, ByVal 0 'invia l'immagine al monitor
  515.  
  516.  
  517.  
  518. End Sub
  519.