Парсинг и калькуляция в Мемо

TEKTON · #1 26.07.2018, 17:38

Есть список в listBox с наименованием параметров.
типо

Код:

Право
Лево
Вверх
В низ
Вперёд
Назад
...

Параметро 30.
Но сразу все они не используются.
В Мемо может оказаться один, а других 5-10 не будет.
В следующий раз наоборот.

Есть мемо с кучей строк типа

Код:

------ ##### ------

Право --- 15 %
Лево --- 21 %
Право --- 21 %
Вперёд --- 0 %

------ №№№№ ------
------******* ------
------ №№№№ ------

Вверх --- 2 %
Право --- 4 %
Назад --- 0 %
Лево --- 6 %
В низ --- 5 %
Право --- 0 %

Как это дело спарсить что б в результате получилось так:

Код:

------ ##### ------

Право --- 15 %
Лево --- 21 %
Право --- 21 %
Вперёд --- 1 %

------ №№№№ ------
------******* ------
------ №№№№ ------

Вверх --- 2,2 %
Право --- 4 %
Назад --- 0 %
Лево --- 6 %
В низ --- 5 %
Право --- 0 %

------ Итог: -----
Право --- 40 %
Лево --- 27 %
Вперёд --- 1 %
Вверх --- 2,2 %
В низ --- 5 %

Тоесть что б все проценты с одинаковыми параметрами суммировались и в итог попали только параметры с положительным процентом.
Проценты могут быть числом с запятой.
Итог надо записать в конец мемо.

Думаю надо сделать типо двух циклов.
Что б первый подставлял в переменную значение строки из списка,
Второй пробегал по всему Мемо и искал строки с этим значением.

Если б делал одно значение, было б типа такого:

Код:

 {################## Функция парсинга ################}
function Pars(T_, ForS, _T: string): string;
var a, b:integer;
begin
Result := '';
if (T_='') or (ForS='') or (_T='') then Exit;
a:=Pos(T_, ForS);
if a=0 then Exit else a:=a+Length(T_);
ForS:=Copy(ForS, a, Length(ForS)-a+1);
b:=Pos(_T, ForS);
if b>0 then
Result:=Copy(ForS, 1, b - 1);
end;

{----------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
var
I:integer;
S: string;
bonus1:real; // Право

begin
S:=memo1.Text;

For I:=0 to Memo1.Lines.Count-1 do   
   begin
	    If pos('Право --- ',S)<>0 then 
    Begin
        bonus1:=bonus1+StrToFloat(pars('Право ---', s, ' %'));
    End;
    End;

memo1.lines.Add('');
memo1.lines.Add('--- Итог: ---');
memo1.lines.Add('');
memo1.lines.Add('Право --- '+ FloatToStr(bonus1)+' %');
end;

Но в listBox 30 значений лежит.
Можно конечно 30 проверок налепить, но хочется по нормальному сделать в цикле.
Наверно надо как то через два цикла делать.
Что б первый подставлял из listBox значения, а второй пробегался по всему Мемо и парсил то что нужно.

Что б вместо

Код:

 ...
If pos('Право --- ',S)<>0 then ...

подставлялось типа

Код:

 ...
If pos(listBox1.Items.Strings[b]+' --- ',S)<>0 then ...

И ещё вопрос:
Есть несколько переменных, a1, a1, a2, a3, a4, a5:string;
можно ли им присваивать индексы в цикле ?
что б типа такого получилось:

Var
i:integer;
a1, a1, a2, a3, a4, a5:string;

Begin

For i:=0 to Memo1.Lines.Count-1 do
begin
If pos('123',Memo1.Lines.Strings[i])<>0 then
Begin
a[i]:=Memo1.Lines.Strings[i];
end;
end;
end;

Спасибо.

lmikle · #2 26.07.2018, 21:35

Заводишь массив для подсчета значения параметра.
Далее ползешь по мемо, для каждой строки выделяешь нужный параметр и суммируешь в массиве. Далее просто вывод. Как-то так:

Код:

var
  P : Array Of Double;
  I, pIdx : Integer;
  pName : String;
  pVal : Double;
begin
  SetLength(P,ListBox1.Items.Count);
  For I := Low(P) To High(P) Do P[i] := 0; // just in case
  For I := 0 To Memo1.Lines.Count-1 Do
  Begin
    ExtractParamNameFromLine(Memo1.Lines[i],pName,pVal);
    If pName <> '' Then
      Begin
        pIdx := ListBox1.Items.IndexOf(pName);
        If pIdx > -1 Then P[pIdx] := P[pIdx] + pVal;
      End;
  End;

  // Print to memo
  Memo1.Lines.Add('--- Итог: ---');
  For I := Low(P) To High(P) Do
    If P[i] > 0 Then Memo1.Lines.Add(ListBox1.Items[i] + ' --- '+ FloatToStr(P[i]) + ' %');
end;

Ну, процедуру ExtractParamNameFromLine думаю сам напишешь.
Декларация:

Код:

procedure ExtractParamNameFromLine(S : String; var AName : String; var AVal : Double);

Смысл - из переданной строки S она выбирает в AName имя параметра, а в AVal - его значение.

TEKTON · #3 27.07.2018, 00:01

lmikle, спасибо.

Цитата:

Ну, процедуру ExtractParamNameFromLine думаю сам напишешь.

Неа.

Чёт я буксую с этой procedure ExtractParamNameFromLine

В первом цикле получаем длинну ListBox
Во втором пробегаем по Memo

ExtractParamNameFromLine - Парсит название параметра и %

Если параметр (pName) не равен нулю, тогда
записываем в pIdx номер строки ListBox
Далее в масив P заносим номер строки и %
Потом в конце это дело записываем в конец Мемо

Цитата:

...из переданной строки S...

Но строку для обработки процедура берёт из Memo1.Lines[i]

Цитата:

...выбирает в AName имя параметра...

Ну имя параметра можно ей дать из строки ListBoxa

Цитата:

...а в AVal - его значение...

Опять же, значение уже есть в Memo1.Lines[i]

Что передавать этой проуедуре ExtractParamNameFromLine (вроде у неё всё есть)
Или что в теле её обрабатывать не догоняю.

lmikle · #4 27.07.2018, 01:44

Да ЯТЬ!
Ну просто же.

Код:

procedure ExtractParamNameFromLine(S : String; var AName : String; var AVal : Double);
var
  sVal : String;
begin
  AName := '';
  AVal := 0;

  If Pos('---',S) > 0 Then
    Begin
      Try
        AName := Trim(Copy(S,1,Pos('---',S)-1));
        sVal := Trim(Copy(S,Pos('---',S)+3,Pos('%',S)-Pos('---',S)-3));
        AVal := StrToFloat(sVal);
      Except
        // Нехорошо прятать эксепшены, но лень вспоминать как tryStrToFloat работает
      End
    End;
end;

Как-то так. Если ничего не напутал, то должно работать.

ЗЫ. Я там основной исходник тоже поправил чуть-чуть.

TEKTON · #5 27.07.2018, 02:46

Цитата:

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

Да ЯТЬ!
Ну просто же.

Для гуру да

Проверил, всё работает чётенько вроде!

Надо наверно в одном посте соединить два кусочка кода.
Пригодится ещё кому нить

Код:

{-------------------------- ФУНКЦИЯ --------------------------------}
procedure ExtractParamNameFromLine(S : String; var AName : String; var AVal : Double); // Закодил lmikle  http://www.delphisources.ru
var
  sVal : String;
begin
  AName := '';
  AVal := 0;
 
  If Pos('---',S) > 0 Then
    Begin
      Try
        AName := Trim(Copy(S,1,Pos('---',S)-1));
        sVal := Trim(Copy(S,Pos('---',S)+3,Pos('%',S)-Pos('---',S)-3));
        AVal := StrToFloat(sVal);
      Except
        // Нехорошо прятать эксепшены, но лень вспоминать как tryStrToFloat работает
      End
    End;
end;

{------------------------- ЮЗАЕМ -----------------------------}

procedure TForm1.Button1Click(Sender: TObject);
var
  P : Array Of Double;
  I, pIdx : Integer;
  pName : String;
  pVal : Double;
begin
  SetLength(P,ListBox1.Items.Count);
  For I := Low(P) To High(P) Do P[i] := 0; // just in case
  For I := 0 To Memo1.Lines.Count-1 Do
  Begin
    ExtractParamNameFromLine(Memo1.Lines[i],pName,pVal);
    If pName <> '' Then
      Begin
        pIdx := ListBox1.Items.IndexOf(pName);
        If pIdx > -1 Then P[pIdx] := P[pIdx] + pVal;
      End;
  End;

  // Print to memo
  Memo1.Lines.Add('');
  Memo1.Lines.Add('--- Итоговый подсчёт: ---');
  Memo1.Lines.Add('');
  For I := Low(P) To High(P) Do
    If P[i] > 0 Then Memo1.Lines.Add(ListBox1.Items[i] + ' --- '+ FloatToStr(P[i]) + ' %');
end;

AlisaBerne · #6 31.07.2018, 22:42

Цитата:

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

Для гуру да

Проверил, всё работает чётенько вроде!

Надо наверно в одном посте соединить два кусочка кода.
Пригодится ещё кому нить

Код:

{-------------------------- ФУНКЦИЯ --------------------------------}
procedure ExtractParamNameFromLine(S : String; var AName : String; var AVal : Double); // Закодил lmikle  http://www.delphisources.ru
var
  sVal : String;
begin
  AName := '';
  AVal := 0;
 
  If Pos('---',S) > 0 Then
    Begin
      Try
        AName := Trim(Copy(S,1,Pos('---',S)-1));
        sVal := Trim(Copy(S,Pos('---',S)+3,Pos('%',S)-Pos('---',S)-3));
        AVal := StrToFloat(sVal);
      Except
        // Нехорошо прятать эксепшены, но лень вспоминать как tryStrToFloat работает
      End
    End;
end;

{------------------------- ЮЗАЕМ -----------------------------}

procedure TForm1.Button1Click(Sender: TObject);
var
  P : Array Of Double;
  I, pIdx : Integer;
  pName : String;
  pVal : Double;
begin
  SetLength(P,ListBox1.Items.Count);
  For I := Low(P) To High(P) Do P[i] := 0; // just in case
  For I := 0 To Memo1.Lines.Count-1 Do
  Begin
    ExtractParamNameFromLine(Memo1.Lines[i],pName,pVal);
    If pName <> '' Then
      Begin
        pIdx := ListBox1.Items.IndexOf(pName);
        If pIdx > -1 Then P[pIdx] := P[pIdx] + pVal;
      End;
  End;

  // Print to memo
  Memo1.Lines.Add('');
  Memo1.Lines.Add('--- Итоговый подсчёт: ---');
  Memo1.Lines.Add('');
  For I := Low(P) To High(P) Do
    If P[i] > 0 Then Memo1.Lines.Add(ListBox1.Items[i] + ' --- '+ FloatToStr(P[i]) + ' %');
end;

Как раз пригодилось!!!! Спс)

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
TEKTON (26.07.2018)

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
TEKTON (27.07.2018)