home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / XLSAdapter / USheetNameList.pas < prev    next >
Pascal/Delphi Source File  |  2002-05-04  |  3KB  |  136 lines
  1. unit USheetNameList;
  2.  
  3. interface
  4. uses classes, SysUtils, XlsMessages, contnrs;
  5.  
  6. type
  7.   TWideContainer= record
  8.     S: WideString;
  9.     n: integer;
  10.   end;
  11.   PWideContainer= ^TWideContainer;
  12.  
  13.   TSheetNameList=class(TList) //Items are TWideContainer
  14.   protected
  15.     procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  16.     function GetFullName(const S: WideString; const N: integer): WideString;
  17.   public
  18.     procedure Add(const aName: WideString); //Error if duplicated entry
  19.     function AddUniqueName(const aName: WideString): WideString;
  20.  
  21.     function FindRootString(const S: WideString; var Index: Integer): Boolean; virtual;
  22.     function FindFullString(const S: WideString; var Index: Integer): Boolean; virtual;
  23.   end;
  24.  
  25. implementation
  26.  
  27. { TSheetNameList }
  28.  
  29. procedure TSheetNameList.Add(const aName: WideString);
  30. var
  31.   InsPos: integer;
  32.   Itm: PWideContainer;
  33. begin
  34.   if FindFullString(AName, InsPos) then raise Exception.CreateFmt(ErrDuplicatedSheetName, [string(aName)]);
  35.   New(Itm);
  36.   Itm.S:=aName;
  37.   Itm.n:=0;
  38.   Insert( InsPos, Itm );
  39. end;
  40.  
  41. function TSheetNameList.AddUniqueName(const aName: WideString): WideString;
  42. var
  43.   InsPos, Dummy: integer;
  44.   Itm: PWideContainer;
  45.   n:integer;
  46. begin
  47.   n:=0;
  48.   if FindRootString(aName, InsPos) then
  49.   begin
  50.     n:=PWideContainer(Items[InsPos]).n+1;
  51.     while FindFullString(GetFullName(aName, n), Dummy) do inc(n);
  52.   end;
  53.   New(Itm);
  54.   Itm.S:=aName;
  55.   Itm.n:=n;
  56.   Insert( InsPos, Itm );
  57.   Result:=GetFullName(aName,n);
  58. end;
  59.  
  60. function MyCompareWideStrings(const s1,s2: WideString): integer;
  61. var
  62.   i:integer;
  63. begin
  64.   Result:=0;
  65.   if Length(S1)<Length(S2) then Result:=-1 else if Length(S1)>Length(S2) then Result:=1
  66.   else
  67.   for i:=1 to Length(S1) do
  68.   begin
  69.     if S1[i]=S2[i] then continue
  70.     else if S1[i]<S2[i] then Result:=-1 else Result:=1;
  71.     exit;
  72.   end;
  73. end;
  74.  
  75. function TSheetNameList.FindFullString(const S: WideString;
  76.   var Index: Integer): Boolean;
  77. var
  78.   L, H, I, C: Integer;
  79. begin
  80.   Result := False;
  81.   L := 0;
  82.   H := Count - 1;
  83.   while L <= H do
  84.   begin
  85.     I := (L + H) shr 1;
  86.     C := MyCompareWideStrings(GetFullName(PWideContainer(Items[I]).S, PWideContainer(Items[I]).N), S);
  87.     if C < 0 then L := I + 1 else
  88.     begin
  89.       H := I - 1;
  90.       if C = 0 then
  91.       begin
  92.         Result := True;
  93.       end;
  94.     end;
  95.   end;
  96.   Index := L;
  97. end;
  98.  
  99. function TSheetNameList.FindRootString(const S: WideString;
  100.   var Index: Integer): Boolean;
  101. var
  102.   L, H, I, C: Integer;
  103. begin
  104.   Result := False;
  105.   L := 0;
  106.   H := Count - 1;
  107.   while L <= H do
  108.   begin
  109.     I := (L + H) shr 1;
  110.     C := MyCompareWideStrings(PWideContainer(Items[I]).S, S);
  111.     if C < 0 then L := I + 1 else
  112.     begin
  113.       H := I - 1;
  114.       if C = 0 then
  115.       begin
  116.         Result := True;
  117.       end;
  118.     end;
  119.   end;
  120.   Index := L;
  121. end;
  122.  
  123.  
  124. function TSheetNameList.GetFullName(const S: WideString; const N: integer): WideString;
  125. begin
  126.   if n=0 then Result:= S else Result:= S+IntToStr(n);
  127. end;
  128.  
  129. procedure TSheetNameList.Notify(Ptr: Pointer; Action: TListNotification);
  130. begin
  131.   if Action = lnDeleted then Dispose(PWideContainer(Ptr));
  132.   inherited Notify(Ptr, Action);
  133. end;
  134.  
  135. end.
  136.