функция Todec, вопрос по ней, когда она в программу внедрена, дает ошибку при одном определенном условии Опции

[neZvezda]

Есть функция ToDec (перевод из любой сист. счисления в 10ричную).

function ToDec(n:string; radix:longint):longint;
const
digit : string[16] = '0123456789ABCDEF';
var
m, i : longint;
begin
m:=0;
while n[1]='0' do
delete(n,1,1);

for i:=1 to length(n) do
m:=m*radix+pos(n[i],digit)-1;
ToDec:=m;
end;

По ней есть вопрос, когда она в программу внедрена. Ошибку дает, когда есть одно определенное условие.
Думаю, у знающего человека займет не более 10 минут. help

есть вектор А и Б. Состоят из единиц и двоек. Заносятся в матрицу. Для этого идет перевод в двоичную систему, все 2ки из векторов заменяются на 1, 1цы из векторов - на 0. Далее при помощи функции ToDec производится преобразование в десятичное представление.
Так вот, если имеется вектор, состоящий из единиц, 11111. Тогда при переводе в двоичное число, будет 00000. А строка программы while n[1]='0' do delete(n,1,1); из строки n удаляет один символ, начиная с первого. Если там все нули, тогда удаляет строку вобще всю! И идет ошибка в программе.
перед while надо сделать условие?
типа того

for i:= 1 to 5 do begin
   if n[i]=0 then не удалять

я так понимаю, что если все элементы вектора равны 0, тогда не удалять?
или как все это реализовать)) запуталась.

[Malice]

Тогда вот так:

Код

while (n[1]='0') and (length(n)>1) do delete(n,1,1);

[neZvezda]

Тогда вот так:

Код

while (n[1]='0') and (length(n)>1) do delete(n,1,1);

при этом условии программа ошибка не дает, но незультат ее НЕверен.
все же склоняюсь к тому, чтобы перед вайл было условие не удаления строки, если там все 0. Хотя, не знаю...

[volvo]

Ну, тогда приводи код ПРОГРАММЫ, если нужна помощь... К процедуре перевода ToDec претензий быть больше не может, она будет работать...

Вопрос теперь в том, КАК ты ее вызываешь, и что делаешь ПЕРЕД вызовом...

все же склоняюсь к тому, чтобы перед вайл было условие не удаления строки, если там все 0

А это без разницы: что '000' выдаст 0 в результате конвертации, что '0' выдаст тот же 0. А вот согласно логике твоей программы может потребоваться, чтобы '111' и '1111' выдавали разные результаты (если ты делаешь что-то типа хеша, например) - тогда такой подход в корне неверен...

Так что условие и программу - в студию

[neZvezda]

Так что условие и программу - в студию

эм..она достаточно большая, из модулей состоит.

два сюда кину, которые взаимодействую, но они большие..звиняйте

" (Показать/Скрыть)

unit uMainTestTask;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DB, ADODB, uSystem, jpeg;

type

  TfMainTestTask = class(TForm)
    Label1: TLabel;
    mQuestion: TMemo;
    rgAnswers: TRadioGroup;
    btnNext: TButton;
    Image1: TImage;
    procedure btnExitClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  Public
     Answers  : TStringList;  // Список ответов для соответствующего вопроса
     Question : TQuestion;    // Текущий вопрос


     TaskQuestions      : Array[1..9] of TQuestion; // перечень вопросов для теста
     UserResultsArray   : Array[1..9] of Byte;   // Вектор результатов
     PupilResultsArray  : Array[1..9] of Byte;
     TestResultArray    : Array[1..8] of Byte;

     QuestionCount      : Word;     // Общее количество вопросов для данного теста
     BaseQuestion       : Integer;  // "центральный" вопрос

     StepsCounter       : Byte; // текущий шаг
     ResultsCounter     : Byte;  // текущая позиция в PupilResultsArray

     LeftQuestionNo     : Byte; // текущий номер "левого" вопроса
     RightQuestonNo     : Byte; // текущий номер "правого" вопроса

     Matrix     : TMatrix;
     BaseVector : TVektor;
     i, j       : Integer;
     N,D1,D2    : integer;

     Procedure ReDraw;
     Procedure InitTaskValues;

     Function GetStrPupilArray : String;
     Function GetStrTestArray  : String;
     Function GetResult(PupilVector, TestVector : String) : Integer;

  End;

var
  fMainTestTask: TfMainTestTask;

implementation

uses uMain;

{$R *.dfm}

Procedure TfMainTestTask.InitTaskValues;
Var
  i, j     : Integer;
Begin
  QuestionCount    := 9;  // Общее количество вопросов для данного теста
  StepsCounter     := 0;
  ResultsCounter   := 0;
  BaseQuestion     := 5;
  LeftQuestionNo   := BaseQuestion - 1;  // счётчик для понижения сложности
  RightQuestonNo   := BaseQuestion + 1;  // счётчик для повышения сложности.

  Question.Chapter := fMain.ActiveChapter;
  Question.Type_   := 'Задача';

  // Первоначально создаём список вопросов со сложностями от 1 до 9
  For i := 1 to 9 do
  Begin
    GetTaskQuestion(Question, i);
    TaskQuestions[i] := Question;
  End;

  // Инициализируем констатнтный вектор
  For i := 1 to _2_N(nMax) do
    BaseVector[i] := _2_N(nMax) - i + 1;

  // Инициализируем матрицу
  For i := 1 to _2_N(nMax) do
  Begin
     For j := 1 to (_2_N(nMax) div 2) do
     Begin
        Matrix[i, j] := BaseVector[GetNumber(i, j, nMax) + 1];
     End;
  End;
  
End;

Procedure TfMainTestTask.ReDraw;
Var
  i : Word;
  QuestionPos : Integer;
Begin
   Question.Type_ := 'Задача';
   Answers        := TStringList.Create;
   QuestionPos    := BaseQuestion;  // номер выбираемого вопроса

   If BaseQuestion < 0 then  // необходимо понизить сложность ?
      Begin
         If StepsCounter <> 0 then  // если выполняем не первый раз
         Begin
           QuestionPos := LeftQuestionNo; // понижаем сложность
           Dec(LeftQuestionNo);
           PupilResultsArray[ResultsCounter] := 2;
         End;
      End
   Else
      Begin
         If StepsCounter <> 0 then
         Begin
           QuestionPos := RightQuestonNo;  // повышаем сложность
           PupilResultsArray[ResultsCounter] := 1;
           Inc(RightQuestonNo);
         End;
      End;

   Question := TaskQuestions[QuestionPos];

   GetAnswers(Question, Answers); // Выбираем ответы

   mQuestion.Text := Question.Value;
   rgAnswers.Items.Clear;

   rgAnswers.Height := 0;

   For i := 0 to Answers.Count-1 do
   Begin
      rgAnswers.Items.Add(Answers[i]);
      rgAnswers.Height := rgAnswers.Height + 35;
   End;

   Height := rgAnswers.Top + rgAnswers.Height + 50;
   rgAnswers.ItemIndex := -1;

   Answers.Free;

   If StepsCounter <> 0 then Inc(ResultsCounter);  //если выполняем не первый раз

   Inc(StepsCounter);
End;

Procedure TfMainTestTask.FormShow(Sender: TObject);
Begin
  InitTaskValues;
  ReDraw;
End;

procedure TfMainTestTask.btnExitClick(Sender: TObject);
begin
  If Application.MessageBox('Вы уверены, то хотите закончить тестирование?',
                            'Внимание',
                             MB_ICONEXCLAMATION+MB_YESNO) = idYes then
  Begin
    Close;
  End;

End;

procedure TfMainTestTask.btnNextClick(Sender: TObject);
Var
  TestVector  : String;
  PupilVector : String;
  Result,Result1      : Integer;
Begin

 If rgAnswers.ItemIndex = -1 then Application.MessageBox('Ответ не выбран!',
                                                         'Внимание',
                                                          MB_ICONEXCLAMATION+MB_OK)
 Else
   Begin
     If IsAnswerTrue(Question, rgAnswers.Items[rgAnswers.ItemIndex]) = True then
       Begin
         PupilResultsArray[ResultsCounter] := 1;
         If BaseQuestion < 0 then BaseQuestion := Abs(BaseQuestion);
       End
     Else
       Begin
         PupilResultsArray[ResultsCounter] := 2;
         BaseQuestion := -Abs(BaseQuestion);
       End;

     Inc(ResultsCounter);

     If StepsCounter >= Abs(BaseQuestion) then
       Begin
        PupilVector := GetStrPupilArray;
        TestVector  := GetStrTestArray;
        Result := GetResult(PupilVector, TestVector);

        If (Result <= 512) and (Result >= 420) then
        Begin
          ShowMessage('Результат: 5 ');
          Result1:=5;
        End;

        If (Result < 420) and (Result >= 312) then
        Begin
          ShowMessage('Результат: 4 ');
          Result1:=4;
        End;

        If (Result < 312) and (Result >= 212) then
        Begin
          ShowMessage('Результат: 3 ');
          Result1:=3;
        End;

        If (Result < 212)  then
        Begin
          ShowMessage(' Вы плохо усвоили материал, результаты вашего теста очень плохие.' + 
  ' Поэтому Вы переходите на полную форму обучения!');
          fMain.IsFullType := True;
          Result1:=2;
       End;
            //начали заносить информацию в базу данных

            With fMain.Query do
            Begin
                Close;
                SQL.Clear;
                SQL.Add('INSERT INTO Тесты ');
                SQL.Add('(КодУченика,ТипТеста,Оценка) VALUES('+IntToStr(fMain.KodUchenika)+
  ',"Задача",'+ IntToStr(Result1) +');');
                ExecSQL;
            end;
            //закончили заносить информацию в базу данных
         fMainTestTask.Close;
       End
     Else
       ReDraw;
   End;
End;

function TfMainTestTask.GetStrTestArray: String;
Var
  i : Word;
  S : String;
begin
  S := '';
  For i := 1 to 8 do
  Begin
    TestResultArray[i] := PupilResultsArray[i];
    S :=  S + IntToStr(PupilResultsArray[i]);
  End;

  GetStrTestArray := S;
end;

function TfMainTestTask.GetStrPupilArray: String;
Var
  i : Word;
  S : String;
begin
  S := '';
  For i := 1 to 9 do
  Begin
    S :=  S + IntToStr(PupilResultsArray[i]);
  End;

   GetStrPupilArray := S;
end;

function TfMainTestTask.GetResult(PupilVector,
  TestVector: String): Integer;
Var
  X, Y : Word;
  i    : Integer;
begin
  For i := 1 to 9 do
  Begin
    If PupilVector[i] = '2' then
      PupilVector[i] := '1'
    Else
      PupilVector[i] := '0';
  End;

  For i := 1 to 8 do
  Begin
    If TestVector[i] = '2' then
      TestVector[i] := '1'
    Else
      TestVector[i] := '1';
  End;

  X := ToDec(PupilVector, 2);
  Y := ToDec(TestVector, 2);

  GetResult := Matrix[X, Y];
end;

End.

и второй модуль, кусочек

" (Показать/Скрыть)

Unit uSystem;

Interface

Uses SysUtils, Classes, DB, ADODB;

Const
   nMax = 9;

Type
   TMatrix = array [ 1..512, 1..256 ] of Integer;

   TVektor = array [ 1..512 ]         of Integer;

  Function GetTaskQuestion(Var Question : TQuestion; Level : Byte) : Boolean;

  Function _2_N ( N : Integer ) : Integer;
  Function Bit( X : Integer;  N : Integer ) : Integer;
  Function Vektor( X, N : Integer ) : String;
  Function GetNumber ( n1, n2, n : Integer ) : Integer;
  function ToDec(n:string; radix:longint):longint;

Implementation

uses uMain;

Var
  i, QuestionNo, QuestionsCount : Word;


Function GetTaskQuestion(Var Question : TQuestion; Level : Byte) : Boolean;
Var
  i, QuestionNo, QuestionsCount : Word;
Begin
  // Получаем список всех вопросов главы Question.Chapters
  With fMain.Query do
  Begin
     Close;
     SQL.Clear;
     SQL.Add(' SELECT * ');
     SQL.Add(' FROM Вопросы ');
     SQL.Add(' WHERE КодГлавы   = '  + IntToStr(Question.Chapter.Key) + '  ');
     SQL.Add('   AND Тип        = "Задача" ');
     SQL.Add('   AND Сложность  = "'  + IntToStr(Level)       + '" ');
     SQL.Add(' ORDER BY Вопрос ');

     Open;

     If IsEmpty then
     Begin
        GetTaskQuestion := False;
        Exit;
     End;

     // Получаем количество вопросов для данной главы
     QuestionsCount := 0;
     First;
     While Not EOF do
     Begin
       Inc(QuestionsCount);
       Next;
     End;

     // Случайным образом выбираем вопрос
     Randomize;
     QuestionNo := Random(QuestionsCount) + 1;

     // Переходим на запись QuestionNo
     First;
     For i := 1 to QuestionNo do Next;

     Question.Key   := FieldByName('КодВопроса').AsInteger;
     Question.Value := FieldByName('Вопрос').AsString;
  End;

  GetTaskQuestion := True;
End;

Function _2_N ( N : Integer ) : Integer;
Begin
  _2_N := 1 shl n;  
End;

Function Bit( X : Integer;  N : Integer ) : Integer;
Var
   B : Integer;
Begin
  B := 1 shl (n-1);
  Bit := 0;

  If (X and B) <> 0 then
    Bit:=1;
End;

Function Vektor( X, N : Integer ) : String;
Var
  I : Integer;
  S : String;
Begin
  S := '( ';

  For i := 1 to n do
  Begin
     If Bit(X, N - i + 1 ) = 0 then
       S := S + '1, '
     Else
       S := S + '2, ';
  End;

  S[ Length(S) - 1 ] := ' ';
  S[ Length(S)     ] := ')';

  Vektor := S;
End;

Function GetNumber ( n1, n2, n : Integer ) : Integer;
var
  i, k, rez : integer;
Begin
  k := Bit(n1,n);
  Rez:=k shl (n-1);

  For i := n - 1 downto 1 do
  Begin
    If (i and 1) = 0 then
    Begin
      k   := Bit(n2 shl k,i);
      Rez := Rez or (k shl (i-1));
    End
    Else
    Begin
       k   := Bit(n1 shl k,i+1);
       Rez := rez or (k shl (i-1));
    End;
  End;
  GetNumber := Rez;
End;

function ToDec(n:string; radix:longint):longint; // перевод двоичного в десятичное
const
  digit : string[16] = '0123456789ABCDEF';
var
  m, i       : longint;
begin
  m:=0;
  while n[1]='0' do
     delete(n,1,1); 
  for i:=1 to length(n) do
      m:=m*radix+pos(n[i],digit)-1;
      ToDec:=m;
end;

End.

[volvo]

Первое, что бросилось в глаза -

  For i := 1 to 8 do
  Begin
    If TestVector[i] = '2' then
      TestVector[i] := '1'
    Else
      TestVector[i] := '1'; // Уверена, что не TestVector[i] := '0' ?
  End;

А в остальном - присоедини архив с программой (только без EXE ), так сложно что-то говорить. Надо видеть всю программу, а не ее куски.

[how long does prednisolone take]

Levitra 20 Mg 30 Tablet

[cheapest prices for viagra onlin]

Comprar Viagra En Tenerife

[nishaknapp]

Why not settling on games that is fun and at the same time your earning. Well it'll make suspense because the game is well but dude just try it and it gave me hope while pandemic is real rn. Online Casino Gaming Best Practices

[povekag860]

Мне кажется, прямо сейчас выгоднее играть в более популярные игровые автоматы на площадке казино Покердом по ссылке pokerdom12.top, сегодня можно играть легко и с уникальным преимуществом, который вы можете найти сразу. Также PokerDom Casino считается полностью позволяет вам играть в удивительные игровые автоматы и слоты, призы и деньги с возможностью хорошо провести время.

[likeinsomnia]

Приготуйтеся до захоплюючого шляху в світ найкращих азартних розваг – це час розкрити таємниці ТОП ігрових автоматів України! Тут, серед ексклюзивних ігор, ви знайдете справжню перлину азартного світу, яка завоювала симпатії гравців. Топ ігрових автоматів України https://jk-yagoda.com.ua/ – це не просто гри, це емоційний вибух та безмежні можливості виграти великі призи. Відкрийте для себе неповторний досвід гри в ігрові автомати, де кожен спін - це крок до захоплюючих виграшів.