おげんきですか、かとちんです。＼(^0^)／



過去ログファイルから情報を集計する際に作成しました。しかし実際には
使わなくなりましたが勿体ない（？）のでアップします。ﾅﾝﾉｺｯﾁｬ

常に昇順ソートされる数値のリストです。リスト項目にはコンストラクタで
指定したサイズのメモリも確保します。例えばユーザが用意した構造体を
使うなどにでも使用してください。必要なければゼロを指定すればデータは
何も使いません。追加時のレスポンスが普通のリストよりも時間がかかると
思いますが二分検索法により高速に追加が行われます。

名称としては「常時ソート済みの無重複な Integer 型の値を持った、付随
データを持てる高速なリスト」...やたら長い名前ですので TSNDNumList
（Sorted No Duplicate Numbers(and datas) List）と省略しました。

--SNDNumList.pas------------------------------------------------------
unit SNDNumList;

interface

uses
  SysUtils, Classes, Dialogs;

type
  TSNDNumList = class
  private
    FList: PPointerList;
    FDatas: PPointerList;
    FDataSize: Integer;
    FCount: Integer;
    function Find(Value: Integer; var Index: Integer): Boolean;
    function GetDatas(Index: Integer): Pointer;
    function GetItems(Index: Integer): Integer;
    procedure SetItems(Index: Integer; const Value: Integer);
  public
    constructor Create(DataSize: Integer); reintroduce;
    destructor Destroy; override;
    property Items[Index: Integer]: Integer read GetItems
      write SetItems; default;
    property Datas[Index: Integer]: Pointer read GetDatas;
    function IndexOf(Value: Integer): Integer;
    function Add(Value: Integer): Integer;
    procedure Delete(Index: Integer);
    function Remove(Value: Integer): Integer;
    procedure Clear;
    property List: PPointerList read FList;
    property Count: Integer read FCount;
  end;

implementation

uses
  Consts;

const
  MAX_DATASIZE = 100;       // 持たせるデータの最大サイズ

{ TSNDNumList }

constructor TSNDNumList.Create(DataSize: Integer);
begin
  if (DataSize < 0) or (DataSize > MAX_DATASIZE) then
    raise Exception.Create(
      'TSNDNumList.Create: DataSize が不正です(0〜'+
      IntToStr(MAX_DATASIZE)+'まで)');
  inherited Create;
  FDataSize := DataSize;
end;

destructor TSNDNumList.Destroy;
begin
  Clear;
  inherited;
end;

function TSNDNumList.Add(Value: Integer): Integer;
begin
  // 検索してソートを保つ
  if not Find(Value, Result) then begin
    Inc(FCount);
    ReallocMem(FList, FCount*Sizeof(Pointer));
    if FDataSize > 0 then ReallocMem(FDatas, FCount*Sizeof(Pointer));
    if Result < FCount then begin
      Move(FList^[Result], FList^[Result+1],
        (FCount-1-Result)*Sizeof(Pointer));
      if FDataSize > 0 then
        Move(FDatas^[Result], FDatas^[Result+1],
          (FCount-1-Result)*Sizeof(Pointer));
    end;
    FList^[Result] := Pointer(Value);
    if FDataSize > 0 then begin
      FDatas^[Result] := nil;
      GetMem(FDatas^[Result], FDataSize);
      FillChar(FDatas^[Result]^, FDataSize, 0);
    end;
  end;
end;

procedure TSNDNumList.Clear;
var
  I: Integer;
begin
  if FDataSize > 0 then begin
    for I := FCount-1 downto 0 do begin
      FreeMem(FDatas^[I]);
    end;
    ReallocMem(FDatas, 0);
  end;
  ReallocMem(FList, 0);
  FCount := 0;
end;

procedure TSNDNumList.Delete(Index: Integer);
begin
  if (Index < 0) and (Index > FCount) then
    TList.Error('TSNDNumList.Delete: '+SListIndexError, Index);
  if FDataSize > 0 then
  begin
    FreeMem(FDatas^[Index]);
    Move(FDatas^[Index+1], FDatas^[Index],
(FCount-1-Index)*Sizeof(Pointer));
    ReallocMem(FDatas, (FCount-1)*Sizeof(Pointer));
  end;
  Move(FList^[Index+1], FList^[Index],
(FCount-1-Index)*Sizeof(Pointer));
  ReallocMem(FList, (FCount-1)*Sizeof(Pointer));

  Dec(FCount);
end;

// Value の存在する行があれば、True を存在しなければ False を返却す
る。
// Index には、見つかった位置か、見つからなかった場合でも Value が挿入
される候補の位置を返却する
function TSNDNumList.Find(Value: Integer; var Index: Integer):
Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Integer(FList^[I]) - Value;
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        L := I;
        Result := True;
      end;
    end;
  end;
  Index := L;
end;

function TSNDNumList.GetDatas(Index: Integer): Pointer;
begin
  if FDataSize = 0 then
  begin
    Result := nil;
    Exit;
  end;
  if (Index < 0) and (Index > FCount) then
    TList.Error('TSNDNumList.GetDatas: '+SListIndexError, Index);
  Result := FDatas^[Index];
end;

function TSNDNumList.GetItems(Index: Integer): Integer;
begin
  if (Index < 0) and (Index > FCount) then
    TList.Error('TSNDNumList.GetItems: '+SListIndexError, Index);
  Result := Integer(FList^[Index]);
end;

function TSNDNumList.IndexOf(Value: Integer): Integer;
begin
  if not Find(Value, Result) then Result := -1;
end;

function TSNDNumList.Remove(Value: Integer): Integer;
begin
  if not Find(Value, Result) then
  begin
    Result := -1;
    Exit;
  end;
  Delete(Result);
end;

procedure TSNDNumList.SetItems(Index: Integer; const Value: Integer);
begin
  if (Index < 0) and (Index > FCount) then
    TList.Error('TSNDNumList.SetItems: '+SListIndexError, Index);
  FList^[Index] := Pointer(Value);
end;

end.
----------------------------------------------------------------------

▲●       2000/02/28 14:43 JDX06162(とんちんかんちんかとちん)
 ■        http://pc2.techno-ware-unet.ocn.ne.jp/~kato/
Inprise Delphi ... The Great Development Kit
uses D2Desktop, D3CSS, D4CSS, D5ENT;

Original document by かとちん        氏 ID:(JDX06162)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。