Переделать код с Delphi на VB

@kkk008009kkk · Регистрация: 24.03.2011

Студворк — интернет-сервис помощи студентам

Добрый день.
Написал код на delphi:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
type tbook=record
x:array [1..4] of real;
y:real;
c:array [1..5] of real;
z1:array [1..4] of real;
z2:array [1..4] of real;
z3:array [1..4] of real;
end;
var
book:tbook;
f:file of tbook;
i:integer;
begin
 
    AssignFile(F, 'C:\Program Files\ProgramVr 2.0\books.dat'); { связать с указателем }
Reset(F);        { открыть для чтения }
Read(F, Book);       { чтение }

Пробую переиначить на basic:

Visual Basic
1
2
3
4
5
6
7
8
9
type tbook
Dim x(5) as double
Dim y as double
Dim c(5) as double
Dim z1(4) as double
Dim z2(4) as double
Dim z3(4) as double
end type
Public book As tbook

Осталось одно: открыть файл, оттуда данные перекинуть в запись tbook.

Объясните, пожалуйста, как это сделать.

@kkk008009kkk · 16.04.2012, 21:36 **[ТС]**

SoftIce, да, результаты совпали с дельфийскими, у меня там ошибка была. А как сделать вывод массива funct(k) в файл? замена Val(Replace((Text7.Text) на funct(k) не проходит

SoftIce · 16.04.2012, 21:44

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Option Explicit
Private Type tbook
   x(1 To 4) As Double
           y As Double
   c(1 To 5) As Double
  z1(1 To 4) As Double
  z2(1 To 4) As Double
  z3(1 To 4) As Double
End Type
Dim zR(1 To 4) As Double 'переменная z в радианах
Private Book As tbook
Dim funct(1 To 16) As Double
Const pi = 3.14159265358979
Const E = 2.7182818
Private Sub Command2_Click() ' Считывание данных из файла
Dim a As String, i As Integer
'C:\Program Files\ProgramVr 2.0\books.dat'
 Open App.Path & "\books.txt" For Input As #1
   For i = 1 To 4
       Line Input #1, a
       Book.x(i) = Val(Replace(CStr(a), ",", "."))
   Next i
       Line Input #1, a
       Book.y = Val(Replace(CStr(a), ",", "."))
   For i = 1 To 5
       Line Input #1, a
       Book.c(i) = Val(Replace(CStr(a), ",", "."))
   Next i
   For i = 1 To 4
       Line Input #1, a
       Book.z1(i) = Val(Replace(CStr(a), ",", "."))
   Next i
   For i = 1 To 4
       Line Input #1, a
       Book.z2(i) = Val(Replace(CStr(a), ",", "."))
   Next i
   For i = 1 To 4
       Line Input #1, a
       Book.z3(i) = Val(Replace(CStr(a), ",", "."))
   Next i
Close #1
Vyvod_V_Tekstovye_Pola
Command1.Enabled = True: Command3.Enabled = True
End Sub
Private Sub Command1_Click()
Dim j As Integer, i As Integer, k
'Запись в файл
'C:\Program Files\ProgramVr 2.0\books.dat'
k = 0
 Open App.Path & "\books1.txt" For Output As #1
   For i = 1 To 4
   For j = 1 To 4
       k = k + 1
       Print #1, Text1(j).Text, _
                 Text2.Text, _
                 Text4(i).Text & " г. "; _
                 Text5(i).Text & " м. "; _
                 Text6(i).Text & " с. ", _
                 funct(k)
       Next j
       Print
   Next i
  Close #1
End Sub
Private Sub Vyvod_V_Tekstovye_Pola()
   Dim i As Integer
   For i = 1 To 4
      Text1(i).Text = Book.x(i)
   Next i
      Text2.Text = Book.y
   For i = 1 To 5
      Text3(i).Text = Book.c(i)
   Next i
   For i = 1 To 4
      Text4(i).Text = Book.z1(i)
   Next i
   For i = 1 To 4
      Text5(i).Text = Book.z2(i)
   Next i
   For i = 1 To 4
      Text6(i).Text = Book.z3(i)
   Next i
End Sub
Private Sub Command3_Click() ' Вычислить'
    Dim i As Integer, j As Integer, k As Integer
    k = 0
    Command1_Click '
    Command2_Click '
    Text7.Text = ""
    For i = 1 To 4
        For j = 1 To 4
        k = k + 1
        zR(i) = Radian(Book.z1(i), Book.z2(i), Book.z3(i)) ' Заполняем массив значениям углов в радианах
        funct(k) = F(Book.x(j), Book.y, zR(i))             ' Вычисляем значения функции
        Text7.Text = Text7.Text & "F (" & i & ") = " & funct(i) & vbNewLine ' Выводим результат
    Next j
    Next i
End Sub
'  Основная функция F = ( S(y) + tan(Z))*(sqr(sin(x)- E^tan(z))
Private Function F(x As Double, y As Double, z As Double) As Double
   F = (S(y) + Tan(z)) * (Sqr(Sin(x)) - E ^ Tan(z)) '
End Function
'  Вычисляем сумму ряда
Private Function S(y As Double) As Double
Dim i As Integer
S = Book.c(1)
For i = 2 To 5
    S = S + Book.c(i) * y ^ (i)
Next i
End Function
'  Переводим из градусов, минут, секунд в радианы
Private Function Radian(a As Double, b As Double, c As Double) As Double  '' a[рад] = a[°] * (Pi / 180),
    Radian = a * (pi / 180) + (b / 60) * (pi / 180) + (c / 3600) * (pi / 180) ' Перевод из градусов, минут, секунд в радианы
End Function

@kkk008009kkk · 16.04.2012, 22:18 **[ТС]**

SoftIce, При считывании данных с файла, перед тем, как нажать "вычислить", меняю значение y, когда нажимаю на "вычислить" значение сбрасывается на то, которое в исходном файле.

Замена book.y на Val(Text2.Text), не помогает.

И можно ли сделать, чтобы в цикле значения

zR(i) = Radian(Book.z1(i), Book.z2(i), Book.z3(i))
funct(k) = F(Book.x(j), book.y, zR(i))

проверялись на корректность и при ошибке влетало окно?

И еще:

Visual Basic
1
2
3
4
5
6
7
8
9
10
Dim a As String, i As Integer
'C:\Program Files\ProgramVr 2.0\books.dat'
 Open App.Path & "\books.txt" For Input As #1
   For i = 1 To 4
       Line Input #1, a
       Book.x(i) = Val(Replace(CStr(a), ",", "."))
   Next i
       Line Input #1, a
       Book.y = Val(Replace(CStr(a), ",", "."))
   For i = 1 To 5

В файле еще значки есть, а почему они не считываются? Из-за табуляции?

Просто хочу также на delphi сделать

SoftIce · 16.04.2012, 22:44

Сообщение от kkk008009kkk

SoftIce, При считывании данных с файла, перед тем, как нажать "вычислить", меняю значение y, когда нажимаю на "вычислить" значение сбрасывается на то, которое в исходном файле

Потому что читалось из файла а не из текстовых полей, потому что все изменения записывались в исходный файл, а потом опять считывались и проводились вычисления.
А теперь результат выводится в другой файл, и поменять исходные данные из программы нельзя, только из какого нибудь текстового редактора.
Короче это поправил, а насчёт ошибок что? Вылетает из за некорректных данных? Так это не сложно поправить.
Тока уже спать хотца

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Option Explicit
Private Type tbook
   x(1 To 4) As Double
           y As Double
   c(1 To 5) As Double
  z1(1 To 4) As Double
  z2(1 To 4) As Double
  z3(1 To 4) As Double
End Type
Dim zR(1 To 4) As Double 'переменная z в радианах
Private Book As tbook
Dim funct(1 To 16) As Double
Const pi = 3.14159265358979
Const E = 2.7182818
Private Sub Command2_Click() ' Считывание данных из файла
Dim a As String, i As Integer
'C:\Program Files\ProgramVr 2.0\books.dat'
 Open App.Path & "\books.txt" For Input As #1
   For i = 1 To 4
       Line Input #1, a
       Book.x(i) = Val(Replace(CStr(a), ",", "."))
   Next i
       Line Input #1, a
       Book.y = Val(Replace(CStr(a), ",", "."))
   For i = 1 To 5
       Line Input #1, a
       Book.c(i) = Val(Replace(CStr(a), ",", "."))
   Next i
   For i = 1 To 4
       Line Input #1, a
       Book.z1(i) = Val(Replace(CStr(a), ",", "."))
   Next i
   For i = 1 To 4
       Line Input #1, a
       Book.z2(i) = Val(Replace(CStr(a), ",", "."))
   Next i
   For i = 1 To 4
       Line Input #1, a
       Book.z3(i) = Val(Replace(CStr(a), ",", "."))
   Next i
Close #1
ArrayToTextBoxes
Command1.Enabled = True: Command3.Enabled = True
End Sub
Private Sub Command1_Click()
Dim j As Integer, i As Integer, k
'Запись в файл
'C:\Program Files\ProgramVr 2.0\books.dat'
k = 0
 Open App.Path & "\books1.txt" For Output As #1
   For i = 1 To 4
   For j = 1 To 4
       k = k + 1
       Print #1, Text1(j).Text, _
                 Text2.Text, _
                 Text4(i).Text & " г. "; _
                 Text5(i).Text & " м. "; _
                 Text6(i).Text & " с. ", _
                 funct(k)
       Next j
       Print
   Next i
  Close #1
End Sub
Private Sub TextBoxesToArray()
Dim a As String, i As Integer
   For i = 1 To 4
        Book.x(i) = Val(Replace(Text1(i).Text, ",", "."))
        Book.z1(i) = Val(Replace(Text4(i).Text, ",", "."))
        Book.z2(i) = Val(Replace(Text5(i).Text, ",", "."))
        Book.z3(i) = Val(Replace(Text6(i).Text, ",", "."))
   Next i
        Book.y = Val(Replace(Text2.Text, ",", "."))
   For i = 1 To 5
        Book.c(i) = Val(Replace(Text3(i).Text, ",", "."))
   Next i
End Sub
Private Sub ArrayToTextBoxes()
   Dim i As Integer
   For i = 1 To 4
      Text1(i).Text = Book.x(i)
      Text4(i).Text = Book.z1(i)
      Text5(i).Text = Book.z2(i)
      Text6(i).Text = Book.z3(i)
   Next i
      Text2.Text = Book.y
   For i = 1 To 5
      Text3(i).Text = Book.c(i)
   Next i
 End Sub
Private Sub Command3_Click() ' Вычислить'
    Dim i As Integer, j As Integer, k As Integer
    k = 0
    'Command1_Click '
    'Command2_Click '
    TextBoxesToArray
    Text7.Text = ""
    For i = 1 To 4
        For j = 1 To 4
        k = k + 1
        zR(i) = Radian(Book.z1(i), Book.z2(i), Book.z3(i)) ' Заполняем массив значениям углов в радианах
        funct(k) = F(Book.x(j), Book.y, zR(i))             ' Вычисляем значения функции
        Text7.Text = Text7.Text & "F (" & i & ") = " & funct(i) & vbNewLine ' Выводим результат
    Next j
    Next i
End Sub
'  Основная функция F = ( S(y) + tan(Z))*(sqr(sin(x)- E^tan(z))
Private Function F(x As Double, y As Double, z As Double) As Double
   F = (S(y) + Tan(z)) * (Sqr(Sin(x)) - E ^ Tan(z)) '
End Function
'  Вычисляем сумму ряда
Private Function S(y As Double) As Double
Dim i As Integer
S = Book.c(1)
For i = 2 To 5
    S = S + Book.c(i) * y ^ (i)
Next i
End Function
'  Переводим из градусов, минут, секунд в радианы
Private Function Radian(a As Double, b As Double, c As Double) As Double  '' a[рад] = a[°] * (Pi / 180),
    Radian = a * (pi / 180) + (b / 60) * (pi / 180) + (c / 3600) * (pi / 180) ' Перевод из градусов, минут, секунд в радианы
End Function

@kkk008009kkk · 16.04.2012, 23:07 **[ТС]**

SoftIce, Например, я ввел данные,а потом в поле исправил(букву добавил). Как сделать при помощи val, что окно вылетело "некорректный ввод значения x(y)@

Необязательно, при помощи val. Просто вроде бs с val легче всего это дело провернуть.

SoftIce · 16.04.2012, 23:30

Вот воткни в программу. Это только для иксов. Для других также сделаешь,если надо.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
' нажатие клавиши в поле
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
       'KeyPreview = True
   Select Case KeyAscii
      Case 48 To 57, 8  ' цифры 0 - 9 и <Backspace>
      ' обработка десятичного разделителя
      Case 44, 46       ' 44 - код запятой, 46 - код точки
         ' если в поле  введена запятая, то
         ' заменим ее на десятичный разделитель
         KeyAscii = 46
         ' проверим, введен ли уже в поле
         ' десятичный разделитель
         If InStr(Text1(Index).Text, ".") <> 0 Then
            KeyAscii = 0
         End If
      Case Else
         MsgBox "Значение X(" + Str(Index) + ")   некорректно" + vbCrLf + "Вводите только цифры !"
         KeyAscii = 0   ' остальные символы запрещены
   End Select
End Sub

@kkk008009kkk · 16.04.2012, 23:51 **[ТС]**

SoftIce,
Громоздко будет. А можно как-нибудь в процедуру/функцию запихнуть?

Добавлено через 3 минуты
В delphi есть функция k=StrToFloatDef(Edit22.Text,1001), которая выдает значение k=1001, если поле едит22 содержит не число.

В VB нет подобного?

Добавлено через 4 минуты

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
       'KeyPreview = True
   Select Case KeyAscii
      Case 48 To 57, 8  ' цифры 0 - 9 и <Backspace>
      ' обработка десятичного разделителя
      Case 44, 46       ' 44 - код запятой, 46 - код точки
         ' если в поле  введена запятая, то
         ' заменим ее на десятичный разделитель
         KeyAscii = 46
         ' проверим, введен ли уже в поле
         ' десятичный разделитель
         If InStr(Text1(Index).Text, ".") <> 0 Then
            KeyAscii = 0
         End If
      Case Else
         MsgBox "Значение X(" + Str(Index) + ")   некорректно" + vbCrLf + "Вводите только цифры !"
         KeyAscii = 0   ' остальные символы запрещены
   End Select
End Sub

Можно же как-то переделать в процедуру, которая бы возвращала глобальной переменной какой-нибудь е4 значение false, если нельзя,и труе, если можно?

То-есть будет вид:

Code
1
2
3
4
5
6
7
s=техт1.техт
процедура(s)
если e4 фалсе,то d=d+x
 
s=техт2.техт
процедура(s)
если e4 фалсе,то показать d=d+y

...

если d<>'' тогда показать "неверный ввод переменных",d

Добавлено через 7 минут
То-есть будет нечто такого?

А как в процедуру запихнуть?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
e4=true
'KeyPreview = True
Select Case KeyAscii
Case 48 To 57, 8 ' цифры 0 - 9 и <Backspace>
' обработка десятичного разделителя
Case 44, 46 ' 44 - код запятой, 46 - код точки
' если в поле введена запятая, то
' заменим ее на десятичный разделитель
KeyAscii = 46
' проверим, введен ли уже в поле
' десятичный разделитель
If InStr(Text1(Index).Text, ".") <> 0 Then
KeyAscii = 0
End If
Case Else
e4=false
End Select
End Sub

SoftIce · 17.04.2012, 00:01

Сообщение от kkk008009kkk

Громоздко будет

Убрал комментарии. Вроде не громоздко. Но их 6 штук должно быть. Тогда громоздко

Может IsNumeric применить? Надо подумать

Visual Basic
1
2
3
4
5
6
7
8
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
   Select Case KeyAscii
      Case 48 To 57, 8  ' цифры 0 - 9 и <Backspace>
      Case 44, 46: KeyAscii = 46
           If InStr(Text1(Index).Text, ".") <> 0 Then KeyAscii = 0
      Case Else: MsgBox "Значение X(" + Str(Index) + ")   некорректно" + vbCrLf + "Вводите только цифры !": KeyAscii = 0 ' остальные символы запрещены
   End Select
End Sub

@kkk008009kkk · 17.04.2012, 03:58 **[ТС]**

SoftIce, Нашел в интернете пример

Visual Basic
1
2
3
Dim numericCheck As Boolean
testVar = "53"
numericCheck = IsNumeric(testVar)

а как он возвратит, если неправильно?

Добавлено через 2 минуты
Сейчас попробовал проверить число. Если ввожу 15.3, то выдает false, если 15,3 то откидывает дробную часть

Добавлено через 3 часа 38 минут
Вобщем все уже сделал. Спасибо

@csa · 21.04.2012, 13:46

ох и на советовали человек наверно в шоке что за язык такой кривой
примерно такой будет "перевод" токо масивы с 0 нумеруются по умолчанию без доп опцый
соответствино либо надо указать что с 1 либо учитывать что с 0

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Type tbook
 x(5) As Double
 y As Double
 c(5) As Double
 z1(4) As Double
 z2(4) As Double
 z3(4) As Double
End Type
 
Dim book As tbook
 
Private Sub Command1_Click()
Dim mFileName As String
Dim mНомерФайла As Long
mFileName = App.Path & "\books.dat"
mНомерФайла = FreeFile
 
Open mFileName For Random As #mНомерФайла Len = Len(book)
Get #mНомерФайла, 1, book
Close #mНомерФайла
 
Cls
For i = 0 To 4
 Print book.x(i) & " - " & book.c(i)
Next i
End Sub

SoftIce · 21.04.2012, 15:22

Всё давно решено.

@kkk008009kkk · 21.04.2012, 22:23 **[ТС]**

Да, все давно решено.

Если кому-то нужен работающий проект для ознакомления, выкладываю в вложениях.

Осуществлена проверка на ОДЗ, проверка корректности введенных чисел.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@kkk008009kkk 46 / 46 / 5 Регистрация: 24.03.2011 Сообщений: 315
	16.04.2012, 21:36 [ТС]
	SoftIce, да, результаты совпали с дельфийскими, у меня там ошибка была. А как сделать вывод массива funct(k) в файл? замена Val(Replace((Text7.Text) на funct(k) не проходит 0

@kkk008009kkk 46 / 46 / 5 Регистрация: 24.03.2011 Сообщений: 315
	16.04.2012, 23:07 [ТС]
	SoftIce, Например, я ввел данные,а потом в поле исправил(букву добавил). Как сделать при помощи val, что окно вылетело "некорректный ввод значения x(y)@ Необязательно, при помощи val. Просто вроде бs с val легче всего это дело провернуть. 0

SoftIce es geht mir gut 11275 / 4761 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	21.04.2012, 15:22
	Всё давно решено. 1