|
Вопрос # 5 670/ вопрос решён / |
|
Здравствуйте!
Вообщем ситуация такая: необходима программка для обработки специфического текстового файла: в нём может быть около 10000 строк, состоящих из 14 символов. Необходимо загрузить содержимое в поле Мемо Main, дальше по нажатию кнопки "Проверить" сравнить все сроки друг с другом по символам с 4 по 11 и если они совпадают то удалить их их поля из Main(для последующего сохранения в отсортированный файл) и одновременно копировать: строка с "3" на конце (14 символ) в поле мемо "Closed", а с "2" в поле мемо "Open". К вопросу прилагаю принт скрин с пояснениями.
Заранее благодарен за помощь!
К вопросу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки вопроса)
 |
Вопрос задал: Rhasta (статус: Посетитель)
Вопрос отправлен: 8 октября 2011, 21:48
Состояние вопроса: решён, ответов: 2.
|
Ответ #1. Отвечает эксперт: ierihon1
Здравствуйте, Rhasta! Вот конечный вариант алгоритма:
function CompareStrings(S1,S2:string):Boolean;
begin
Delete(S1,1,3); Delete(S1,12,3);
Delete(S2,1,3); Delete(S2,14,3);
if S1 = S2 then
Result:=True
else
Result:=False;
end;
procedure TForm11.btn1Click(Sender: TObject);
var i,j:Integer;
begin
mmo2.Clear;
mmo3.Clear;
for i := 0 to mmo1.Lines.Count - 1 do
for j := 0 to mmo1.Lines.Count - 1 do
if i <> j then
if CompareStrings(mmo1.Lines[i],mmo1.Lines[j]) then
begin
if mmo1.Lines[i][14] = '2' then
mmo2.Lines.Add(mmo1.Lines[i]);
if mmo1.Lines[i][14] = '3' then
mmo3.Lines.Add(mmo1.Lines[i]);
mmo1.Lines.Delete(i);
end;
end;
 |
Ответ отправил: ierihon1 (статус: 1-ый класс)
Время отправки: 8 октября 2011, 22:43
Оценка за ответ: 5
Комментарий к оценке: Кое что подправил, но за идею спасибо
|
Ответ #2. Отвечает эксперт: Drinkenz
Здравствуйте, Rhasta!
function CompareStrings(S1,S2:string):Boolean;
begin
Delete(S1,14,1);
Delete(S1,1,3);
Delete(S2,14,1);
Delete(S2,1,3);
Result:=S1=S2;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i,j,k:Integer;
savmemo,delmemo: tstringlist;
f1,f2: boolean;
begin
savmemo:=TStringList.Create();
delmemo:=TStringList.Create();
memo2.Clear;
memo3.Clear;
i:=0;
while i<(memo1.Lines.Count-2) do begin
f1:=false;
f2:=true; // restore i
for j:=i+1 to memo1.Lines.Count-1 do
if CompareStrings(memo1.Lines[i],memo1.Lines[j]) then begin
f1:=true;
delmemo.add(memo1.Lines[j]);
end
else
savmemo.add(memo1.Lines[j]);
if f1 then begin
f2:=false; // мемо1 в на переделку
delmemo.add(memo1.Lines[i])
end
else
savmemo.add(memo1.Lines[i]); // строка уникальна!
for k:=0 to delmemo.count-1 do
case delmemo.strings[k][14]of
'2': memo2.Lines.Add(delmemo.strings[k]);
'3': memo3.Lines.Add(delmemo.strings[k]);
end;
delmemo.Clear;
memo1.lines.assign(savmemo);
if f2 then inc(i);
savmemo.Clear;
end;
delmemo.Free;
savmemo.Free;
end;
 |
Ответ отправил: Drinkenz (статус: 1-ый класс)
Время отправки: 9 октября 2011, 01:10
|
Мини-форум вопроса
Всего сообщений: 25; последнее сообщение — 13 октября 2011, 15:59; участников в обсуждении: 4.
Страницы: [1] [2] [Следующая »]
|
|
ierihon1 (статус: 1-ый класс), 8 октября 2011, 22:00 [#1]:
я так понимаю нужен именно алгоритм сравнения?
|
|
|
Rhasta (статус: Посетитель), 8 октября 2011, 22:06 [#2]:
Да, вы совершенно правы!
|
|
|
ierihon1 (статус: 1-ый класс), 8 октября 2011, 22:07 [#3]:
хорошо уже работаю над этим.
|
|
|
ierihon1 (статус: 1-ый класс), 8 октября 2011, 22:19 [#4]:
function CompareStrings(S1,S2:string):Boolean;
begin
Delete(S1,1,3); Delete(S1,14,1);
Delete(S2,1,3); Delete(S2,14,1);
if S1 = S2 then
Result:=True
else
Result:=False;
end;
procedure TForm11.btn1Click(Sender: TObject);
var i,j:Integer;
begin
for i := 0 to mmo1.Lines.Count - 1 do
for j := 0 to mmo1.Lines.Count - 1 do
if i <> j then
if CompareStrings(mmo1.Lines[i],mmo1.Lines[j]) then
if mmo1.Lines[i][14] = '2' then
begin
mmo2.Lines.Add(mmo1.Lines[i]);
mmo1.Lines.Delete(i);
end;
if mmo1.Lines[i][14] = '3' then
begin
mmo3.Lines.Add(mmo1.Lines[i]);
mmo1.Lines.Delete(i);
end;
end;
Проверьте, если будут недочёты исправим.
|
|
|
Rhasta (статус: Посетитель), 8 октября 2011, 22:24 [#5]:
Ок, кэп. Отпишусь завтра. Спасибо!
|
|
|
ierihon1 (статус: 1-ый класс), 8 октября 2011, 22:46 [#6]:
Только сейчас увидел: в ответе в чётвёртой строке должно быть
Delete(S2,1,3); Delete(S2,12,3);
|
|
|
Drinkenz (статус: 1-ый класс), 8 октября 2011, 23:23 [#7]:
после Delete(S2,1,3) длина строки у тебя будет 11 символов,
и Delete(S2,12,3) уже работает с пустотой
|
|
|
Rhasta (статус: Посетитель), 8 октября 2011, 23:27 [#8]:
Delete(S1,1,3); Delete(S1,11,1);
Delete(S2,1,3); Delete(S2,11,1); Тогда наверное так?
|
|
|
Rhasta (статус: Посетитель), 8 октября 2011, 23:34 [#9]:
Алгоритм вроде не работает... буду копаться дальше)))
|
|
|
Drinkenz (статус: 1-ый класс), 8 октября 2011, 23:38 [#10]:
проще вот так
function CompareStrings(S1,S2:string):Boolean;
begin
Delete(S1,12,3);Delete(S1,1,3);
Delete(S2,12,3);Delete(S2,1,3);
Result:=S1=S2;
end;
|
|
|
Rhasta (статус: Посетитель), 8 октября 2011, 23:46 [#11]:
Извиняюсь, в вопросе сделал опечатку сравнение идёт с 4 по 13 символ
|
|
min@y™ (статус: Доктор наук), 9 октября 2011, 09:16 [#12]:
Цитата (Drinkenz):
проще вот так
function CompareStrings(S1,S2:string):Boolean;
begin
Delete(S1,12,3); Delete(S1,1,3);
Delete(S2,12,3); Delete(S2,1,3);
Result:=S1=S2;
end;
А может вот так быстрее будет?
function CompareStrings(const S1, S2: string): Boolean;
var
Index: Integer;
begin
// 4 вызова Delete() - это 4 перераспределения памяти,
// которые нахрен не нужны. Поэтому ФТОПКУ их.
Result:= False;
{ при необходимости можно проверять коррекность:
if (Length(S1) <> 14) or (Length(S2) <> 14)
then Exit; }
for Index:= 4 to 13 do
if S1[Index] <> S2[Index]
then Exit;
Result:= True;
end;
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Rhasta (статус: Посетитель), 9 октября 2011, 12:37 [#13]:
min@y™, спасибо сейчас попробую!
ierihon1, если программа находит совпадения, то она не копирует одну из двух строк в поле мм3, а также не удаляет значения из главного поля Мемо
Drinkenz, Ваш алгоритм ещё не пробовал. Но всё равно спасибо, отпишусь в течение дня
|
|
|
Rhasta (статус: Посетитель), 10 октября 2011, 12:18 [#14]:
Спасибо всем кто откликнулся. Добился желаемого примерно следующим:
procedure TForm1.Button2Click(Sender: TObject);
var i,j:Integer;
str1,str2:string;
begin
close.Clear;
open.Clear;
for i := 0 to main.Lines.Count-1 do
for j := 0 to main.Lines.Count-1 do
if i <> j then
if CompareStrings(main.Lines[i],main.Lines[j]) then
begin
str1:=main.Lines[i];
str2:=main.Lines[j];
main.Lines.Delete(j);
main.Lines.Delete(i);
if str1[14] = '2' then
open.Lines.Add(str1)
else close.Lines.Add(str1);
if str2[14] = '3' then
close.Lines.Add(str2)
else open.Lines.Add(str2);
end;
label1.Caption:=inttostr(main.Lines.Count);
label2.Caption:=inttostr(main.Lines.Count);
label3.Caption:=inttostr(main.Lines.Count);
end;
Теперь в поле main у меня все необходимые строки для сортировки. написал процедуру на кнопку:
procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to main.Lines.Count-1 do
if main.Lines[i][14]='3'then
main.Lines.Delete(i)
end;
Но почему то выдаёт ошибку... где я напортачил и как рациональней с точки зрения ресурсов выполнить удаление? (если 14 символ 3, то удалить из поля)
|
|
|
Drinkenz (статус: 1-ый класс), 10 октября 2011, 12:56 [#15]:
Rhasta, мне тоже пятерку поставь.
|
|
|
Rhasta (статус: Посетитель), 10 октября 2011, 13:10 [#16]:
Поставлю, только помогите мне с последним вопросом))))
|
|
|
min@y™ (статус: Доктор наук), 10 октября 2011, 13:12 [#17]:
Цитата (Rhasta):
Поставлю, только помогите мне с последним вопросом))))
for ... to ... do замени на for ... downto .. do.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Rhasta (статус: Посетитель), 10 октября 2011, 13:17 [#18]:
min@y™: А так при нажатии на кнопку вообще ничего не происходит((((
|
|
|
min@y™ (статус: Доктор наук), 10 октября 2011, 13:45 [#19]:
Цитата (Rhasta):
А так при нажатии на кнопку вообще ничего не происходит
Вместо того, штобы скулить на форуме, прочитал бы, как работает цикл for через downto.
procedure TForm1.Button3Click(Sender: TObject);
var
i: integer;
begin
main.Lines.BeginUpdate();
try
for i := main.Lines.Count - 1 downto 0 do
if main.Lines[i][14] = '3'
then main.Lines.Delete(i);
finally
main.Lines.EndUpdate();
end;
end;
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Rhasta (статус: Посетитель), 10 октября 2011, 13:51 [#20]:
я не скулю, а вы вместо того, чтобы оскорблять, тогда бы вообще не писали! такая помощь не особо то нужна
|
Страницы: [1] [2] [Следующая »]
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
