0 / 0 / 0
Регистрация: 31.05.2012
Сообщений: 8

Переделать код в VBasic из Basic

22.05.2015, 15:20. Показов 531. Ответов 0
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Помогите пожалуйста перевести этот код в VBasic
QBasic/QuickBASIC
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
   NMAX%=5
   MMAX%=10
   VCN=10
    VN=10
    QM=2.1
    sigmaQ=.002
    VPMAX=22
    D2=10
    DV=23
  
  CLS
  A=2400: DELTAT=.0002:VS=VCN:A1=1680:K=296
  PRINT " (Nmax)=";NMAX%
  PRINT " (Mmax)=";MMAX%
  PRINT "  (Vц)=";VCN
  PRINT "  (Vр)=";VN
  PRINT " (Q)=";:PRINT USING"  #.#";QM
  PRINT " ";:PRINT USING"  .###";sigmaQ
  PRINT " ";VPMAX
  PRINT " (D2)="; D2
  PRINT " (Dр)="; Dv
  PRINT:PRINT
  PRINT "БУДЕТЕ МЕНЯТЬ ИСХОДНЫЕ ДАННЫЕ (Y/N)"
60 K$=INKEY$:IF LEN(K$)=0 THEN 60
   IF K$="Y" OR K$="y" THEN END
   CLS
  PI=3.141592
  M$=" M=":N$=" N=":Tsl$=" Tsl=####.####"
  Tp$="  Tp=#.#####":QPC1$=" QPC1=###.##"
  Tsl2$=" Tsl2=####.####":Tsl3$=" Tsl3=####.####":Tsl4$=" Tsl4=####.####"
  KP$=" KP=###.###":VP$=" VP=##.#": D$=" D=##.#"
   qr1$=" qr1=###.##":qc1$=" qc1=###.##"
   w$=" KC="':Tssl$=" Tssl=####.###"
avtoshema     OPEN "RES343.bas" FOR OUTPUT AS #5
55  DM=D2
    FOR M%=1 TO MMAX%:FOR N%=NMAX% TO 1 STEP -1
    CLS
    LOCATE 1,3
    IF M%<>MMAX AND N%<>NMAX THEN PRINT " M=";M%;" N=";N%
    CALL BN(PARAMETR(),M%,N%,VC,VP,DV,QPC,D,D1,DELTAD)
    CALL BN0(PARAMETR(),F,I,J%,HU,R8,KP,KC,HG,S)
    CALL PP31(PARAMETR(),D,KC,KP,HCP,QPC1,QPC,DV,P,VC,VP,HM,TS,I)
    IF HM=0 THEN T8=1200 ELSE T8=1/HM
    IF n% > 1 THEN
        IF T8=1200 THEN PRINT #5, "   "; CHR$(043); ELSE PRINT #5,USING "####.###";T8;
        GOTO 200
    END IF
    IF T8=1200 THEN PRINT #5,"   "; CHR$(043) ELSE PRINT #5,USING "####.###";T8
200
    NEXT N%:NEXT M%
    CLS
    PRINT " КОНЕЦ"
300 K$=INKEY$:IF LEN(K$)=0 THEN 300 ELSE END    
    END
 
   'ПРОЦЕДУРА BN0 1111111111111111111111111111111111111111111111
   SUB BN0(PARAMETR(1),F,I,J%,HU,R8,KP,KC,HG,S)
   SHARED TS1
   TS=TS1+.0001
   X=0:Y=0:F=1:I=1:J%=1:HU=0:R8=10000:KP=0:KC=0:HG=0:S=0
   PARAMETR(1)=X:PARAMETR(2)=Y
   END SUB'BN0
   'ПРОЦЕДУРА BN 11111111111111111111111111111111111111111111111
   SUB BN(PARAMETR(1),M%,N%,VC,VP,DV,QPC,D,D1,DELTAD)
   SHARED QM,DM,NMAX%,MMAX%,R0,VN
   SHARED VU,VS,NU,DELTAD1,DELTAD2,TS1,PI,NCH
   SHARED AA(),BB(),BB1()
   QPC=QM-QM*N%/NMAX%+QM/(2*NMAX%)
   VC=VS:VP=VN
1  D=DV-(DV-DM)*M%/MMAX%
   D=D+(DV-DM)/(2*MMAX%)
   D1=D:ZZ=D*COS(QPC):HH=D*SIN(QPC)
   PARAMETR(1)=X:PARAMETR(2)=Y
   PARAMETR(3)=ZZ:PARAMETR(4)=HH
   END SUB
 
 
    'ПРОЦЕДУРА PP31  111111111111111111111111111111111111111111111111111111
     SUB PP31(PARAMETR(1),D,KC,KP,HCP,QPC1,QPC,DV,P,VC,VP,HM,TS,I)
     SHARED HK,PI,VCMAX,VPMAX,VCB,QM,VCN,B,VU,l,CC,NCH,DELTAQ,IPK3(),IPK4()
     SHARED TS2,NMAX%,MMAX%,A,A1,AA(),BB(),BB1(),DELTAT,K,D1,DELTAD,Tp,IPK1()
     SHARED IPK(),VN,CK,N%,M%,K26(),K27(),rab(),DM,sigmaQ,qr1,qc1,Tsl,w,KR()
     SHARED qr(),qc(),Tp(),VP(),D(),QPC1()
     M$=" M=":N$=" N=": qr1$=" qr1=###.##":qc1$=" qc1=###.##"
     VP$=" VP":VC$=" VC"
     HG=0:S=0:TS=0:PI=3.1416
     N1MAX%=5:deltaKC=PI/6:kd=1:Tsl=1300
     Tp$=" Tp=###.###"
     X=PARAMETR(1):Y=PARAMETR(2)
     ZZ=PARAMETR(3):HH=PARAMETR(4)
     FOR w=0 TO 11
98   CALL BN(PARAMETR(),M%,N%,VC,VP,DV,QPC,D,D1,DELTAD)
     CALL BN0(PARAMETR(),F,I,J%,HU,R8,KP,KC,HG,S)
     km=0:kz=0:z1=0:xx=0:kn=0:i=1:fi=1
     KC=w*deltaKC:Tp=0
     CALL PP1(PARAMETR(),KP,KC,VP,VC,HCP,QPC1,D,DV,K7,I)
     IF KC=0 OR KC=PI THEN
       IF QPC <=15*PI/180 THEN Tp=.05:kz=0:Tp(w)=Tp:GOTO 150
     END IF
100   VP=VN/2:kz=1:CALL TP(D,KP,KC,HCP,VC,VP,sigmaQ,TP):kn=1
150
      IF Tp < fi*deltaT THEN'3
        fi=0:kn=0
        IF kz=0 THEN 163
        IF xx<>2 THEN
           xx=xx+1:GOTO 101
        END IF
163     IF z1=2 THEN 132
        IF KP < 2*PI/4 THEN KP=KP+K*deltaT
        IF KP >= 2*PI/4 THEN KP=2*PI/4:VP=VN:z1=z1+1
101      CALL PP1(PARAMETR(),KP,KC,VP,VC,HCP,QPC1,D,DV,K7,I)
       IF D > DV OR D < DM THEN
 
162    KR(w)=KP*180/PI:qr(w)=qr1*180/PI:qc(w)=qc1*180/PI:Tp(w)=Tp:VP(w)=VP
         rab(w)=I*deltaT: D(w)=D:GOTO 37':PRINT "Tsl1=";rab(w):GOTO 37'4
       END IF
161    IF ABS(QPC1) > QM AND ABS(QPC1) < (2*PI-QM) THEN
         KR(w)=KP*180/PI:qr(w)=qr1*180/PI:qc(w)=qc1*180/PI:Tp(w)=Tp:QPC1(w)=QPC1
         rab(w)=I*deltaT: D(w)=D:GOTO 37':PRINT "Tsl2=";rab(w):GOTO 37'5
       END IF
               I=I+1:K22=D
       IF kz=0 THEN fi=fi+1:GOTO 150
       IF kn=0 THEN 100 ELSE fi=fi+1:GOTO 150
132    KR(w)=KP*180/PI
       CALL PP1(PARAMETR(),KP,KC,VP,VC,HCP,QPC1,D,DV,K7,I)
        MM1%=1:NN1%=1
        KR(w)=KP*180/PI:qr(w)=qr1*180/PI:qc(w)=qc1*180/PI: D(w)=D
33      CALL BN1(PARAMETR(),D,VC,VP,DV,QPC,D1,NN1%,MM1%)
        CALL BN0(PARAMETR(),F,I,J%,HU,R8,KP,KC,HG,S)
        RAB1=ABS(QPC1)
        RAB2=QPC+QM/(2*NMAX%)
        RAB3=(DV-DM)/(2*MMAX%)
        IF RAB1 > PI THEN QPC1=2*PI-RAB1
130     IF (D1-RAB3) <= K22 AND K22 <=(D1+RAB3) THEN MM1%=MM1%+1:GOTO 33
131     IF QPC-(QM/(2*NMAX%)) <= RAB1 AND RAB1<=RAB2 THEN NN1%=NN1%+1:GOTO 33
              rab(w)=1200'IPK3(NN1%,MM1%)':PRINT "Tsl3=";rab(w)
              K26(w)=NN1%:K27(w)=MM1%':PRINT w;K26(w);K27(w)
              'KR(w)=KP*180/PI:qr(w)=qr1*180/PI:qc(w)=qc1*180/PI:Tp(w)=Tp:QPC1(w)=QPC1
              D(w)=D
             GOTO 37
        END IF
        GOTO 101
 37
        NEXT w
        FOR w=0 TO 11
        IF Tsl >= rab(w) THEN Tsl=rab(w)
        NEXT w
        HM=1/Tsl
 
        END SUB'PP31
 
     'ПРОЦЕДУРА PP1  111111111111111111111111111111111111111111111111111111
     SUB PP1(PARAMETR(1),KP,KC,VP,VC,HCP,QPC1,D,DV,K7,I)
     SHARED M%,N%,HK,PI,DELTAT,SHAG,QM,NMAX%,MMAX%,PD%
     X=PARAMETR(1):Y=PARAMETR(2)
     ZZ=PARAMETR(3):HH=PARAMETR(4)
    IF KP > 2*PI THEN KP=KP-2*PI
      IF KP < O THEN KP=2*PI-ABS(KP)
      IF KC > 2*PI THEN KC=KC-2*PI
      IF KC < O THEN KC=2*PI-ABS(KC)
     X=X+VP*DELTAT*COS(KP)
     Y=Y+VP*DELTAT*SIN(KP)
     ZZ=ZZ+VC*DELTAT*COS(KC)
     HH=HH+VC*DELTAT*SIN(KC)
     IF ZZ=X THEN
        PER=HH-Y
        IF PER > 0 THEN HCP=PI/2 ELSE HCP=3*PI/2
        GOTO 113
     END IF
     PER=ZZ-X
     IF PER > 0 THEN
         PER=HH-Y
         IF PER > 0 THEN
             PER=(HH-Y)/(ZZ-X)
             HCP=ATN(PER)
             GOTO 113
         END IF
          PER=(Y-HH)/(ZZ-X):HCP=2*PI-ATN(PER)
          GOTO 113
     END IF
     PER=HH-Y
     IF PER > 0 THEN
           PER=(HH-Y)/(X-ZZ):HCP=PI-ATN(PER)
           ELSE
           PER=(Y-HH)/(X-ZZ)
           HCP=PI+ATN(PER)
      END IF
113   QPC1=HCP-KP
     PER#=(ZZ-X)^2+(HH-Y)^2
     D=SQR(PER#)
     PARAMETR(1)=X:PARAMETR(2)=Y
     PARAMETR(3)=ZZ:PARAMETR(4)=HH
     END SUB'PP1
     'END
 
  '11111111111111111111111111111111111111111111111111111111111111111111111111
 
     SUB TP(D,KP,KC,HCP,VC,VP,sigmaQ,TP)
     SHARED qr1,qc1,D(),w
     PI=3.1416
     'PRINT USING " KP=##.###";KP
     IF KP<0 THEN KP=2*PI-ABS(KP)
     IF KP>2*PI THEN KP=KP-2*PI
     IF KC<0 THEN KC=2*PI-ABS(KC)
     IF KC>2*PI THEN KC=KC-2*PI
     qc1=HCP+PI-KC
     qr1=HCP-KP
     IF ABS(qc1) > PI THEN qc1=2*PI-ABS(qc1)
     IF ABS(qr1) > PI THEN qr1=2*PI-ABS(qr1)
     'PRINT "qr1=";qr1*180/pi;:PRINT "qc1=";qc1*180/pi
     BPm=VC*SIN(ABS(qc1))
     BPk=VP*SIN(ABS(qr1))
     OBP=BPm+BPk
     VIP=OBP/D: D(w)=D
     Tp=2*sigmaQ/VIP
    END SUB'TP
 
   'ПРОЦЕДУРА BN1  11111111111111111111111111111111111111111111111
   SUB BN1(PARAMETR(1),D,VC,VP,DV,QPC,D1,NN1%,MM1%)
   SHARED QM,DM,NMAX%,MMAX%,RO,VN
   SHARED VU,VS,NU,DELTAD1,DELTAD2,TS1,PI,NCH
   SHARED AA(),BB(),BB1()
   QPC=QM-QM*NN1%/NMAX%+QM/(2*NMAX%)
   IF NU=1 THEN
        VC=VU:VP=VU
        GOTO 91
   END IF
   VC=VS:VP=VN
91 D=DV-(DV-DM)*MM1%/MMAX%
   D=D+(DV-DM)/(2*MMAX%)
   D1=D:ZZ=D*COS(QPC):HH=D*SIN(QPC)
   PARAMETR(1)=X:PARAMETR(2)=Y
   PARAMETR(3)=ZZ:PARAMETR(4)=HH
   END SUB'BN1
   END
110    END
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
22.05.2015, 15:20
Ответы с готовыми решениями:

Переделать код из Visual Basic в С++
Здравствуйте, помогите пожалуйста переделать код с Visual Basic в Visual C++ Dim i As Double Dim Date0 As Date Private Sub...

Переделать код с си++ на Visual basic
Здравствуйте! У меня есть программа, создающая генератор случайных чисел, но она написана на языке си++. Помогите пожалуйста переделать в...

Переделать код vb.net на visual basic 6
Здравствуйте. Нужно переделать этот код под Visual Basic 6. Imports System.IO Public Class Form1 Dim rek As String Dim...

0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
22.05.2015, 15:20
Помогаю со студенческими работами здесь

Нужно переделать программу из Pascal в VBasic
Попросили меня сделать программу, выполнил я её на Pascal, но надо на VisualBasic. Вот программа, выполняющая подсчет десятизначных...

Не получеется переделать код из Паскаля в visual basic
program Matrix80; type matrix = array of integer; var a:matrix; Sum,M, i, j:Integer; begin Write('M: ');

Не получеется переделать код из Паскаля в visual basic
program Matrix80; type matrix = array of integer; var a:matrix; Sum,M, i, j:Integer; begin Write('M: ');

Как вернуть код из exe на VBasic 6.0 ????
Требуется, чтобы приложение .exe возвращало код в вызывающее приложение. Например, код ошибки или состояния завершения. Как это...

Нужно переделать программу Pascal в Visual Basic
Помогите, пожалуйста перевести эту программу на VBA. Я его практически не знаю Заранее благодарен Код на Паскаль: program z1; ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

Новые блоги и статьи
Отчёт о спецтехнике находящейся в ремонте
Maks 20.04.2026
Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .
Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)"
Hrethgir 19.04.2026
Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .
Запрет удаления строк ТЧ документа при определенном условии
Maks 19.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .
Модель заражения группы наркоманов
alhaos 17.04.2026
Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .
Мысли в слух. Про "навсегда".
kumehtar 16.04.2026
Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .
My Business CRM
MaGz GoLd 16.04.2026
Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .
Знаешь почему 90% людей редко бывают счастливыми?
kumehtar 14.04.2026
Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД
Maks 14.04.2026
Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru