En algoritme der fjerne gentagne mellemrum i en streng.

Prøv den her

Function Hest(Const s : String; RepeatChar : char = #32) : String;
var
  i,j : Integer;
begin
  result := s;
  j := 0;

  while j<Length(Result) do
  begin
    inc(j);
    if Result[j] <> RepeatChar then
      continue;

    if Result[j+1] <> RepeatChar then
      continue;

    i := j +1;

    while Result[i] = RepeatChar do
      inc(i);

    Delete(Result,j+1, i-j-1);
  end;
end;

Og kald den sådan her ...

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text := hest(Edit1.Text);
end;

Den her algoritme kan ikke kun fjerne Gentagende mellemrum men helt generelt gentagende Karekterer efter eget valg.

Jens B

Værsgo:

Function DelSpace(s:string):string;
Var i: word;
Begin
  i := 1;
  While i <= length(s)-1 do
  Begin
    While (s[i]=\' \') and (length(s)>=i+1) and (s[i+1]=\' \') do
      delete(s,i+1,1);
    inc(i);
  end;
  Result := s;
end;

Kaldes:
  test := \'ab c  d  e    f\';
  edit1.text := delspace(test);

//hreiff

Prøv dette:

// Fjerner alle forekomster af DelCh
Function DeleteChar(Const Str:String;DelCh:Char):String;
Var Idx:Integer;
begin
  Result:=\'\';
  for Idx:=1 to Length(Str) do
    if Str[Idx]<>DelCh then
      Result:=Result+Str[Idx];
end;

Kaldes:
  Test:=\' 12  3 4  5\';
  Test:=DeleteChar(Test);
  // Test er nu lig \'12345\'

Den korte version:

function RemoveSpace(S:string) : string;
  begin
    while Pos(\' \', S) > 0 do
      delete(s,Pos(\' \', S),1);
    RemoveSpace:=S;
  end;

Den korte version incl. test eksempel

Opret ny application med 1 Editfelt: Edit1
                        1 Button  : Button1 

indsæt nedenstående kode i onclick event for button
og du er kørende


function RemoveSpace(S:string) : string;
  begin
    while Pos(\' \', S) > 0 do
      delete(s,Pos(\' \', S),1);
    RemoveSpace:=S;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := RemoveSpace(Edit1.Text)
end;

mroten_S>> Var der ikke gentagende mellemrum han ville have fjernet og ikke alle mellem rum ?

JEns B

Som jeg læser det har han lavet en som kun kan fjerne dbl mellemrum
og det er tilsyneladende Øv, øv. Derfor gætter jeg på at der også
skal fjernes enkelte mellemrum.

tja .. Nu må vi se når vi en gang får manden på banen ...

Jens B

Men uanset hvad, så er det så heldigt at den korte version kan
opgraderes til ver 1.1 (kan tage dbl mellemrum) ved at indsætte ekstra space
som vist neden under, det kræver kun et par tryk på mellemrumstast

function RemoveSpace(S:string) : string;
  begin
    while Pos(\'  \', S) > 0 do  // <-- 2*MELLEMRUM MELLEM \'  \'
      delete(s,Pos(\'  \', S),1); // <-- 2*MELLEMRUM MELLEM \'  \'
    RemoveSpace:=S;
  end;

Eller den korte version som fjerner hvad som helst
incl. det kendte ord hest ;-))


function RemoveSpace(S, DelStr:String) : string;
  begin
    while Pos(DelStr, S) > 0 do
      delete(s,Pos(DelStr, S),length(DelStr));
    RemoveSpace:=S;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := RemoveSpace(Edit1.Text, \'hest\')
end;

jo jo ... JEg læste bare opgaven som han havde n mellemrum mellem hvert ord og der askulle kun være et.

Jens B

Sådan har jeg også læst opgaven.
morten s\'s måde er simpel, men jeg kan ikke forstå at du kalder den rekursivt: While sætningen ændrer alle forekomster af \'  \' (dobbelt) til \' \' (enkelt), og den gentager sig selv indtil der kun er enkelt \' \' tilbage.
Jeg synes faktisk at den er ret smart!
//hreiff

hreiff>> jeg kalder den ikke rekursivt

RemoveSpace:=S; sætter resultatet af function til S

Nå nej, det er også rigtigt - jeg blev bare narret af Removespace = istedet for Result =
(Jeg synes stadig det er smart)

Den store forskel på min algoritme og mortens er at jeg ikke fjerner et bestemt antal mellemrum hver gang. JEg finder ud af hvormange der er også fjerner dem.


Jens B

Principielt burde borrisholts funktion være hurtigere, da strengen kun løbes igennem 1 gang, men man skal jo ikke kimse af standardfunktionerne da de som regel er kodet ret godt.

og min sidste udvidelse fjerner alle forekomne
delstrenge i en streng, incl et mellemru, 2 mellemrum
diverse tekster som f.eks \'hest\' m.m.

OKI. Min virker lidt anderledes

fx
Test:=\'12  3 4  5\';
Test:=Hest(Test);
  // Test er nu lig \'12 3 4 5\' 

Eller
Test:=\'12##3#4###5\';
Test:=Hest(Test);
// Test er nu lig \'12#3#4#5\' 

Jens B

Jeg havde simpelthen glemt ALT om dette emne.. Sorry! Borrisholdt får pointne, fordi det var hans svar der var først, og det virkede... Sorry igen til alle!