DELPHI AREA Forum

Hi all,

I have a problem Incremental Character code.

sample
'AAZ' to 'ABB'

gen to 'AAZ' 'AB0' 'AB1' 'AB2' 'AB3' 'AB4' 'AB5' 'AB6' 'AB7' 'AB8' 'AB9' 'ABA' 'ABB'

Code: Select all

function IncStr(Str: String; Amount: Integer; Index: Integer = -1): String;
const
 //MIN_NUM = 48; // '0' 65; // 'A'
 //MAX_NUM = 57;
 MIN_VAL = 48; //65;
 MAX_VAL = 90; // 'Z'
var
 Digit, ToAdd, ToCarry: Integer;
begin

 if (Index = 0) and (Amount > 0) then
  begin
   //Result := Char(MIN_VAL + Amount - 1) + Str;
   Result := Char(MIN_VAL + Amount - 1) + Str;
   Exit;
  end;

 if Index = -1 then Index := Length(Str);

 ToCarry := 0;

 Digit := Ord(Str[Index]);

 while not (Digit in [MIN_VAL..MAX_VAL]) do
 //while not (Digit in [MIN_NUM..MAX_NUM, MIN_VAL..MAX_VAL]) do
  begin
   Dec(Index);
   Digit := Ord(Str[Index]);
  end;

 ToAdd := Digit + Amount;

 while (ToAdd > MAX_VAL) do
  begin
   Dec(ToAdd, 26);
   Inc(ToCarry);
  end;

 Result := Str;
 Result[Index] := Char(ToAdd);

 if (ToCarry > 0) then
  Result := IncStr(Result, ToCarry, Index - 1);

end;


Thank you in advance for your help
psomkuan

These two functions may help you. But they only use letters, not digits.

Code: Select all

function LetterToNumber(const Letter: String): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(Letter) do
  begin
    if (Letter[I] >= 'A') and (Letter[I] <= 'Z') then
      Result := Result * 26 + Ord(Letter[I]) - Ord('A') + 1
    else if (Letter[I] >= 'a') and (Letter[I] <= 'z') then
      Result := Result * 26 + Ord(Letter[I]) - Ord('a') + 1
    else
    begin
      Result := 0;
      Exit;
    end;
  end;
end;

function NumberToLetter(Number: Integer): String;
begin
  Result := '';
  while Number > 0 do
  begin
    Result := Chr(Ord('A') + (Number - 1) mod 26) + Result;
    Number := (Number - 1) div 26;
  end;
end;


To increment a letter code, use:

Code: Select all

  Code := NumberToLetter(LetterToNumber(Code) + 1);


Hello,
You can try thic class, it uses a TStringList.

Usage:

Code: Select all

 
..
uses ...,UEnums;
...
test: TCodeEnumerator; //object
...
test:= TCodeEnumerator.Create('TST');
...
code := test.next; //return value is: TSU
code := test.prev; //return value is: TSS
...


Class unit:

Code: Select all

unit UEnums;

interface
uses Classes;

type
  TCodeEnumerator = class
  private
    FCodeList: TStringList;
  public
    Value: string;

    constructor Create(InitValue: string='000');
    destructor Destroy; override;

    function Next: string;
    function Prev: string;

  end;

implementation

{ TCodeEnumerator }

constructor TCodeEnumerator.Create(InitValue: string);
begin
  inherited Create;

  FCodeList := TStringList.Create;
  FCodeList.DelimitedText := ('0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z');

  Value := InitValue;
end;

destructor TCodeEnumerator.Destroy;
begin
  FCodeList.Free;

  inherited Destroy;
end;

function TCodeEnumerator.Next: string;
begin
  if FCodeList.IndexOf(Value[3]) < 35 then begin
    Value :=
      Value[1] +
      Value[2] +
      FCodeList.Strings[1 + FCodeList.IndexOf(Value[3])];
  end else if FCodeList.IndexOf(Value[2]) < 35 then begin
    Value :=
      Value[1] +
      FCodeList.Strings[1 + FCodeList.IndexOf(Value[2])] +
      '0';
  end else if FCodeList.IndexOf(Value[1]) < 35 then begin
    Value :=
      FCodeList.Strings[1 + FCodeList.IndexOf(Value[1])] +
      '0' +
      '0';
  end else
    Value := 'ZZZ';

  Result := Value;

end;

function TCodeEnumerator.Prev: string;
begin
  if FCodeList.IndexOf(Value[3]) > 0 then begin
    Value :=
      Value[1] +
      Value[2] +
      FCodeList.Strings[-1 + FCodeList.IndexOf(Value[3])];
  end else if FCodeList.IndexOf(Value[2]) > 0 then begin
    Value :=
      value[1] +
      FCodeList.Strings[-1 + FCodeList.IndexOf(Value[2])] +
      'Z';
  end else if FCodeList.IndexOf(Value[1]) > 0 then begin
    Value :=
      FCodeList.Strings[-1 + FCodeList.IndexOf(Value[1])] +
      'Z' +
      'Z';
  end else
    Value := '000';

  Result := Value;
end;

end.



Hi actalk and Kambiz

UEnums unit can work ,

Thank you so much for your quick reply.
Have a good day.

psomkuan