2雨流法.frm

Rainflow Visual Basic

VERSION 5.00
Begin VB.Form Form2 
   Caption         =   "Form2"
   ClientHeight    =   8610
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7695
   LinkTopic       =   "Form2"
   ScaleHeight     =   8610
   ScaleWidth      =   7695
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "结果"
      Height          =   375
      Left            =   5880
      TabIndex        =   1
      Top             =   7320
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "返回"
      Height          =   375
      Left            =   5880
      TabIndex        =   0
      Top             =   7920
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      ForeColor       =   &H8000000D&
      Height          =   495
      Left            =   360
      TabIndex        =   2
      Top             =   120
      Visible         =   0   'False
      Width           =   1575
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Form2.Cls
Form2.Hide
Form1.Show
Form1.Text1.Text = ""
Form1.Text2.Text = ""
Form1.Text3.Text = ""
Form1.Text1.SetFocus
End Sub

Private Sub Command2_Click()
Form2.Cls
Form2.Hide
Form3.Show
End Sub

Private Sub Form_Activate()
q = Val(Form1.Text1.Text)
p = Val(Form1.Text2.Text)

Dim a() As Integer, i As Integer
n = Val(Form1.Text3.Text)
ReDim a(0 To n)
Show
For i = 1 To n
Randomize
a(i) = Int((q - p + 1) * Rnd + p)
Print a(i);
If i / 20 = i \ 20 Then
Print
End If
Next i


For m = 1 To n
For shi = 1 To 10
If a(m) >= q - (q - p) / 10 * shi And (a(m) < q - (q - p) / 10 * (shi - 1) Or a(m) = q) Then z(shi) = z(shi) + 1
Next shi
Next m





k = 0
For i = 2 To n - 1
If ((a(i) - a(i - 1)) > 0 And (a(i) - a(i + 1)) < 0) Or ((a(i) - a(i - 1)) < 0 And (a(i) - a(i + 1)) > 0) Then
k = k + 1
End If
Next i
Print
Print "不符合的个数为"; k
Label1.Caption = k

Dim b() As Integer, j As Integer
ReDim b(1 To (n - k))
b(1) = a(1)
b(n - k) = a(n)
j = 2
For i = 2 To n - 1
If ((a(i) - a(i - 1)) > 0 And (a(i) - a(i + 1)) > 0) Or ((a(i) - a(i - 1)) < 0 And (a(i) - a(i + 1)) < 0) Then

b(j) = a(i)
j = j + 1
If i = n - 1 Then j = j
End If
Next i
For j = 1 To n - k
Print b(j);
If j / 20 = j \ 20 Then
Print
End If
Next j

Dim x() As Integer, y() As Integer, s() As Integer, sm() As Single
ReDim x(1 To UBound(b)), y(1 To UBound(b)), s(1 To n), sm(1 To n)
For j = 1 To UBound(b) - 2
If UBound(b) - 2 >= j + 1 Then
y(j) = Abs(b(j) - b(j + 1))
x(j) = Abs(b(j + 1) - b(j + 2))
If x(j) < y(j) Then
Else
s(i) = y(j)
sm(i) = (b(j + 1) + b(j + 2)) / 2
Print
Print "载荷变程"; s(i); "均值"; sm(i)
For w = j To UBound(b) - 2
b(w) = b(w + 2)
Next w
Dim u() As Integer
ReDim u(1 To UBound(b) - 2)
For t = 1 To UBound(b) - 2
u(t) = b(t)
Next t
ReDim b(1 To UBound(u))
For h = 1 To UBound(u)
b(h) = u(h)
Next h
j = j - 1
End If
End If
Next j
Command2.SetFocus
End Sub