Форум «Всё о Паскале» _ Делфи _ функция Todec, вопрос по ней, когда она в программу внедрена
Автор: neZvezda 19.05.2006 0:45
Есть функция 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 19.05.2006 0:57
Тогда вот так:
Код
while (n[1]='0') and (length(n)>1) do delete(n,1,1);
Автор: neZvezda 19.05.2006 1:08
Цитата(Malice @ 18.05.2006 20:57)
Тогда вот так:
Код
while (n[1]='0') and (length(n)>1) do delete(n,1,1);
при этом условии программа ошибка не дает, но незультат ее НЕверен. все же склоняюсь к тому, чтобы перед вайл было условие не удаления строки, если там все 0. Хотя, не знаю...
Автор: volvo 19.05.2006 1:20
Ну, тогда приводи код ПРОГРАММЫ, если нужна помощь... К процедуре перевода ToDec претензий быть больше не может, она будет работать...
Вопрос теперь в том, КАК ты ее вызываешь, и что делаешь ПЕРЕД вызовом...
Цитата
все же склоняюсь к тому, чтобы перед вайл было условие не удаления строки, если там все 0
А это без разницы: что '000' выдаст 0 в результате конвертации, что '0' выдаст тот же 0. А вот согласно логике твоей программы может потребоваться, чтобы '111' и '1111' выдавали разные результаты (если ты делаешь что-то типа хеша, например) - тогда такой подход в корне неверен...
Так что условие и программу - в студию
Автор: neZvezda 19.05.2006 1:36
Цитата(volvo @ 18.05.2006 21:20)
Так что условие и программу - в студию
эм..она достаточно большая, из модулей состоит.
два сюда кину, которые взаимодействую, но они большие..звиняйте
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; // текущий номер "правого" вопроса
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; // счётчик для повышения сложности.
// Первоначально создаём список вопросов со сложностями от 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;
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;
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 19.05.2006 3:46
Первое, что бросилось в глаза -
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 7.10.2021 7:37
Levitra 20 Mg 30 Tablet
Автор: cheapest prices for viagra onlin 13.11.2021 23:57
Comprar Viagra En Tenerife
Автор: nishaknapp 16.01.2023 6:38
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. https://newsportsweb.com/online-casino-gaming-best-practices/
Автор: povekag860 29.08.2023 19:20
Мне кажется, прямо сейчас выгоднее играть в более популярные игровые автоматы на площадке казино Покердом по ссылке https://pokerdom12.top/, сегодня можно играть легко и с уникальным преимуществом, который вы можете найти сразу. Также PokerDom Casino считается полностью позволяет вам играть в удивительные игровые автоматы и слоты, призы и деньги с возможностью хорошо провести время.
Автор: likeinsomnia 4.02.2024 22:21
Приготуйтеся до захоплюючого шляху в світ найкращих азартних розваг – це час розкрити таємниці ТОП ігрових автоматів України! Тут, серед ексклюзивних ігор, ви знайдете справжню перлину азартного світу, яка завоювала симпатії гравців. Топ ігрових автоматів України https://jk-yagoda.com.ua/ – це не просто гри, це емоційний вибух та безмежні можливості виграти великі призи. Відкрийте для себе неповторний досвід гри в ігрові автомати, де кожен спін - це крок до захоплюючих виграшів.