[Discoeggplant]

у меня есть код программы, реализующей тест на определение темперамента. в ходе программы она считает баллы полученные от пользователя путем нажатия кнопок да и нет, записывает в список pts. также у нас есть список ключей, в которых 3 части разделенные знаком =: в первой название шкалы оценивания, во второй номера вопросов на которые если пользователь отвечает да, то получает балл, в третьей части то же самое но для вопросов с ответом нет. все это записано в 3 строки - 3 параметра оценивания(шкалы). функция ots(i) возвращает 3 строки, как и переменная l в которой записано количество баллов по каждой шкале, то есть 3 строки, 3 разных числа баллов, которые получаются в ходе цикла. и мне необходимо сделать ,чтобы вот это самое количество баллов хранилось еще в разных переменных, разделить как то эти 3 числа, чтобы они не выводились поочереди(например если в showmessage загнать l, то мне последовательно выдается 3 числа, но мне нужно чтобы хотя бы в одну строку 3 числа были, а лучше вообще отдельно ) для того, чтобы в дальнейшем прописать условия для выдачи пользователю не только количество баллов отдельно по критериям(шкалам), но и сам тип, зависящий от количества баллов по первой, по второй и третьей шкале(в списке ключа первая, вторая и третья строки соответственно)

Код:

function TForm1.ots(vs: integer): string;
var
str,c,p,o,v: string;
    
    

nsm   : array[0..3] of string; // Хранилище лексем строки ключа
// 0 - Название шкалы
// 1 - перечень вопросов с ответом "Да"
// 2 - -//-              с ответом "Нет"
// 3 - множитель "Грубо"
aaa : array[0..2] of integer;

i,l,b,g,y : integer;
flg :boolean;
begin
str:= kvs.Strings[vs];  // Строка ключа
l:= 0;
b:=0;
flg:= true;

for i:=1 to Length(str) do
begin
if str[i] = '=' then  // пойман разделитель
begin
inc(l);
//inc(b); // Заполнить следующую лексему
flg:= false;
end;
if flg then nsm[l] := nsm[l] + str[i];
if not flg then flg:= true;
end;

// Проверка ответов "Да"
str:= nsm[1] + ' ' + nsm[2]; // перечень заданий с критерием ключа
v:= '';
flg:= true;
l:= 0; // счётчик ответов подходящих по критерию ключа (набранных баллов)
for i:=1 to Length(str) do  //считываем номер задания для проверки
begin
if str[i] = ' ' then flg:= false;
if flg then v:= v + str[i];
if not flg then  // если номер есть
begin
flg:= true;
// и на него был дан ответ "Да", то увеличиваем счетчик баллов на единицу
if StrToIntDef(pts.Strings[StrToInt(v)-1], 0) = 1 then
inc(l);
v:='';  // Подготовка к следующей итерации цикла
end;
if (i=length(str)) and (v <> '') then // достигнут конец строки
if StrToIntDef(pts.Strings[StrToInt(v)-1], 0) = 1 then
inc(l); // окончательная проверка
//inc(b);
end;

str:= nsm[2]; //  Проверка ответов "Нет", тоже самое
if length(str) > 0 then  // Если есть номера для проверки
begin
v:='';
flg:= true;
for i:=1 to Length(str) do
begin
if str[i] = ' ' then flg:= false;
if flg then v:= v + str[i];
if not flg then
begin
flg:= true;
if StrToIntDef(pts.Strings[StrToInt(v)-1], 0) = 2 then inc(l);
v:= '';
end;
if (i = length(str)) and (v <> '') then
if StrToIntDef(pts.Strings[StrToInt(v)-1], 0) = 2 then inc(l);
end;
end;
l:= l * StrToIntDef(nsm[3], 0); // умножаем набранные баллы на множитель

if l > 0 then Result:= nsm[0] + ' - баллов: ' + IntToStr(l) else
Result:= nsm[0] + ' - баллов: нет';
end;



end.

[xchgeaxeax]

Попробуйте переделать этот код используя массив из структур подобного типа:

Код:

type
  TRecord = packed record
    question: String; // Строка с вопросом
    answer: Boolean; // Ответ на вопрос: True = Да / False = Нет
  end;
  TArray = array of TRecord; // Определяем тип для задания массива. Так массив можно будет передать через параметры в процедуру подсчёта

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

[Shaft]

Не уверен что я все правильно понял

[xchgeaxeax]

Не знаю что вы там поменяли. Я вам говорил про другое. Сейчас вы загружаете данные в два разных списка и предполагаете, что они будут синхронизированы по индексам. Но что, если из одного файла удалят одну строку, а из второго другую (с разными индексами). Тогда все ваши данные станут не верными. Я же вам сказал Загрузить данные в связанные структуры в памяти. Т.е. сделайте так:

Код:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls;

type
  TResults = packed record
    question: String;
    answer: Boolean;
    user_ans: LongInt;
  end;
  TQWSArray = array of TResults;

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Memo1: TMemo;
    procedure BitBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    qws: TQWSArray;
    idx: LongInt;
    procedure GetResults();
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
const
  qwsFileName = 'qws.txt';
var
  tmp: TStringList;
  i: LongInt;
begin
  tmp := TStringList.Create;
  if FileExists(qwsFileName) then
    tmp.LoadFromFile(qwsFileName);
  SetLength(qws, tmp.Count);
  for i := 0 to tmp.Count - 1 do with qws[i + Low(qws)] do begin
    question := copy(tmp[i], 2, Length(tmp[i]));
    answer   := tmp[i][1] = '1';
    user_ans := -1;
  end;
  tmp.Free;
  if Length(qws) > 0 then begin
    idx := Low(qws);
    Memo1.Text := qws[idx].question;
  end else
    GetResults();
end;

procedure TForm1.BitBtnClick(Sender: TObject);
var
  answer: Boolean;
begin
  answer := (Sender as TBitBtn).Tag = 1;
  if answer = qws[idx].answer then
    qws[idx].user_ans := 1
  else
    qws[idx].user_ans := 0;
  inc(idx);
  if idx <= High(qws) then
    Memo1.Text := qws[idx].question
  else
    GetResults;
end;

procedure TForm1.GetResults;
const
  ansFileName = 'ans.txt';
var
  i, c: LongInt;
  tmp: TStringList;
begin
  c := 0;
  BitBtn1.Visible := False;
  BitBtn2.Visible := False;
  Memo1.Clear;
  Memo1.Lines.Add('Результаты:');
  for i := Low(qws) to High(qws) do begin
    case qws[i].user_ans of
      1: Memo1.Lines.Add(qws[i].question + ' Ответ: Да');
      0: Memo1.Lines.Add(qws[i].question + ' Ответ: Нет');
    else
      Memo1.Clear;
      Memo1.Lines.Add('Ошибка в результатах теста');
      Exit;
    end;
    c := c + qws[i].user_ans;
  end;
  tmp := TStringList.Create;
  if FileExists(ansFileName) then begin
    tmp.LoadFromFile(ansFileName);
    if c < tmp.Count then
      Memo1.Lines.Add(tmp[c])
    else
      Memo1.Lines.Add('Результат не определен!');
  end;
  tmp.Free;
end;

end.

Как-то так. Теперь ошибка если и будет, то только в результатах подсчёта баллов, но зная точную цифру его можно поправить. И не получится ошибиться в сопоставлении строк в разных файлах т.к. и вопросы и ответы сохранены в одном файле. Но вопрос начинающийся с символа отличного от 1 будет требовать ответа "Нет", а с 1 в начале - "Да". Но эти символы анализируются один раз при загрузке данных из файла в память и попадают в отдельную переменную (поле структуры) до того, как пользователь ответит на вопрос. При этом переменная с ответами на вопросы от пользователя изначально содержит значение -1, но при прохождении того или иного вопроса получает значение 0 или 1. Дальше они просто суммируются и результат уже выбирается из файла, в котором перечислены строки с ответами на разное число очков. Это можно упростить, если добавить к ответам описания диапазонов. Но это уже сделаете сами.

[Shaft]

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

Я вам говорил про другое.

Это не я тс

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

Не знаю что вы там поменяли

Я только добавил переменные для хранения значений l как названии темы написано

[xchgeaxeax]

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

Это не я тс

Извините. Не обратил внимания на ники.

Но я все же считаю, что эту программу лучше переписать и избавиться от ненужной работы со строками в таком количестве. Надо собрать связные данные в структурах, а не разбрасывать их по разным объектам. Ещё и в коде нет контроля индексов. Т.е. если вы анализируете связанные данные, тогда не надо создавать несколько последовательных одинаковых циклов.