Tælle med en alphanumerisk værdi

Jeg er lidt bange for at du bliver nødt til selv at skrive noget for noget
så specielt.

Hvad skal det bruges til?

Prøv det her som jeg lige har skruet sammen til dig. Jeg testede lidt og som jeg forstår opgaven, så virker det.

Procedure AlphaAdd(Const InpStr : String; Var OutStr : String);
Var
  ilen : Integer;
  idx  : Integer;
Begin
  OutStr := '';
  iLen  := Length(InpStr);
  If iLen=0 Then Exit;

  For idx := iLen DownTo 1 Do
    If (InpStr[idx]<'0') Or (InpStr[idx]>'9') Then
      Break;

  If (InpStr[idx]<'0') Or (InpStr[idx]>'9') Then
    Begin
      OutStr := Copy(InpStr, 0, idx) +
                IntToStr(StrToInt(Copy(InpStr, idx+1, iLen))+1)
    End
  Else
    OutStr := IntToStr(StrToInt(InpStr) + 1);
End;

Det firma hvor jeg arbejder, har vi en mængde stumper der er serienummereret efter producentens forgodtbefindende, alle formater, som jeg har set indtil nu, slutter med en numerisk del. Det skal bruges til at registrere hvor de forskellige dele er købt, og i hvilke produkter de indgår i, i produktionen. Langt de fleste producenter nummererer dem fortløbende. Så for at gøre det nemt at indtaste dem ville det være smart med en routine der selv kunne tælle op.

Jeg sad i går aftes og biksede denne rutine sammen.

function TForm3.Naeste(V: String):String;
var
  A: String;  // Eventuel ikke-numerisk første del af nummeret.
  N: String;  // Heltals tæller i slutningen af nummeret.
  P: Integer;  // Position hvor alphanumerisk og numerisk skiller.
  L: Integer;  // Antal cifre i den numeriske del, mht. foranstillede nuller.
begin
  P := Length(V);
  while (P > 0) and (V[P]>='0') and (V[P]<='9') do
    P := P - 1;
  A := Copy(V, 1, P);            // A = Den alphanumeriske del.
  N := Copy(V, P+1, Length(V));  // N = Den numeriske del.
  if N = '' then N := '0';        // Der skal være en numerisk del.
  L := Length(N);
  N := IntToStr(StrToInt(N) +1);  // Tæl en frem.
  while Length(N) < L do          // Hvis der er foranstillede nuller på den
    N := '0' + N;                // numeriske del, skal disse bibeholdes,
  Naeste := A + N;                // indtil værdien kræver et ciffer mere.
end;

Hvis der er en der kan lave den kortere/simplere end dette er der point.

Den her er da kortere :-)

function Naeste(V: String):String;
var
  P: Integer;  // Position hvor alphanumerisk og numerisk skiller.
begin
  P := Length(V);
  while (P > 0) and (V[P] in ['0'..'9']) do
    P := P - 1;
  Result := Copy(V, 1, P) + IntToStr(StrToIntDef(Copy(V, P+1, Length(V)), 0)+1);
  while Length(Result) < Length(V) do
    Insert('0', Result, P+1);
end;

Lidt kortere igen :-)

function Naeste(V: String):String;
var
  P: Integer;  // Position hvor alphanumerisk og numerisk skiller.
begin
  P := Length(V);
  while (P > 0) and (V[P] in ['0'..'9']) do
    P := P - 1;
  Result := Copy(V, 1, P) + Format('%.'+IntToStr(Length(V)-P)+'d', [StrToIntDef(Copy(V, P+1, Length(V)), 0)+1]);
end;

Galning! ;)  Det er squ da umugeligt at yde service på det kode!  Prøv at gennemskue den slags fx. om bare tre måneder.

Sådan er kort kode jo typisk.

"Umugeligt" - hvad hulen er det for noget bavl at skrive.... stik mig flux en staveplade!

Der er lige før Delphi havde fået point. Den sidste kommentar fik mig til at grine så meget at jeg næt havde spildt alt min kaffe ned i tastaturet.
Tolderlund: Har du en ide om hvilken en af de viste eksempler der er hurtigst.

Hm, godt spørgsmål, jeg tester lige ...
Helt uvidenskabeligt:
Jeg kørte begge rutiner igennem 1000000 (1 million) gange.
Med input 'Test1'
Rutine 1: 2094 ms (millisekunder)
Rutine 2: 3187 ms
Med input 'Test0098'
Rutine 1: 2797 ms
Rutine 2: 3265 ms
Konklusion: den første rutine er vist hurtigst.

Jeg ser altså 4 forslag.....

Du skal da også brokke dig :-)
Jeg testede kun mine egne rutiner.
Men i øvrigt, din rutine fungerer ikke helt.
Ved input af 'Test0098' giver den 'Test99' og ikke som krævet 'Test0099'.
Ved input af '0098' giver den '99' og ikke som krævet '0099'.
Og ved input af f.eks. 'Test' giver den en Exception error, men input af kun alfanumerisk er dog ikke dækket af opgavebeskrivelsen.

Prøv:

function incr4(s : string) : string;

var
  add,i : integer;
  res : string;

begin
  res := s;
  add := 1;
  i := length(res);
  while add > 0 do begin
    res[i] := chr(ord(res[i]) + add);
    if res[i] > '9' then begin
      res[i] := chr(ord(res[i]) - 10);
      add := 1;
    end else begin
      add := 0;
    end;
    i := i - 1;
  end;
  incr4 := res;
end;

Beklager arne, men med 'Test9' som input giver din rutine en fejl.

Hvis den skal kunne øge længde af strengen, så skal den modificeres til:

function incr4(s : string) : string;

var
  add,i : integer;
  res : string;

begin
  res := s;
  add := 1;
  i := length(res);
  while add > 0 do begin
    if (res[i] < '0') or (res[i] > '9') then begin
      res := copy(res, 1, i) + '0' + copy(res, i + 1, length(res) - i);
      i := i + 1;
    end;
    res[i] := chr(ord(res[i]) + add);
    if res[i] > '9' then begin
      res[i] := chr(ord(res[i]) - 10);
      add := 1;
    end else begin
      add := 0;
    end;
    i := i - 1;
  end;
  incr4 := res;
end;

Hej Tolderlund.
Du har gjort et fint stykke arbejde, du får pointene.

Takker.

Fik du testet hastighed med incr4 ?

06/12-2004 23:47:17
07/12-2004 13:38:14
08/12-2004 11:04:38
11/12-2004 10:49:02

giver hos mig:

Test1
Test2 1281
Test2 1094
Test2 1813
Test2 312
Test0098
Test0099 1625
Test0099 1563
Test0099 1859
Test0099 328
Test0199
Test0200 1422
Test0200 1391
Test0200 1843
Test0200 360
Test9
Test10 1344
Test10 1109
Test10 1828
Test10 1047

eller på dansk:
  - hvis strengen ikke skal gøres længere så er mit forslag ca. 3-5 gange hurtigere
  - hvis strengen skal gøres længere så er mit forslag ca. lige så hurtigt