Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #46  
Старый 01.08.2008, 16:45
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
По умолчанию

Цитата:
Сообщение от The Shadow
Вот, но здесь уже без стоимости рейса
Код:
procedure TForm1.Button1Click(Sender: TObject);
type
  TStringMatrix = Array of Array of String;
function NumPos(S: String; C: Char; Num: Integer): Integer;
var
  i, CurPos: Integer;
begin
  CurPos:=0;
  Result:=0;
  for i:=1 to Length(S) do
  begin
    if S[i] = C then
    Inc(CurPos);
    if CurPos = Num then
    begin
      Result:=i;
      Break;
    end;
  end;
end;
function CopyFromTo(S: String; C: Char; BeginPos, EndPos: Integer): String;
begin
  Result:=Copy(S, NumPos(S, C, BeginPos) + 1, NumPos(S, ',', EndPos) - NumPos(S, ',', BeginPos) - 1);
end;
function IndexInArray(S: String; Ar: TStringMatrix): Integer;
var
  i: Integer;
begin
  Result:=-1;
  if Length(Ar) = 0 then
  Exit;
  for i:=Low(Ar) to High(Ar) do
  begin
    if Length(Ar[i]) > 0 then
    if Ar[i][0] = S then
    begin
      Result:=i;
      Exit;
    end;
  end;
end;
var
  TmpStr: String;
  Cheks: TStringMatrix;
  i, j: Integer;
begin
  AssignFile(Input, 'f.txt');
  Reset(Input);
  AssignFile(Output, 'num.txt');
  Rewrite(Output);
  //AssignFile(ErrOutput, 'price.txt');
  //Rewrite(ErrOutput);
  while not Eof(Input) do
  begin
    Readln(Input, TmpStr);
    if IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks) > -1 then
    begin
      SetLength(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)], Length(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)]) + 1);
      Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)][High(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)])]:=CopyFromTo(TmpStr, ',', 2, 3);
    end
    else
    begin
      SetLength(Cheks, Length(Cheks) + 1);
      SetLength(Cheks[High(Cheks)], 2);
      Cheks[High(Cheks)][0]:=Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1);
      Cheks[High(Cheks)][1]:=CopyFromTo(TmpStr, ',', 2, 3);
    end;
  end;
  for i:=Low(Cheks) to High(Cheks) do
  begin
    Writeln(Output, Cheks[i][0]);
    for j:=Low(Cheks[i]) + 1 to High(Cheks[i]) do
    Writeln(Output, Cheks[i][j] + ',');
  end;
  CloseFile(Input);
  CloseFile(Output);
end;
Слушай а вот ты вставил //AssignFile(ErrOutput, 'price.txt');
//Rewrite(ErrOutput);
здесь можно просто вставить код из предыдущего примера и будет работать как один?
Ответить с цитированием
  #47  
Старый 01.08.2008, 16:46
Аватар для The Shadow
The Shadow The Shadow вне форума
Продвинутый
 
Регистрация: 11.06.2007
Адрес: Уфа, Россия
Сообщения: 793
Репутация: 35
По умолчанию

Да, просто я убрал несколько строчек чтобы код не стал еще больше.
__________________
Что делать, когда сломался комп:
1. Если вы юзер - делать ноги.
2. Если ремонтник - делать деньги.
3. Если вы программист - делать вид, что так было задумано.
Ответить с цитированием
  #48  
Старый 01.08.2008, 17:05
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
По умолчанию

Цитата:
Сообщение от The Shadow
Да, просто я убрал несколько строчек чтобы код не стал еще больше.
Блин мне конечно стыдно, но у меня что то не получается...... Подскажи...
Ответить с цитированием
  #49  
Старый 01.08.2008, 17:13
Аватар для The Shadow
The Shadow The Shadow вне форума
Продвинутый
 
Регистрация: 11.06.2007
Адрес: Уфа, Россия
Сообщения: 793
Репутация: 35
По умолчанию

Код:
procedure TForm1.Button1Click(Sender: TObject);
type
  TStringMatrix = Array of Array of String;
function NumPos(S: String; C: Char; Num: Integer): Integer;
var
  i, CurPos: Integer;
begin
  CurPos:=0;
  Result:=0;
  for i:=1 to Length(S) do
  begin
    if S[i] = C then
    Inc(CurPos);
    if CurPos = Num then
    begin
      Result:=i;
      Break;
    end;
  end;
end;
function CopyFromTo(S: String; C: Char; BeginPos, EndPos: Integer): String;
begin
  Result:=Copy(S, NumPos(S, C, BeginPos) + 1, NumPos(S, ',', EndPos) - NumPos(S, ',', BeginPos) - 1);
end;
function IndexInArray(S: String; Ar: TStringMatrix): Integer;
var
  i: Integer;
begin
  Result:=-1;
  if Length(Ar) = 0 then
  Exit;
  for i:=Low(Ar) to High(Ar) do
  begin
    if Length(Ar[i]) > 0 then
    if Ar[i][0] = S then
    begin
      Result:=i;
      Exit;
    end;
  end;
end;
var
  TmpStr: String;
  Cheks: TStringMatrix;
  i, j: Integer;
begin
  AssignFile(Input, 'f.txt');
  Reset(Input);
  AssignFile(Output, 'num.txt');
  Rewrite(Output);
  AssignFile(ErrOutput, 'price.txt');
  Rewrite(ErrOutput);
  while not Eof(Input) do
  begin
    Readln(Input, TmpStr);
    Writeln(ErrOutput, Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1));
    Writeln(ErrOutput, Copy(TmpStr, Pos(': ', TmpStr) + 2, NumPos(TmpStr, ',', 9) - Pos(': ', TmpStr) - 2));
    if IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks) > -1 then
    begin
      SetLength(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)], Length(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)]) + 1);
      Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)][High(Cheks[IndexInArray(Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1), Cheks)])]:=CopyFromTo(TmpStr, ',', 2, 3);
    end
    else
    begin
      SetLength(Cheks, Length(Cheks) + 1);
      SetLength(Cheks[High(Cheks)], 2);
      Cheks[High(Cheks)][0]:=Copy(TmpStr, Pos('№', TmpStr) + 1, NumPos(TmpStr, ',', 7) - Pos('№', TmpStr) - 1);
      Cheks[High(Cheks)][1]:=CopyFromTo(TmpStr, ',', 2, 3);
    end;
  end;
  for i:=Low(Cheks) to High(Cheks) do
  begin
    Writeln(Output, Cheks[i][0]);
    for j:=Low(Cheks[i]) + 1 to High(Cheks[i]) do
    Writeln(Output, Cheks[i][j] + ',');
  end;
  CloseFile(Input);
  CloseFile(Output);
  CloseFile(ErrOutput);
end;
Вроде так, не проверял
__________________
Что делать, когда сломался комп:
1. Если вы юзер - делать ноги.
2. Если ремонтник - делать деньги.
3. Если вы программист - делать вид, что так было задумано.
Ответить с цитированием
  #50  
Старый 01.08.2008, 18:51
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
По умолчанию

И еще подскажите пожалуйста как убрать из файла повторяющиеся строки длинна которых не более 3 символов.. Например есть строки
3
54555454
54545454
3
545454
878778
4
545545
5454554 и.т.д
нудно чтоб осталось
3
54555454
54545454
545454
878778
4
545545
5454554
Спасибо
Ответить с цитированием
  #51  
Старый 01.08.2008, 21:18
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  SList : TStringList;
  I, J : Integer;
begin
  SList := TStringList.Create;
  Try
    SList.LoadFromFile(Edit1.Text);
    For I := 0 To SList.Count-1 Do
      If Lenght(SList[i]) <= 3 Then // Длинна строки <= 3
        For J := SList.Count DownTo I + 1 Do
          If Slist[i] = SList[J] Then
            SList.Delete(J); // Удаляем такие-же, что ниже I
    SList.SaveToFile(Edit1.Text);
  Finally
    SList.Free;
  End;
end;
Ответить с цитированием
  #52  
Старый 04.08.2008, 08:44
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
По умолчанию

Спасибо. Есть еще один вопрос. Можно организавать чтобы обработка Мemo1.lines..SavetoFile (C:\1.txt) не переписыва файл заново а добавляла записи в конец ?
Ответить с цитированием
  #53  
Старый 04.08.2008, 08:47
Аватар для The Shadow
The Shadow The Shadow вне форума
Продвинутый
 
Регистрация: 11.06.2007
Адрес: Уфа, Россия
Сообщения: 793
Репутация: 35
По умолчанию

Код:
procedure AppendFile(Memo: TMemo; FN: String);
var
  i: Integer;
  f: TextFile;
begin
  AssignFile(f, FN);
  Append(f);
  for i:=0 to Memo.Lines.Count - 1 do
  Writeln(f, Memo.Lines[i]);
  CloseFile(f);
end;
__________________
Что делать, когда сломался комп:
1. Если вы юзер - делать ноги.
2. Если ремонтник - делать деньги.
3. Если вы программист - делать вид, что так было задумано.
Ответить с цитированием
  #54  
Старый 23.08.2008, 15:56
oleg87 oleg87 вне форума
Прохожий
 
Регистрация: 23.08.2008
Сообщения: 1
Репутация: 10
По умолчанию

Мне дан текстовый файл с описанием переменной f, количество переменных в файле заранее не известно.

>view f=0784
07/24/08_10:24:22 rty
### view subd start ###
# basic information #
f=0784
et=8974
sub_typ=analog lcls=indv chrg_cls=ama chrg_an=0 an=0
bnw=com tpad=0.0 rpad=-6.0 rc_org=1 rc_trm=0
chrg_ccls=nctl lctl=nctl
st=trmv
# service information #
sc=clip clip_typ=p
//total=1

>view f=3698

07/24/08_09:36:41 rty
### view subd start ###
# basic information #
f=0047
et=3698
sub_typ=analog lcls=indv chrg_cls=ama chrg_an=0 an=0
bnw=com tpad=0.0 rpad=-6.0 rc_org=1 rc_trm=0
chrg_ccls=nctl lctl=nctl
st=trmv
//total=1


В общем виде
>view f=.... параметры......... //total=1


Нужно в зависимости от параметров f вывести в новый файл инструкции последовательно для каждой переменной содержащие ее значение.

В общем виде для первой записи т.к sc=clip Нужно вывести в новый файл
can f=0784 sc=clip
reg f=0784 st_ope=trmv
can f=3698 sc=cw

где f=0784 значение функции
can sc=clip действия

и так для каждой f

Пожалуйста, помогите!
Ответить с цитированием
  #55  
Старый 08.09.2008, 09:57
DSL88 DSL88 вне форума
Новичок
 
Регистрация: 08.09.2008
Адрес: Пермь
Сообщения: 51
Репутация: 10
По умолчанию

Ничего не понял из твоего объяснения
__________________
Жизнь - игра: сюжет фигня... Зато какая графика!!!
Ответить с цитированием
  #56  
Старый 21.03.2009, 11:29
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
Радость Мастера помогите с копированием пожалуйста

Здравствуйте мастера. Подсткажите пожалуйста возможно ли скопировать файлы по дате? К примеру на форме есть компонента DateTimePicker и кнопка копировать. Выбираем дату в DateTimePicker, нажимаем копировать и файлы к примеру из папки C:\1\*.cm копируются (при этом у файлов меняется расширение) в папку D:\2\*.txt. Возможно ли это? Спасибо большое за ответы.
Ответить с цитированием
  #57  
Старый 21.03.2009, 11:29
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
Радость

Здравствуйте мастера. Подсткажите пожалуйста возможно ли скопировать файлы по дате? К примеру на форме есть компонента DateTimePicker и кнопка копировать. Выбираем дату в DateTimePicker, нажимаем копировать и файлы к примеру из папки C:\1\*.cm копируются (при этом у файлов меняется расширение) в папку D:\2\*.txt. Возможно ли это? Спасибо большое за ответы.
Ответить с цитированием
  #58  
Старый 24.03.2009, 08:59
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
По умолчанию

Цитата:
Сообщение от MSD
Здравствуйте мастера. Подсткажите пожалуйста возможно ли скопировать файлы по дате? К примеру на форме есть компонента DateTimePicker и кнопка копировать. Выбираем дату в DateTimePicker, нажимаем копировать и файлы к примеру из папки C:\1\*.cm копируются (при этом у файлов меняется расширение) в папку D:\2\*.txt. Возможно ли это? Спасибо большое за ответы.


Что никто не знает как это сделать??
Ответить с цитированием
  #59  
Старый 29.04.2009, 09:29
MSD MSD вне форума
Прохожий
 
Регистрация: 29.03.2008
Сообщения: 35
Репутация: 10
Радость Помогите пожалуйста исправить код...)

мастера подсткажите пожалуйста это пример заменяет определенные значения на другие, но вот в чем проблема условие может быть только одно..... как сделать 3 и более условий для замены? Спасибо.
Код:
var
sl: TStringList;
begin
sl := TStringList.Create;
if fileexists ('C:\1.txt')then sl.LoadFromFile('C:\1.txt');
for i := 0 to sl.Count - 1 do
  sl[i] := StringReplace(sl[i], 'г:', '', [rfReplaceAll]);
sl.SaveToFile('C:\1.txt');
sl.Free;
Admin: Пользуемся тегами, иначе последуют санкции!

Последний раз редактировалось Admin, 29.04.2009 в 10:34.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 10:08.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter