VERSION 5.00
Begin VB.Form FrmTrain 
   Caption         =   "Form1"
   ClientHeight    =   9570
   ClientLeft      =   60
   ClientTop       =   510
   ClientWidth     =   14985
   LinkTopic       =   "Form1"
   ScaleHeight     =   9570
   ScaleWidth      =   14985
   StartUpPosition =   3  '系統預設值
   Begin VB.PictureBox Pic1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   9060
      Left            =   2400
      Picture         =   "FrmTrain.frx":0000
      ScaleHeight     =   9000
      ScaleWidth      =   12000
      TabIndex        =   3
      Top             =   360
      Width           =   12060
   End
   Begin VB.CommandButton Cmdend 
      Caption         =   "Stop(停止)"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   480
      Width           =   975
   End
   Begin VB.TextBox Textinput 
      Height          =   270
      Left            =   2880
      TabIndex        =   1
      Top             =   10320
      Width           =   10935
   End
   Begin VB.CommandButton CmdMoveTrain 
      Caption         =   "Start(開始行駛)"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   2400
      Width           =   1335
   End
   Begin VB.Timer Timer_Cls 
      Enabled         =   0   'False
      Left            =   960
      Top             =   3240
   End
   Begin VB.Timer Timer_Smoke1 
      Enabled         =   0   'False
      Left            =   1440
      Top             =   3240
   End
   Begin VB.Timer Timer_smoke2 
      Enabled         =   0   'False
      Left            =   1920
      Top             =   3240
   End
   Begin VB.Timer TimerDriveTime 
      Interval        =   30
      Left            =   1200
      Top             =   4080
   End
   Begin VB.Label Xym_Label 
      AutoSize        =   -1  'True
      Caption         =   "x,y(目前座標):"
      Height          =   180
      Left            =   0
      TabIndex        =   9
      Top             =   1200
      Width           =   1110
   End
   Begin VB.Label Labinput 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   0
      TabIndex        =   8
      Top             =   10320
      Width           =   480
   End
   Begin VB.Label LblxyMove 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   120
      TabIndex        =   7
      Top             =   1440
      Width           =   480
   End
   Begin VB.Label lblxs 
      AutoSize        =   -1  'True
      Height          =   180
      Left            =   4080
      TabIndex        =   6
      Top             =   0
      Width           =   45
   End
   Begin VB.Label LblDriveTime 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   0
      TabIndex        =   5
      Top             =   0
      Width           =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "push "" <"" or "" >""  to change direction ,key ""p"" for faster and"" m"" for slowwer"
      Height          =   180
      Left            =   6600
      TabIndex        =   4
      ToolTipText     =   "按左右鍵改變行駛方向,P(p)鍵加速(plus),M(m)減速(minus)push left or right button to changedirect"
      Top             =   120
      Width           =   5415
   End
End
Attribute VB_Name = "FrmTrain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Option Base 1
Dim Fcty As Single
Dim Filename1 As String, FileNo1 As Integer
Dim HourBeg As Single, MinBeg As Single, SecBeg As Single, HourEnd As Single, MinEnd As Single, SecEnd As Single, SecUse As Single
Dim Xs As Single, Ncall As Integer
Dim X1(0 To 49) As Single, Y1(0 To 49) As Single, X2(0 To 48) As Single, Y2(0 To 48) As Single
Dim X1W(0 To 5) As Single, Y1W(0 To 5) As Single, X2W(0 To 5) As Single, Y2W(0 To 5) As Single
Dim XcWh(0 To 3) As Single, YcWh(0 To 3) As Single, RadWh(0 To 3) As Single
Dim Xwin(0 To 4) As Single, Ywin(0 To 4) As Single
Dim Xecen(0 To 2) As Single, Yecen(0 To 2) As Single, AE(0 To 2) As Single, BE(0 To 2) As Single, AngiE(0 To 2) As Single
Dim ra As Single, glButton As Integer
Public Sub Pic1_MouseMove(Button As Integer, shift As Integer, Xmove As Single, Ymove As Single)
LblxyMove.Caption = "x= " & Str(Xmove) + " ;y= " & Str(Ymove)
End Sub



Private Sub Cmdend_Click()
End
End Sub
Sub Form_Load()
Dim X1scale As Single, Y1scale As Single, X2scale As Single, Y2scale As Single
Dim Fct1 As Single, Fct2 As Single, Fct3 As Single
ra = 3.14159 / 180
Pic1.AutoRedraw = True
Pic1.ScaleMode = 0
X1scale = -500
Y1scale = 200
X2scale = 500
Y2scale = -200
Timer_Cls.Interval = 400
Timer_Smoke1.Interval = 700
Timer_smoke2.Interval = 600
TimerDriveTime.Interval = 50
Pic1.Scale (X1scale, Y1scale)-(X2scale, Y2scale)
Fct1 = Abs(Y2scale - Y1scale) / Abs(X2scale - X1scale)
Fct2 = Pic1.Width / Pic1.Height
Fcty = Fct1 * Fct2
Pic1.Scale (-600, -600)-(500, 500)
HourBeg = Hour(Now)
MinBeg = Minute(Now)
SecBeg = Second(Now)
End Sub
 
Private Sub CmdMoveTrain_Click()
Timer_Cls.Enabled = True
Timer_Smoke1.Enabled = True
Timer_smoke2.Enabled = True
End Sub

Sub Plot_Train()
Dim Ya As Single, FilenameI As String, FiLeNoI As Integer
Dim Yrail As Single, rwhRot As Single, X1tpt As Single, Y1tpt As Single
Dim AngI As Single, Xi As Single
Dim K As Integer
Ya = 5 / 6
Pic1.ScaleMode = 0

Pic1.ForeColor = vbMagenta
Pic1.FillStyle = vbSolid
FilenameI = App.Path & "\MoveTrain.inp"
FiLeNoI = FreeFile
Open FilenameI For Input As FiLeNoI
Pic1.Cls
If Ncall > 0 Then GoTo 50
  If Ncall = 0 Then
   '火車輪廓
Input #FiLeNoI, X1(0), Y1(0)
For K = 0 To 24
Input #FiLeNoI, X2(K), Y2(K)
X1(K + 1) = X2(K)
Y1(K + 1) = Y2(K)
Next K

Input #FiLeNoI, Xwin(0), Ywin(0), Xwin(1), Ywin(1), Xwin(2), Ywin(2), Xwin(3), Ywin(3)
Xwin(4) = Xwin(0)
Ywin(4) = Ywin(0)

   
    'bottom of trian 車子底部及車輪連桿
    
  For K = 0 To 5
      Input #FiLeNoI, X1W(K), Y1W(K), X2W(K), Y2W(K)  'X1W(6), Y1W(6), X2W(6), Y2W(6)為車輪連桿
      Next K

For K = 0 To 3
  'Wheel of train 火車車輪
  
 Input #FiLeNoI, XcWh(K), YcWh(K), RadWh(K)

Next K

For K = 0 To 2
Input #FiLeNoI, Xecen(K), Yecen(K), AE(K), BE(K), AngiE(K)
Next K
   End If
50 Ncall = Ncall + 1
   'Shape of train火車輪廓

100 For K = 0 To 24
   Pic1.Line (X1(K) + Xs, Y1(K))-(X2(K) + Xs, Y2(K))
    Next K
    ' Window of train車子窗戶
    For K = 0 To 3
    Pic1.Line (Xwin(K) + Xs, Ywin(K))-(Xwin(K + 1) + Xs, Ywin(K + 1)), vbGreen, BF
    Next K
    For K = 0 To 5
Pic1.Line (X1W(K) + Xs, Y1W(K))-(X1W(K) + Xs, Y1W(K))
Next K
For K = 0 To 3
  Pic1.FillColor = RGB(250, 0, 250)
  Pic1.Circle (XcWh(K) + Xs, YcWh(K)), RadWh(K) ' XcWh(3), YcWh(3), RadWh(3)為後輪
  Pic1.FillColor = RGB(250, 120, 250)
  Pic1.Circle (XcWh(K) + Xs, YcWh(K)), RadWh(K) - 10  ' XcWh(3), YcWh(3)-20, RadWh(3)為後輪
  Next K
  
Yrail = 152     'ele. of wheel軌道高程
rwhRot = 15       'radius of wheel車輪連桿迴轉半徑
AngI = 50 * ra
X1tpt = XcWh(3) + rwhRot * Sin(AngI)
Y1tpt = YcWh(3) + rwhRot * Cos(AngI) * Ya
Pic1.Line (X1tpt + Xs, Y1tpt)-(X1tpt - 90 + Xs, Y1tpt)
Pic1.FillColor = RGB(125, 125, 125)
For Xi = Xs - 1500 To 2500 Step 20
Pic1.Line (Xi - 1500, Yrail + 5)-(Xi + 1500, Yrail + 5), vbGreen
Next Xi
If Ncall >= 50 Then Exit Sub
 If glButton = 2 Then Exit Sub
300  Close
 
End Sub

Private Sub Timer_Cls_Timer()
Dim I As Integer, K As Integer
Pic1.Cls
For I = 0 To 3
Beep
Next
Xs = Xs - 10
lblxs.Caption = "xs = " & Xs
If Xs >= 500 Or Xs < -500 Then Xs = 500
Call Plot_Train
If glButton = 2 Then Exit Sub
End Sub
 Private Sub Timer_Smoke1_Timer()
  Dim K As Integer
  For K = 0 To 2
   Call EllipEasycad(Pic1, 30, Xs + 1.5 * Xecen(K), Yecen(K) - 50, AE(K) / 2, BE(K) / 2, AngiE(K), 0, 360, vbWhite, 1#)
  Next K
End Sub
Private Sub Timer_Smoke2_Timer()
 Dim K As Integer
   For K = 0 To 2
   Call EllipEasycad(Pic1, 30, Xs + 1.5 * Xecen(K), Yecen(K) - 60, AE(K) / 3, BE(K) / 3, AngiE(K), 0, 360, vbWhite, 1#)
  Next K
End Sub
Private Sub TimerDriveTime_Timer()
HourEnd = Hour(Now)
MinEnd = Minute(Now)
SecEnd = Second(Now)
SecUse = (HourEnd - HourBeg) * 60 * 60 + (MinEnd - MinBeg) * 60 + (SecEnd - SecBeg)
LblDriveTime.Caption = "行駛時間(Sec)= " & SecUse
If SecUse >= 90 Then Stop
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, shift As Integer)
'MsgBox ("keycod= " & KeyCode)
    Select Case KeyCode
        Case vbKeyLeft
         Pic1.Scale (-600, -600)-(500, 500)
        Case vbKeyRight
         Pic1.Scale (600, -600)-(-500, 500)
          Case 80 'p=plus
        Timer_Cls.Interval = Timer_Cls.Interval - 20
        If Timer_Cls.Interval <= 20 Then Timer_Cls.Interval = 20
        Case 77 'm=minus
          Timer_Cls.Interval = Timer_Cls.Interval + 120
           If Timer_Cls.Interval > 500 Then Timer_Cls.Interval = 500
           Case Else
            Exit Sub
    End Select

End Sub
Sub EllipEasycad(Myobj As Object, Npti As Integer, XhI As Single, YkI As Single, Aa As Single, Bb As Single, AngIncL As Single, _
                       AngBeg As Single, AngEnd As Single, Coloruse As Long, Fcty As Single)
           Dim I As Integer, AngI As Single, AngSlp As Single
      Dim Delang As Single, Xtpt As Single, Ytpt As Single, NdataIN As Integer
      Dim Xi() As Single, Yi() As Single, Xbeg As Single, Ybeg As Single, Xend As Single, Yend As Single
      'NptI:曲線上點數
      ' XhI, YkI: 中心座標
      'Aa, Bb:軸長
      'AngIncL:第1軸與水平夾角,即傾斜角
      'AngBeg:曲線起點角度位置;AngEnd:終點角度位置
      'Xi() , Yi() 曲線座標陣列
      Erase Xi(): Erase Yi()
      AngBeg = AngBeg + AngSlp     '曲線起點位置
      AngEnd = AngEnd + AngSlp     '曲線終點位置
      If AngEnd = 0# Then AngEnd = 359.85
      Delang = (AngEnd - AngBeg) / (Npti - 1)
      AngSlp = AngIncL
      ReDim Xi(0 To Npti), Yi(0 To Npti)
      For I = 0 To Npti
      AngI = AngBeg + Delang * (I - 0)
      Xtpt = Aa * Cos(AngI * ra) * Cos(AngSlp * ra) - Bb * Sin(AngI * ra) * Sin(AngSlp * ra) 'x座標
      Ytpt = Aa * Cos(AngI * ra) * Sin(AngSlp * ra) + Bb * Sin(AngI * ra) * Cos(AngSlp * ra) 'y座標
      Xi(I) = XhI + Xtpt
      Yi(I) = YkI + Ytpt
              
        If (I >= 2) Then '畫線
        Xbeg = Xi(I - 1)
        Ybeg = Yi(I - 1)
        Xend = Xi(I)
        Yend = Yi(I)
        Myobj.Line (Xbeg, Ybeg * Fcty)-(Xend, Yend * Fcty), Coloruse
         End If
         Next I
200     End Sub


