求助有关计算方法插值部分的问题!!!!!!!!!!!

Question

大家好,我有一个问题想请教大家,希望能得到您的帮助,谢谢!
我在做一个关于计算方法的软件的论文,需要改正下面有关插值的程序,希望您能帮我解决一下:
Dim flag As Boolean '判断是否可以输入小数点
Dim flag1 As Boolean '判断是否是从msflexgild中提取数据
Dim aflag As Boolean '判断是否可以输入小数点
Dim aflag1 As Boolean '判断是否是从msflexgild中提取数据
Private Sub a1_Change()
c.Text = a1.Text
End SubPrivate Sub c_EnterCell()
If c.Col > 1 And c.Row > 0 Then Exit SubIf aflag1 Then
a1.Text = ""
aflag = True
End IfEnd SubPrivate Sub c_KeyPress(KeyAscii As Integer)
If c.Col > 1 And c.Row > 0 Then Exit SubIf (KeyAscii <= Asc("9") And KeyAscii >= Asc("0")) Or (KeyAscii = Asc(".")) Or (KeyAscii = Asc("-")) Then
    If KeyAscii = Asc("-") And Len(a1.Text) = 0 Then a1.Text = a1.Text & Chr(KeyAscii)
    
    If KeyAscii = Asc(".") And aflag Then
    a1.Text = a1.Text & Chr(KeyAscii)
    aflag = False
    End If    If KeyAscii <> Asc("-") And KeyAscii <> Asc(".") Then
    a1.Text = a1.Text & Chr(KeyAscii)
    End If
Else
KeyAscii = 0
Beep
End IfEnd Sub
Private Sub Command2_Click()
Dim x(0 To 17)
Dim y(0 To 17)
Dim Y1(0 To 3)
flag1 = False
aflag1 = False
For i = 1 To b.Rows - 1
b.Col = 1
b.Row = i
x(i - 1) = Val(b.Text)
b.Col = 2
y(i - 1) = Val(b.Text)
If Module1.index1 = "hmet" Then
b.Col = 3
Y1(i - 1) = Val(b.Text)
End If
Next
c.Col = 1
c.Row = 1
d = Val(c.Text)
If judge(x(), y(), d) Then
MsgBox "输入错误"
GoTo aa
End If
c.Col = 2
Select Case Module1.index1
Case "lagr": c.Text = Round(lagr(x(), y(), d), 6)
Case "newton": c.Text = Round(newton(x(), y(), d), 6)
Case "hmet": c.Text = Round(hmrt(x(), y(), Y1(), d), 6)
End Select
aa:
flag = True
aflag = True
Command2.Enabled = False
UpDown1.Enabled = False
Text1.Enabled = False
End Sub
Function judge(x(), y(), d) As Boolean
n = Text1.Text
judge = False
For i = 0 To n - 2
If x(i) >= x(i + 1) Then judge = True
Next
If d = 0 Then judge = True
End FunctionPrivate Sub Command3_Click()
Unload Me
End SubPrivate Sub Form_Load()
geshu = 1
flag1 = True
flag = True
aflag1 = True
aflag = True
b.Rows = 2 + 1
b.Cols = 3
b.Row = 0
c.Row = 0
For i = 1 To 2
b.Col = i
c.Col = i
If i = 1 Then b.Text = "        X" Else b.Text = "       Y"
If i = 1 Then c.Text = "        X" Else c.Text = "       Y"
Next
b.Col = 0
For i = 1 To b.Rows - 1
b.Row = i
b.Text = i
Next
c.Col = 0
c.Row = 1
c.Text = 1
If Module1.dianshu < 10 Then
b.Height = b.CellHeight * (b.Rows + 1)
Else
b.Height = b.CellHeight * (b.Rows + 1.5)
End If
If Module1.dianshu > 3 Then Me.Height = b.Height * 1.35 + b.Top
skn.LoadSkin Module1.file1  ' Loads another skin into Skin component
skn.ApplySkin Me.Hwnd ' Applies the skin to this window and its child controls
Select Case Module1.index1
Case "lagr": Me.Caption = "Lanrange插值"
Case "newton": Me.Caption = "Newton插值"
Case "hmet":
Me.Caption = "Hermite插值"
b.Cols = 4
b.Width = b.Width + b.CellWidth
c.Left = c.Left + b.CellWidth
Me.Width = Me.Width + b.CellWidth
Text1.Enabled = False
UpDown1.Enabled = False
b.Col = 3
b.Row = 0
b.Text = "       Y'"
End SelectEnd Sub
Private Sub a_Change()
b.Text = a.Text
End SubPrivate Sub b_EnterCell()
If flag1 Then
a.Text = ""
flag = True
End If
End SubPrivate Sub b_KeyPress(KeyAscii As Integer)
If (KeyAscii <= Asc("9") And KeyAscii >= Asc("0")) Or (KeyAscii = Asc(".")) Or (KeyAscii = Asc("-")) Then
    If KeyAscii = Asc("-") And Len(a.Text) = 0 Then a.Text = a.Text & Chr(KeyAscii)
    
    If KeyAscii = Asc(".") And flag Then
    a.Text = a.Text & Chr(KeyAscii)
    flag = False
    End If    If KeyAscii <> Asc("-") And KeyAscii <> Asc(".") Then
    a.Text = a.Text & Chr(KeyAscii)
    End If
Else
KeyAscii = 0
Beep
End IfEnd SubPrivate Sub Text1_Change()
Module1.dianshu = Text1.Text
If b.Rows < Text1.Text + 1 Then Call re(1) Else Call re(-1)
b.Rows = Text1.Text + 1
b.Row = b.Rows - 1
b.Col = 0
b.Text = b.Row
End Sub
Sub re(x As Integer)
b.Height = b.Height + x * 240
Me.Height = Me.Height + x * 240
Command2.Top = Command2.Top + x * 240
Command3.Top = Command2.Top
End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End SubFunction lagr(a(), b(), x)
Dim l(0 To 20)
lagr = 0
For i = 0 To dianshu
l(i) = 1
For j = 0 To dianshu
If i <> j Then l(i) = (x - a(j)) / (a(i) - a(j)) * l(i)
Next j
lagr = lagr + l(i) * b(i)
Next i
Exit Function
End Function
Function newton(a(), b(), v)
Dim i, j As Integer
Dim c(0 To 20)
aa = 0
For i = 0 To dianshu
l = 1
If i <> 0 Then
For j = 0 To dianshu - i
c(j) = a(j + i) - a(j)
b(j) = (b(j + 1) - b(j)) / c(j)
Next j
End If
For j = 0 To i - 1
l = l * (v - a(j))
Next j
newton = newton + l * b(0)
Next i
Exit Function
End Function程序就是这些,希望能尽快得到您的帮助,非常感谢!

Answer 1

昨晚看了你的程序，看得本人头痛(你引起的对象没有说明，变量又不按规范书写)：不过还是发现了错误。现在整理如下：
1.command2_click:以下代码中hmrt函数不存在
  Case "hmet": c.Text = Round(hmrt(x(), y(), Y1(), d), 6)2.我认为你所谓的“插值”，就是输入确定的字符(比如只能输入数字、大小写字母等)。因此没有必要在MSflexgrid中去输入。你可以在任何一个文本框中输入，将些值再传送到MSflexgrid中你指定的单元格。我曾经写过一段在文本框中控制输入数字及小数点程序，如下仅供参考：Option Explicit
Dim decimaltag As BooleanPrivate Sub Form_Load()
   decimaltag = False
End SubPrivate Sub Text1_Change()
   If InStr(1, Trim$(Text1.Text), ".") Then
      decimaltag = True
   End If
End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 46 And decimaltag = False Then
      decimaltag = True  '控制小数点只能输入一次。
   ElseIf KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Then
      Exit Sub
   ElseIf KeyAscii <= 31 Then
      Exit Sub   '控制可接受退格键或删除键等。
   Else
      KeyAscii = 0
   End If
End Sub3.如果你真的需要在MSflexgrid中输入，MSflexgrid我调试了昨天的代码，无论如果它不会接受删除键和退格键。因此如果输入错误的话，修改非常困难。原来你的代码有诸多错误，如果调整如下：Private Sub c_EnterCell()
   'If c.Col > 1 And c.Row > 0 Then Exit Sub  '这句代码是什么意思？
   '难道是只要存在一两列和一行，就不允许输入任何值吗？   If aflag1 Then
      a1.Text = ""
      aflag = True
   End IfEnd SubPrivate Sub c_KeyPress(KeyAscii As Integer)
   'If c.Col > 1 And c.Row > 0 Then Exit Sub  '这句代码是什么意思？
   '难道是只要存在一两列和一行，就不允许输入任何值吗？
   
   If KeyAscii <= Asc(9) And KeyAscii >= Asc(0) Then
      a1.Text = a1.Text & Chr(KeyAscii)
   ElseIf KeyAscii = Asc(".") Then
      If aflag Then
         a1.Text = a1.Text & Chr(KeyAscii)
         aflag = False
      End If
   ElseIf KeyAscii = Asc("-") Then
      If Len(a1.Text) = 0 Then
         a1.Text = a1.Text & Chr(KeyAscii)
      End If
   Else
      KeyAscii = 0
      Beep
   End IfEnd SubPrivate Sub b_EnterCell()
   If flag1 Then
      a.Text = ""
      flag2 = True
   End If
End SubPrivate Sub b_KeyPress(KeyAscii As Integer)   If KeyAscii <= Asc("9") And KeyAscii >= Asc("0") Then
      a.Text = a.Text & Chr(KeyAscii)
   ElseIf KeyAscii = Asc(".") Then
      If flag2 Then
         a.Text = a.Text & Chr(KeyAscii)
         flag2 = False
      End If
   ElseIf KeyAscii = Asc("-") Then
      If Len(a.Text) = 0 Then
         a.Text = a.Text & Chr(KeyAscii)
      End If
   ElseIf KeyAscii <= 31 Then
      Exit Sub
   Else
      KeyAscii = 0
      Beep
   End IfEnd Sub

Answer 2

上面一句If KeyAscii <= Asc(9) And KeyAscii >= Asc(0) Then
还是应改为：
If KeyAscii <= Asc("9") And KeyAscii >= Asc("0") Then
虽经如上调整，还是不能接受退格键和删除键。你好自为之吧。

Answer 3

qingming81(晴明)兄:
看了你对作者 netcp (风之翼)  那个人的回答,耐心且详细.在这个追求金钱和分数(星星)的时代,还能有你这样的人,我很配服你.真的.是CSDN的庆幸,是中国程序员们的庆幸.其实这个帖子我以前也看过的.当时我确实觉得麻烦(或许是不愿去回答这样混乱的问题),而一晃而过.没想到时隔两个多月再次看到........现在我觉得十分对不起我头上的4颗星.更觉得惭愧与虚伪.为什么我变成了这样,当年我是新手的时候,也多么渴望别人的帮助!为什么我变成了这样,连我自己也不能解释.为了容易的问题能拿容易的分?我郁闷.不知道说些什么好,也不知道该在做些什么好.思考些什么呢?我却是一片空白.

Answer 4

退格键是KeyPress里面KeyAscii=8
删除键是KeyDown里面的KeyCode=vbKeyDelete所有的插值函数你都省略了，是吧楼上上的这位值得表扬