оставление первого слова

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

оставление первого слова

Сообщение Alex_Gordon1 » 27.02.2011 19:14:09

Есть строка:
HG_ALERT1 hgrunt/alert1.wav
Необходимо удалить вспе после пробела, и оставить толкьо HG_ALERT1
Как это сделать?
Alex_Gordon1
новенький
 
Сообщения: 18
Зарегистрирован: 09.02.2011 20:41:12

Re: оставление первого слова

Сообщение Mr.Smart » 27.02.2011 19:35:24

Код: Выделить всё
s_in='HG_ALERT1 hgrunt/alert1.wav';
s_out:=Copy(s_in,1,Pos(' ',s_in));
Mr.Smart
долгожитель
 
Сообщения: 1796
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

Re: оставление первого слова

Сообщение Nik » 27.02.2011 19:49:06

Если в начале строки всегда HG_ALERT1, можно ещё проще:

Код: Выделить всё
s_in:='HG_ALERT1 hgrunt/alert1.wav';
s_out:=Copy(s_in,9,Length(s_in));
Аватара пользователя
Nik
энтузиаст
 
Сообщения: 573
Зарегистрирован: 04.02.2006 00:08:09
Откуда: Киров

Re: оставление первого слова

Сообщение Alex_Gordon1 » 27.02.2011 19:52:05

Да, я уже разобрался, но все равно спасибо.
Alex_Gordon1
новенький
 
Сообщения: 18
Зарегистрирован: 09.02.2011 20:41:12

Re: оставление первого слова

Сообщение СерП » 27.02.2011 20:16:04

Немного попридираюсь к последнему предложенному коду. Видимо, имелось в виду что-то вроде:
Код: Выделить всё
s_in:='HG_ALERT1 hgrunt/alert1.wav';
s_out:=s_in;
Delete (s_out,10,Length(s_out));

Это если пробел не нужен.
Или:
Код: Выделить всё
s_in:='HG_ALERT1 hgrunt/alert1.wav';
s_out:=Copy(s_in,1,9);
СерП
новенький
 
Сообщения: 13
Зарегистрирован: 04.12.2010 01:20:10

Re: оставление первого слова

Сообщение VirtUX » 27.02.2011 20:46:02

Тоже внесу лепту:
Код: Выделить всё
function GetFirstWorldInString(StrIn: string): string;
var
  ic, l: integer;
begin
  l := length(StrIn);
  if l < 1 then Result := ''
  else for ic := 1 to l begin
    if StrIn[ic] = #20 then break
    else Result += StrIn[ic];
  end;
end;

Не рекомендуется для реального применения!
Код: Выделить всё
function GetFirstWorldInString(StrIn: string): string;
var
  p, l: integer;
begin
  l := length(StrIn);
  if l < 1 then Result := ''
  else begin
    p := pos(#20, StrIn);
    if p > 1 then Result := copy(StrIn, 1, pred(p))
    else if p = 1 Result := ''
    else Result := StrIn;
  end;
end;

Тем более не рекомендуется!
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 880
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

Re: оставление первого слова

Сообщение Mr.Smart » 27.02.2011 20:50:09

Ну тогда продолжим :lol:
Код: Выделить всё
s:='HG_ALERT1 hgrunt/alert1.wav';
SScanf(s,'%s %s',[@s1,@s2]);
Mr.Smart
долгожитель
 
Сообщения: 1796
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

Re: оставление первого слова

Сообщение Brainenjii » 27.02.2011 21:52:00

Код: Выделить всё
Function GetFirstWordInString(Const aString: String): String;
Var
  aProcess: TProcess;
  aStringList: TStringList;
Begin
  aStringList := TStringList.Create;
  aStringList.Text := aString;
  aStringList.SaveToFile('1.txt');
  aProcess := TProcess.Create(nil);
  aProcess.CommandLine := 'cmd /C "FOR /F "tokens=1" %i IN (1.txt) DO echo %i"';
  aProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
  aProcess.Execute;
  aStringList.LoadFromStream(aProcess.Output);
  Result := aStringList[2];
  aStringList.Free;
  aProcess.Free;
End;
Аватара пользователя
Brainenjii
энтузиаст
 
Сообщения: 1351
Зарегистрирован: 10.05.2007 00:04:46

Re: оставление первого слова

Сообщение Odyssey » 27.02.2011 22:58:36

Присоединяюсь :)
Код: Выделить всё
uses StrUtils;
...
s := 'HG_ALERT1 hgrunt/alert1.wav';
FirstWord := Copy2Symb(s, ' ');
Odyssey
энтузиаст
 
Сообщения: 580
Зарегистрирован: 29.11.2007 17:32:24

Re: оставление первого слова

Сообщение devels » 27.02.2011 23:05:02

И я тоже:

Код: Выделить всё
function CopyL(const S: String; const Srch:String):String;
begin
  Result:=Copy(s,1,Pos(Srch,S)-1);
end;

begin
   s := 'HG_ALERT1 hgrunt/alert1.wav';
   FirstWord := CopyL(s, ' ');
end;
devels
постоялец
 
Сообщения: 137
Зарегистрирован: 01.09.2010 12:14:38

Re: оставление первого слова

Сообщение Ism » 27.02.2011 23:53:24

Товарищи, есть функция ExtractWord

http://lazarus-ccr.sourceforge.net/docs ... tword.html

указываешь номер слова и ограничители.
Ism
энтузиаст
 
Сообщения: 908
Зарегистрирован: 06.04.2007 17:36:08

Re: оставление первого слова

Сообщение VirtUX » 28.02.2011 00:45:05

Модификация:
Код: Выделить всё
function GetFirstWorldInString(StrIn: string): string;
    var
      ic, l: integer;
      gtc: DWord;
    begin
      l := length(StrIn);
      if l < 1 then Result := ''
      else for ic := 1 to l begin
        gtc := gettickcount;
        if StrIn[ic] = #20 then break
        else Result += StrIn[ic];
        if gettickcount > (gtc + 60000) then begin
          showmessage('Извините, НО! Ваш ПК слишком устарел для выполнения поставленной задачи!');
          Result := '';
          exit;
        end;
      end;
    end;
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 880
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

Re: оставление первого слова

Сообщение dunin » 28.02.2011 09:35:12

Ну давайте и я свою лепту внесу...
Код: Выделить всё
uses StrUtils...
...
procedure TMainForm.Button1Click(Sender:TObject);
  const intext = 'HG_ALERT1 hgrunt/alert1.wav';

  function ReturnFirstWird (FirstWord: string; DoMessage: boolean = False): string;

    function CharCount(InStr: string; TheChar: Char): integer;
      var I: Integer;
    begin
      result:= 0; i:= 0;
      if Length(InStr) = 0 then exit;
      repeat
        if (InStr[i] = TheChar) then inc(result);
        inc(i);
      until (i > Length(InStr));
    end;

    function CopyFN(Str: string; Simvol: Char; FromSimvolNomer: integer): string;
      var StartPos, EndPos: integer;
        i, j: Integer;
    begin
    Result := '';
      if (pos(Simvol, Str) = 0) then exit;
      StartPos:= 0; j:= 0;
      Str:= trim(Str);

      if not (Str[1] = Simvol) then Str:= Simvol + Str;
      if not (Str[length(Str)] = Simvol) then Str:= Str + Simvol;

        for i:= 1 to Length(trim(Str))-1 do begin
          if (Str[i] = Simvol) then begin
            Inc(j);
            if (j = FromSimvolNomer) then begin
              StartPos:= i;
              break;
            end;
          end;
        end;
      if (StartPos = 0) then exit;
      EndPos:= PosEx(Simvol, Str, StartPos+1);
        if (EndPos > StartPos)
          then result := copy(Str, StartPos+1, EndPos-StartPos-1)
          else result := '';
    end;

  begin
    if (CharCount(FirstWord, #32) = 0)
      then begin
        if DoMessage then showmessage('Менее двух слов');
        Result:= '';
        Exit;
      end
      else begin
        Result:= CopyFN(FirstWord,#32,1);
      end;
  end;

begin
  showmessage(ReturnFirstWird(intext));
end;

Работает. Проверено.
Аватара пользователя
dunin
энтузиаст
 
Сообщения: 634
Зарегистрирован: 02.05.2007 13:18:11
Откуда: Тољя††и

Re: оставление первого слова

Сообщение leo_bsv » 02.03.2011 22:26:35

пиппец мясо... :shock:
да если нужно оставить только HG_ALERT1 дык чё парица:
Код: Выделить всё
procedure ...
var s:string;
begi..
s:='HG_ALERT1';  // it's my way! =0
end;
Аватара пользователя
leo_bsv
постоялец
 
Сообщения: 276
Зарегистрирован: 04.08.2010 16:26:10
Откуда: Йошкар-Ола


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot] и гости: 20

Рейтинг@Mail.ru