-
Разработка пользовательского интерфейса
Рисунок 3 – Пользовательская форма
Userform – пользовательская форма, которая предназначена для отображения основных элементов управления.
Label1 – надпись, которая предназначена для отображения текста «Длина кривошипа».
Label2 – надпись, которая предназначена для отображения текста «Начальный угол».
TextBox1 – текстовое поле, которое предназначено для ввода длины кривошипа.
TextBox2 – текстовое поле, которое предназначено для ввода начального угла.
TextBox3 – текстовое поле,
которое предназначено для вывода длины
кулисы
.
TextBox4 – текстовое поле,
которое предназначено для вывода длины
кулисы
.
TextBox4 – текстовое поле,
которое предназначено для вывода
межосевого расстояния
.
TextBox5 – текстовое поле,
которое предназначено для вывода
расстояния
.
TextBox6 – текстовое поле, которое предназначено для вывода расстояния до точки C Y.
Compare – кнопка, предназначенная
для расчета длин
,
,
,
,
Y и вывода их в
текстовые поля.
Run – кнопка, которая предназначена для отображения анимации механизма на рабочем листе.
Cancel – кнопка выхода из формы.
Clear – кнопка, которая предназначена для очистки пользовательской формы.
BuildDiagram – кнопка, которая предназначена для рисования графиков скорости, перемещения и ускорения.
Image1 – элемент управления, который предназначен для отображения изображения графика перемещения.
Image2 – элемент управления, который предназначен для отображения изображения графика скорости.
Image3 – элемент управления, который предназначен для отображения изображения графика ускорения.
3 Реализация программного модуля
-
Код программы
Const Pi = 3.14159265358979
Dim y, O2B, o2d, o1o2, value As Double
Private Sub Workbook_Open()
Kurs.Show
End Sub
Private Sub CommandButton2_Click()
Kurs.Hide
End Sub
Private Sub UserForm_Initialize()
Image1.PictureAlignment = fmPictureAlignmentTopLeft
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image2.PictureAlignment = fmPictureAlignmentTopLeft
Image2.PictureSizeMode = fmPictureSizeModeStretch
Image3.PictureAlignment = fmPictureAlignmentTopLeft
Image3.PictureSizeMode = fmPictureSizeModeStretch
Frame.Visible = False
End Sub
'Кнопка Механизм'
Private Sub CommandButton3_Click()
If Not IsNumeric(LO1A.Text) Then
MsgBox "Длина кривошипа должна быть числом", vbOKOnly, "Повторите ввод..."
TextBox1 = ""
TextBox1.SetFocus
Exit Sub
End If
If LO1A <= 0 Then
MsgBox "Длина кривошипа должна быть больше 0", vbOKOnly, "Повторите ввод..."
TextBox1 = ""
TextBox1.SetFocus
Exit Sub
End If
If Not IsNumeric(fi1.Text) Then
MsgBox "Значение угла должно быть числом", vbOKOnly, "Повторите ввод..."
TextBox2 = ""
TextBox2.SetFocus
Exit Sub
End If
O1A = CInt(LO1A.Text)
f1 = CInt(fi1.Text) * Pi / 180
xo1 = 100: yo1 = 100
o1o2 = 3 * O1A: y = 2.4 * O1A: O2B = 4.5 * O1A: o2d = 3 * O1A
For f = 0 + f1 To 2 * Pi + f1 Step Pi / 60
xA = xo1 - O1A * Cos(f)
yA = yo1 + O1A * Sin(f)
xo2 = xo1 + o1o2
yo2 = yo1
phi1 = Atn((yo2 - yA) / (xo2 - xA))
phi2 = Pi / 2 - phi1
phi3 = Pi / 2 - phi2
yB = yo1 - (O2B * Sin(phi1))
ro2 = Sqr((O2B) ^ 2 - (yB - yo1) ^ 2)
xB = xo1 - (ro2 - o1o2)
phi4 = Pi / 2 - phi3
phi5 = (Pi / 2) - phi4
O2C = y / Cos(phi5)
If f >= 0 And f <= 1 * Pi Or f >= 2 * Pi And f <= 3 * Pi Then
xC = xo1 + (o1o2 - Sqr((O2C) ^ 2 - (y) ^ 2))
Else
xC = xo1 + (o1o2 + Sqr((O2C) ^ 2 - (y) ^ 2))
End If
yC = yo1 - y
yD = yo1 - (o2d * Cos(phi5))
If f >= 0 And f <= 1 * Pi Or f >= 2 * Pi And f <= 3 * Pi Then
xD = xo1 + (o1o2 - Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
Else
xD = xo1 + (o1o2 + Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
End If
ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, xo1 - 3, yo1, 6, 6).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, xo2 - 3, yo2, 6, 6).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, xC - 5, yC - 2, 10, 4).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, xA - 5, yA - 2, 10, 4).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddLine(xo1, yo1, xA, yA).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xo2, yo2, xB, yB).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xC, yC, xo2, yo2).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xD, yD, xC, yC).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xC, yC, xC - O1A * 3, yC).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xo2 - O1A * 2, yC - 2, xo2 - y, yC - 2).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xo2 - O1A * 2, yC + 2, xo2 - y, yC + 2).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddShape(msoShapeOval, xA - 1, yA - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeOval, xC - 1, yC - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeOval, xo1 - 1, yo1 - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeOval, xo2 - 1, yo2 - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
Clock 0.01
ActiveSheet.Shapes.SelectAll
Selection.Delete
Next f
End Sub
Private Sub Clear_Click()
Cells.Clear
ActiveSheet.Shapes.SelectAll
Selection.Delete
Image1.Picture = LoadPicture("")
Image2.Picture = LoadPicture("")
Image3.Picture = LoadPicture("")
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Frame.Visible = False
End Sub
Sub Clock(PauseTime)
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub
Private Sub BuildDiagram_Click()
Dim fi As Double, L As Double
Dim input_text As Boolean
Dim iter As Integer
return_value = CheckInputData(LO1A.Text, fi1.Text, L, fi)
If (return_value = False) Then
MsgBox "Ошибка исходных данных", vbCritical, "Сообщение об ошибке"
Exit Sub
End If
angle = fi
For iter = 1 To 13
Call WriteDataOnList(angle, L, iter)
angle = angle + Pi / 6
Next iter
Call DrawGraphics
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
Function CheckInputData(ByVal L_text As String, ByVal fi1_text As String, _
ByRef L As Double, ByRef fi As Double)
If (IsNumeric(L_text)) Then
If (CDbl(L_text) > 0) Then
L = CDbl(L_text)
Else
CheackInputData = False
Exit Function
End If
Else
CheackInputData = False
Exit Function
End If
If (IsNumeric(f1_text)) Then
fi = CDbl(fi1_text) * Pi / 180
Else
CheackInputData = False
Exit Function
End If
CheckInputData = True
End Function
Sub WriteDataOnList(ByVal angle As Double, ByVal L As Double, ByVal iterator As Integer)
Worksheets(2).Range("A" & iterator) = iterator - 1
Worksheets(2).Range("B" & iterator) = Recompare(angle, L)
Worksheets(2).Range("C" & iterator) = iterator - 1
Worksheets(2).Range("D" & iterator) = (Recompare(angle + 0.000001, L) - Recompare(angle - 0.000001, L)) / 0.000001
Worksheets(2).Range("E" & iterator) = iterator - 1
Worksheets(2).Range("F" & iterator) = (Recompare(angle + 0.001, L) - 2 * Recompare(angle, L) + Recompare(angle - 0.001, L)) / 0.001 ^ 2
End Sub
Function Recompare(ByVal angle As Double, ByVal L_value As Double)
O1A = L_value
xo1 = 0: yo1 = 0
o1o2 = 3 * O1A: y = 2.4 * O1A: O2B = 4.5 * O1A: o2d = 3 * O1A
xA = xo1 - O1A * Cos(angle)
yA = yo1 + O1A * Sin(angle)
xo2 = xo1 + o1o2
yo2 = yo1
phi1 = Atn((yo2 - yA) / (xo2 - xA))
phi2 = Pi / 2 - phi1
phi3 = Pi / 2 - phi2
yB = yo1 - (O2B * Sin(phi1))
ro2 = Sqr((O2B) ^ 2 - (yB - yo1) ^ 2)
xB = xo1 - (ro2 - o1o2)
phi4 = Pi / 2 - phi3
phi5 = (Pi / 2) - phi4
O2C = y / Cos(phi5)
If angle >= 0 And angle <= 1 * Pi Or angle >= 2 * Pi And angle <= 3 * Pi Then
xC = xo1 + (o1o2 - Sqr((O2C) ^ 2 - (y) ^ 2))
Else
xC = xo1 + (o1o2 + Sqr((O2C) ^ 2 - (y) ^ 2))
End If
yC = y
yD = o2d * Cos(phi5)
If angle >= 0 And angle <= 1 * Pi Or angle >= 2 * Pi And angle <= 3 * Pi Then
xD = xo1 + (o1o2 - Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
Else
xD = xo1 + (o1o2 + Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
End If
Recompare = yD
End Function
Sub DrawLink(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
With ActiveSheet.Shapes.AddLine(screenX + x1, screenY - y1, screenX + x2, screenY - y2)
.Line.BeginArrowheadStyle = msoArrowheadOval
.Line.EndArrowheadStyle = msoArrowheadOval
End With
End Sub
Sub DrawGraphics()
Const count_cell = 13
Image1.Picture = LoadPicture(Diagram("A1:B" & count_cell, "График перемещения"))
Image2.Picture = LoadPicture(Diagram("C1:D" & count_cell, "График скорости"))
Image3.Picture = LoadPicture(Diagram("E1:F" & count_cell, "График ускорения"))
End Sub
Function Diagram(o, name)
cells_range = o
Range(cells_range).Select
Charts.Add
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SetSourceData Source:=Sheets("Лист2").Range(cells_range)
ActiveChart.Location Where:=xlLocationAsObject, name:="Лист2"
ActiveChart.SeriesCollection(1).Smooth = True
ActiveChart.Legend.Delete
ActiveChart.ChartWizard , , , , , , , Title:=name
ActiveChart.Export ActiveWorkbook.Path & "\ss.gif"
Worksheets(2).ChartObjects.Delete
Worksheets(2).Range(cells_range) = ""
Worksheets(2).Cells(1, 1).Select
Diagram = ActiveWorkbook.Path & "\ss.gif"
End Function
Private Sub Compare_Click()
Dim fi As Double, L As Double
Dim input_text As Boolean
return_value = CheckInputData(LO1A.Text, fi1.Text, L, fi)
If (return_value = False) Then
MsgBox "Ошибка исходных данных", vbCritical, "Сообщение об ошибке"
Exit Sub
End If
Call Recompare(fi, L)
Text1 = "DO2:" & o2d
Text2 = "BO2:" & O2B
Text3 = "O1O2:" & o1o2
Text4 = "y:" & y
Frame.Visible = True
End Sub