#### mortgageman

##### Well-known Member

- Joined
- Jun 30, 2005

- Messages
- 2,015

Gene, "The Mortgage Man", Klein

Private Sub Go_Click()

Dim a, b, c As Long ' the a,b and c of ax2+bx+c

Dim aos As Double ' Axis Of Symmetry

Dim x1, x2 As Double 'The two roots

Dim determ As Double

Dim line1xarray, line1yarray

Dim y1, y2, y3, y4, y5, y6, y7

Dim currentchart, fname

'Retrieve the Coefficients of the quadratic

a = TextBox1.Value

b = TextBox2.Value

c = TextBox3.Value

'Calculate the Axis of Symmetry

aos = -1 * b / (2 * a)

TextBox4.Value = aos

'Calculate y value of vertex

TextBox5.Value = a * aos ^ 2 + b * aos + c

'Determine if function "holds" or "spills" water

TextBox6.Value = "UP"

If a < 0 Then TextBox6.Value = "DOWN"

'Determine if function is wider or narrower than y=x^2

TextBox7.Value = "WIDER"

If Abs(a) > 1 Then TextBox7.Value = "NARROWER"

'Express in Vertex form

TextBox8.Value = a & "(x-" & aos & ")^2+" & TextBox5.Value

'Make sure that there are no complex roots

determ = b ^ 2 - 4 * a * c

If determ < 0 Then

TextBox12.Value = "The rest is too complex for me"

Exit Sub

End If

'Calculate first root

MsgBox allroots(a, b, c, 0)

x1 = (-b + (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)

TextBox10.Value = x1

MsgBox allroots(a, b, c, 1)

'Calculate second root

x2 = (-b - (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)

TextBox11.Value = x2

'Express in Intercept form

TextBox9.Value = a & "(x-" & x1 & ")(x-" & x2 & ")"

'Generate the Graph

'First clean up any graphs that may already exist:

Charts.Add

ActiveChart.ChartType = xlXYScatterSmooth

Do Until ActiveChart.SeriesCollection.Count = 0

ActiveChart.SeriesCollection(1).Delete

Loop

'create the arrays for the inputs to the charts

line1xarray = Array(aos - 3, aos - 2, aos - 1, aos, aos + 1, aos + 2, aos + 3)

y1 = a * ((aos - 3) ^ 2) + b * (aos - 3) + c

y2 = a * ((aos - 2) ^ 2) + b * (aos - 2) + c

y3 = (a * ((aos - 1) ^ 2)) + b * (aos - 1) + c

y4 = a * (aos ^ 2) + b * aos + c

y5 = a * ((aos + 1) ^ 2) + b * (aos + 1) + c

y6 = a * ((aos + 2) ^ 2) + b * (aos + 2) + c

y7 = a * ((aos + 3) ^ 2) + b * (aos + 3) + c

line1yarray = Array(y1, y2, y3, y4, y5, y6, y7)

'put on line 1

With ActiveChart.SeriesCollection.NewSeries

.Name = "Line 1"

.XValues = line1xarray

.Values = line1yarray

End With

'put on line 2

With ActiveChart.SeriesCollection.NewSeries

.Name = "Line 2"

.XValues = Array(aos, aos, aos, aos, aos, aos, aos)

.Values = line1yarray

End With

'Title the Chart

With ActiveChart

.HasTitle = True

.ChartTitle.Characters.Text = "y=ax^2+bx+c"

End With

'put Horizontal and Vertical Gridline

With ActiveChart.Axes(xlCategory)

.HasMajorGridlines = True

.HasMinorGridlines = False

End With

With ActiveChart.Axes(xlValue)

.HasMajorGridlines = True

.HasMinorGridlines = False

End With

'Write the Chart to the spreadsheet

ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"

'Write graph to a file and then read it into the UF image

'Set currentchart = Sheets("Sheet1").ChartObjects(Sheets("Sheet1").ChartObjects.Count).Chart

'fname = ThisWorkbook.Path & "\temp.gif"

'currentchart.Export Filename:=fname, Filtername:="GIF"

'Image1.Visible = True

'Image1.Picture = LoadPicture(fname)

End Sub

Private Function q(a As Long, b As Long, c As Long, ByVal xval) As Long

q = a * xval ^ 2 + b * xval + c

End Function

Public Function allroots(a As Long, b As Long, c As Long, posneg As Boolean)

Dim determ As Double

Dim real, img As Double

determ = b ^ 2 - 4 * a * c

If determ < 0 Then

real = -b / (2 * a)

determ = -determ

img = (determ ^ 0.5) / (2 * a)

If (posneg = 0) Then img = -img

allroots = complex(real, img)

Exit Sub

End If

If posneg = 0 Then

allroots = (-b - (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)

Else: allroots = (-b + (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)

End If

End Function