Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Клуб программистов > Свободное общение
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.05.2010, 21:35   #1
Mixasik
New Delphi Coder
Форумчанин Подтвердите свой е-майл
 
Аватар для Mixasik
 
Регистрация: 20.07.2008
Сообщений: 874
По умолчанию Переписать программу с Qbasic на Delphi[переписал - считает не верно]

Код:
   REM ва**бЇ®ав**п §*¤*з*
2  IF PEEK(68) = 18 AND PEEK(67) = 1 GOTO 8
3  REM pr = 5
4  POKE 67, 1: POKE 68, 18: POKE 1800, 0
6  PRINT CHR$(4); "run kes"
8  text = 2: REM text =34
17 REM PRINT CHR$(4)
   REM   OPEN "c:/qbasic/imitac.txt" FOR OUTPUT AS #1
   INPUT "‚ўҐ¤ЁвҐ Ё¬п д*©«*"; filename$
   OPEN "t:/qbasic/" + filename$ + ".txt" FOR OUTPUT AS #1
18 REM PRINT CHR$(4):  "Write"; A$

19 'метод Джонсона (задача 2-х станков)
20 DIM n(100), A(100), B(100), n1(100), A1(100), B1(100)
30 INPUT "Введите число деталей"; num
40 PRINT "Введите через запятую номер детали и время ее обработки    на ст1, время обработки на ст2"
50  FOR i = 1 TO num
60 INPUT n(i), A(i), B(i)
70 NEXT i
80
85 'печать исходных данных
90 PRINT #1, "число деталей N="; num
92 PRINT #1, "№ детали станок1 станок2"
94  FOR i = 1 TO num
96 PRINT #1, n(i), A(i), B(i)
98 NEXT i
100
110 'формирование двух массивов деталей (первый -R1,второй -R2)
130 i = 0: k = 0: REM k при a(j)<=b(j) - R1, i  при a(j)>b(j) - R2
140 FOR j = 1 TO num
150 IF A(j) <= B(j) THEN 190
160 k = k + 1
170 n(k) = n(j): A(k) = A(j): B(k) = B(j)
175 REM print #1, "170 к 210: i, k, j, N, a(j), b(j), n(k), n(j), A(k), A(j), B(k), B(j)", i; k; j; N; a(j); b(j); n(k); n(j); A(k); A(j); B(k); B(j)
180 GOTO 205
190 i = i + 1
200 n1(i) = n(j): A1(i) = A(j): B1(i) = B(j)
203 REM print #1, "190 из 150 при a(j)<=b(j): i, j, N1(i), N(j), A1(i), A(j), B1(i), B(j)", i; j; N1(i); N(j); A1(i); A(j); B1(i); B(j)
205 REM print #1, "210: i, k, j, N, a(j), b(j), n(k), n(j), A(k), A(j), B(k), B(j), N1(i), N(j), A1(i), A(j), B1(i), B(j)", i; k; j; N; a(j); b(j); n(k); n(j); A(k); A(j); B(k); B(j); N1(i); N(j); A1(i); A(j); B1(i); B(j)
210 NEXT j
220 'упорядочивание деталей R1 в порядке возрастания A(j)
410 IF k1 <= 1 THEN 580
420 k1 = 1
430 k1 = k1 * 2
440 IF k1 < k THEN 430
450 k1 = k1 / 2
460 IF k1 < 1 THEN 580
470 m = k1: k = k1
480 FOR q = 1 TO m
490 j = q
500 l = j + k1
510 IF B(l) < B(j) THEN 560
520 SWAP B(j), B(l)
530 SWAP n(j), n(l)
540 j = j - k1
550 IF j > 0 THEN 500
560 NEXT q
570 GOTO 450
580 'выдача результатов оптимальной последовательности деталей
582 FOR jj = 1 TO i
584 REM print #1, "jj, i, n1(jj), n(jj), A1(jj), A(jj), B1(jj), B(jj)", jj; i; n1(jj); n(jj); A1(jj); A(jj); B1(jj); B(jj)
586 NEXT jj
590 PRINT #1, "оптимальная последовательность"
595 REM print #1, "i, k="; i, k
600 IF i = 0 THEN 650
605 REM print #1, "j; i; n1(j); A1(j); A(j); B1(j); B(j)"; j; i; n1(j); A1(j); A(j); B1(j); B(j)
610 FOR j = 1 TO i
620 REM print #1, "j; i; n1(j); A1(j); A(j); B1(j); B(j)"; j; i; n1(j); A1(j); A(j); B1(j); B(j)
625 REM print #1, "j, i, n1(j); A1(j); B1(j)"; j; i; n1(j); A1(j); B1(j)
630 NEXT j
640 IF k = 0 THEN 680
650 FOR j = 1 TO k
653 REM print #1, "j; k; n(j); n1(j); A1(j); A(j); B1(j); B(j)"; j; k; n(j); n1(j); A1(j); A(j); B1(j); B(j)
656 REM print #1, "j, k, n(j); n1(j); A1(j); B1(j)"; j; k; n(j); n1(j); A1(j); B1(j)
660 REM print #1, "j, k, n(j)"; j, k, n(j)
670 NEXT j
680
690 REM print #1, "упорядочение деталей на станке 1"
695 nn = i - 1
700 FOR ii = 1 TO nn
705 i1 = ii + 1
710 FOR j1 = i1 TO i
715 IF A1(ii) <= A1(j1) THEN 735
720 p1 = A1(ii): np = n1(ii): p2 = B1(ii)
725 A1(ii) = A1(j1): n1(ii) = n1(j1): B1(ii) = B1(j1)
730 A1(j1) = p1: n1(j1) = np: B1(j1) = p2
735 NEXT j1
740 NEXT ii
745 REM print #1, "на станке 1 детали упорядочены"
747 PRINT #1, "позиция    № детали  станок 1  станок 2"
750 FOR j = 1 TO i
755 REM print #1, "j,  i, n1(j); A1(j); B1(j)"; j; i; n1(j); A1(j); B1(j)
758 PRINT #1, j, n1(j), A1(j), B1(j)
760 NEXT j

780
790 REM print #1, "упорядочение деталей на станке 2"
795 nn = k - 1
800 FOR ii = 1 TO nn
805 i1 = ii + 1
810 FOR j1 = i1 TO k
815 IF B(ii) >= B(j1) THEN 835
820 p1 = B(ii): np = n(ii): p2 = A(ii)
825 B(ii) = B(j1): n(ii) = n(j1): A(ii) = A(j1)
830 B(j1) = p1: n(j1) = np: A(j1) = p2
835 NEXT j1
840 NEXT ii
845 REM print #1, "на станке 1 детали упорядочены"
847 REM print #1, "позиция    № детали  станок 1  станок 2"
850 FOR j = 1 TO k
852 jk = j + i
853 REM print #1, "j, k, n(j); A(j); B(j)"; j; i; n(j); A(j); B(j)
855 PRINT #1, jk, n(j), A(j), B(j)
860 NEXT j

900 END
Добрый вечер. Мне необходимо переписать программу для выбора оптимальной последовательности деталей на 2-х станках на Delphi. Я вроде бы пиреписал, но работает не верно. Поэтому решил попросить помощи, ошибка как мне кажется там где начинаются игры с переменной k1 - я не пойму откуда ее берут и с чем сравнивают. Тоесть понял, но кажется она во всех случаях будет <=1 так что я это просто опустил.
Подскажите в чем дело, если не трудно.
Вот листинг на Delphi(то что я написал):
Не уместилось в одном посте - перенес во второй.
Страх это слабость и потому, кто испугался уже побежден.
Mixasik вне форума Ответить с цитированием
Старый 19.05.2010, 21:36   #2
Mixasik
New Delphi Coder
Форумчанин Подтвердите свой е-майл
 
Аватар для Mixasik
 
Регистрация: 20.07.2008
Сообщений: 874
По умолчанию

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  i, k, j : word;
  nn, j1, i1, iq, ii, p1, np, p2, jk : word;
begin
setlength(n, dnums+1);
setlength(A, dnums+1);
setlength(B, dnums+1);
setlength(n1, dnums+1);
setlength(A1, dnums+1);
setlength(B1, dnums+1);
// Вкачали данные в массивы
for I := 1 to dnums do
  begin
    n[i] := strtoint(stringgrid1.Cells[0,i]);
    A[i] := strtoint(stringgrid1.Cells[1,i]);
    B[i] := strtoint(stringgrid1.Cells[2,i]);
  end;
// вывод исходных данных
for j := 1 to dnums do begin
  stringgrid2.Cells[0,j] := inttostr(n[j]);
  stringgrid2.Cells[1,j] := inttostr(A[j]);
  stringgrid2.Cells[2,j] := inttostr(B[j]);
end;
// Формируем вторую пару массивов
i := 0; k := 0;
for j := 1 to dnums do begin
  if A[j] <= B[j] then
    begin
      inc(i);
      n1[i] := n[j]; A1[i] := A[j]; B1[i] := B[j];
    end else
      begin
        inc(k);
        n[k] := n[j]; A[k] := A[j]; B[k] := B[j];
      end;
// Вывод чего то там
end; // Конец цикла
nn := i - 1;
for ii := 1 to nn do
  begin
    i1 := ii +1;
    for j1 := i1 to i do
      begin
        if A1[ii] > A1[j] then
          begin
            p1 := A1[ii]; np := n1[ii]; p2 := B1[ii];
            A1[ii] := A1[j1]; n1[ii] := n1[j1]; B1[ii] := B1[j1];
            A1[j1] := p1; n1[j1] := np; B1[j1] := p2;
          end;
      end;
  end;
for j := 1 to i do begin
  stringgrid3.Cells[0,j] := inttostr(j);
  stringgrid3.Cells[1,j] := inttostr(n1[j]);
  stringgrid3.Cells[2,j] := inttostr(A1[j]);
  stringgrid3.Cells[3,j] := inttostr(B1[j]);
end;
// Второй станок
nn := k - 1;
for ii := 1 to nn do
  begin
    i1 := ii +1;
    for j1 := i1 to k do
      begin
        if A[ii] < B[j1] then
          begin
            p1 := B[j1]; np := n[j1]; p2 := A[ii];
            B[ii] := B[j1]; n[ii] := n[j1]; A[ii] := A[j1];
            B[j1] := p1; n[j1] := np; A[j1] := p2;
          end;
      end;
  end;
for j := 1 to k do begin
jk := j+1;
  stringgrid3.Cells[0,j] := inttostr(jk);
  stringgrid3.Cells[1,j] := inttostr(n[j]);
  stringgrid3.Cells[2,j] := inttostr(A[j]);
  stringgrid3.Cells[3,j] := inttostr(B[j]);
end;
Страх это слабость и потому, кто испугался уже побежден.
Mixasik вне форума Ответить с цитированием
Старый 20.05.2010, 17:07   #3
Mixasik
New Delphi Coder
Форумчанин Подтвердите свой е-майл
 
Аватар для Mixasik
 
Регистрация: 20.07.2008
Сообщений: 874
По умолчанию

Хотя бы подскажите верно то что на строке
Код:
410 IF k1 <= 1 THEN 580
я сразу перепрыгиваю на 580 и иду оттуда.
Страх это слабость и потому, кто испугался уже побежден.
Mixasik вне форума Ответить с цитированием
Старый 20.05.2010, 17:54   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Код:
я сразу перепрыгиваю на 580 и иду оттуда.
По-моему goto нужно дописать...
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 20.05.2010, 18:33   #5
Mixasik
New Delphi Coder
Форумчанин Подтвердите свой е-майл
 
Аватар для Mixasik
 
Регистрация: 20.07.2008
Сообщений: 874
По умолчанию

Та программа не моя, и она работает, не знаю почему))) Это вроде даже не qbasic а просто basic и как в fortran после if видимо можно не писать goto. Но дело в том как переменная л1 вводится и чему равна. Возникает вопрос имею ли я право просто взять при переписывании под Delphi просто проигнорировать блок до метки 580
Страх это слабость и потому, кто испугался уже побежден.
Mixasik вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно переписать программу с pascal на С++ ALiKa ALiK Помощь студентам 2 02.05.2010 22:01
переписать программу с VB на delphi qpush Помощь студентам 1 21.04.2010 23:57
Нужно переписать программу из C++ в Delphi - Кто поможет?! Sanyo Общие вопросы C/C++ 2 07.12.2009 13:31
Как проверить, верно ли считает программа? Mixim Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 1 05.12.2009 07:14
Переписать программу с использованием функций, С++ Vikylik Помощь студентам 2 09.04.2009 10:39