Логический алгоритм почти отладил. Исходные числа из файла/текстбокса читает без ошибок, переводит их в числовой массив без ошибок. Сливает в эксель эти же числовые массивы исходных чисел- без ошибок. Создает из этих массивов матрицу, странновато создает- иногда внутри попадаются столбцы из нулей. Буду разбираться.
Благодарю пользователя Alex77755
http://www.cyberforum.ru/members/13705.html , благодаря Помощи Алекса я решил фундаментальные проблемы проги умножения в столбик, и его Калькулятор это просто класс, выдает отличные результаты, проверенные мною на точно верных, полученных другим путём.
Функцией Split можно данные и из Текстбокса обрабатывать: alltext =textbox1.text Все числа через пробелы каждое за один раз.
Код:
Public Class Form1
Dim n, i, j, l, l3, p4, s As Integer
Dim w, w2, b(), b2(), l2(,) As Integer
Dim q3(), q4, q5() As Integer
Dim z(,), z2(,), m, p2(), p3() As Integer
Dim x, y, v, t, t2, more As Integer
Dim TestArray(), c(), c2(), s2() As String
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextBox1.Clear()
Button2.Text = "Ввод через текстовое окно"
Button1.Text = "Вычислить"
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim n, k, f As Integer
Dim w As Integer
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim alltext As String
alltext = My.Computer.FileSystem.ReadAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt")
TestArray = Split(alltext, " ") 'критерий-пробел- после запятой. если без него-по умолчанию, то всё равно пробел. Обязательно " " , а не "" -иначе alltext не разделится.
Dim LastNonEmpty As Integer = -1 'номер только непустых элементов
For i As Integer = 0 To TestArray.Length - 1 ' номер последнего(верхняя граница) меньше на 1 чем длина массива
If TestArray(i) <> "" Then
LastNonEmpty = LastNonEmpty + 1
TestArray(LastNonEmpty) = TestArray(i) ' LastNonEmpty будет всегда меньше i, i считает и пустые
End If
Next
ReDim Preserve TestArray(LastNonEmpty) 'установление новой верхней границы, кол-ва эл-тов TestArray
w = Len(TestArray(0))
My.Computer.FileSystem.WriteAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt", CStr(w), True) 'для проверки
w2 = Len(TestArray(1)) '
My.Computer.FileSystem.WriteAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt", CStr(w2), True)
My.Computer.FileSystem.WriteAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt", TestArray(0), True) 'для проверки
Dim c(w) As String 'ustanovlenie verhnih granic. Inache Basic nikak.
Dim b(w) As Integer
Dim c2(w2) As String
Dim b2(w2) As Integer
For n = 1 To w
c(n) = Mid(TestArray(0), n, 1) '
b(n) = CInt(c(n)) ' X ,perevedenny v massiv
Next
For n = 1 To w2
c2(n) = Mid(TestArray(1), n, 1)
b2(n) = CInt(c2(n)) 'Y, perevedenny v massiv
Next
If w > w2 Or w = w2 Then 'эта кутерьма нужна, чтобы записать массивы Х и У одним двумерным в эксель(на всякий случай)
more = w
Else : more = w2
End If
Dim z2(2, more) As Integer 'но строки 3 и столбцов more+1
For k = 1 To w
z2(1, k) = b(k)
Next
For k = 1 To w2
z2(2, k) = b2(k)
Next
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets(1)
Dim l2(w2, w) As Integer
Dim z(w2, w + 1) As Integer
Dim p2(w) As Integer
Dim p3(w) As Integer
For n = w2 To 1
For k = w To 1 'sozdanie matrici к- номера столбцов
l = b(k) * b2(n)
If l >= 10 Then
l2(n, k) = Math.Floor(l / 10) 'desyatki. из предыдущего шага берём
l3 = l - 10 * l2(n, k) 'edinici
z(n, k) = l2(n, k + 1) + l3
Else : l = z(n, k)
End If
If k = 1 Then 'posledny stolbec
p2(k) = l + l2(n, w + 1)
p3(k) = Math.Floor(p2(k) / 10) 'desiatki kraine levih chlenov
z(n, w) = p2(k) - 10 * p3(k) 'edinici
z(n, w + 1) = p3(k) '
End If
Next
Next
oSheet.Range("A1").Value = "Пример заголовка"
oSheet.Range("A3").Resize(3, more + 1).Value = z2 'в ресайзе указываем фактическое число строк, столбцов
oSheet.Range("A9").Resize(w2 + 1, w + 2).Value = z
oBook.SaveAs("C:\Documents and Settings\я\Мои документы\97476001754732.xls") 'если файла нет- будет создан, если есть- ответить заменить на вопрос "заменить?"
oExcel.Quit()
My.Computer.FileSystem.WriteAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt", " ", True)
Dim q3(w + w2) As Integer
Dim q5(w + w2) As Integer
For n = 1 To (w + 1) 'kolichestvo stolbcov=w+1
m = z(1, n)
For f = 1 To (n - 1)
m = m + z(f + 1, n - f) 'summiruem po \diagonali
Next
q3(n) = Math.Floor(m / 10) 'desyatki ot chisel sumirovania
q4 = m - 10 * q3(n) 'ih edinici
q5(n) = q4 + q3(n - 1)
My.Computer.FileSystem.WriteAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt", CStr((q5(n))), True)
Next
For n = w + 2 To (w + 1 + w2 - 1) '(1,w+1)-uglovoy element matrici vhodit in w and in w2
m = z(n - (w + 1) + 1, w + 1)
For f = 1 To (w2 - (n - (w + 1) + 1)) ' ostatok do konca w2-vertikalnoy dliny ot tekushego n
m = m + z(f + n - (w + 1) + 1, w + 1 - f) ' summiruem po \diagonali
Next
q3(n) = Math.Floor(m / 10) 'desyatki ot chisel sumirovania
q4 = m - 10 * q3(n) 'ih edinici
q5(n) = q4 + q3(n - 1)
If n = w + w2 Then
q5(n) = m + q3(n - 1) 'pervaia cifria Rezultata ne razdeliaetsa
My.Computer.FileSystem.WriteAllText("C:\Documents and Settings\я\Мои документы\97476001754732.txt", CStr((q5(n))), True)
End If
Next
End Sub
Public Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
On Error GoTo ErrorHandler ' ввод
If x > 1 Then
Me.TextBox1.Text = TestArray(1)
Else : Me.TextBox1.Text = TestArray(0) 'before exitsub- kod, mogushiy sozdat oshibku
End If
'Exit Sub
ErrorHandler:
Me.TextBox1.Text = TestArray(0) ' Insert code to handle the error here
Resume Next 'perehod k sleduyoushey comande koda, vniz
TextBox1.Clear()
End Sub
End Class