この発言に対し以下のコメントが寄せられています

#01058　凛              さん　RE:ツリー表示用のクラス:使用例

#01062　凛              さん　RE:ツリー表示用のクラス




{ツリー表示する完全オリジナルなクラスです。(単に捜すのが面倒だった(^^;)
掲示板などで発言をTree表示するのに汎用的に使えると思ったので上げて
おきます。使用サンプルもいっしょに上げておくのでご利用下さい。
サンプルとして上げるため機能は最小限にしています。
行数を減らすためにインデントやコメントも普通じゃない状態ですがご容赦下さ
い。ご自由に拡張してお使い下さい。
}
unit kTrees_small;
interface
uses SysUtils, Classes;
const
  lnTitle=40;//タイトルのバイト数
  lnWho  =20;//発言者名のバイト数
type
  TKTIndex=Record
    Index:integer;
    Title:string[lnTitle];//タイトル
    Day:TDateTime;//
    resTo:integer;//レス対象 ルートの場合 -1
    From:integer; //contents内の位置
    Size:integer; //サイズ
    Layer:integer;//階層
    Who:string[lnWho];//発言者
  end;
  PKTIndex=^TKTIndex;
  TKTree=Class(TObject)
  private
    FZZ:integer; //ルート発言にツリー線付ける際に使うフラグ
    FPath:string; //データディレクトリ
    List:TList;//全タイトルレコードをぶら下げるためのList
    bufList:TStringList;//集計したタイトルリストを保持するためのもの
    FShowRootLine: boolean;
    procedure ClearList;
    function ListIndexOf(SayIndex:integer):integer;
    procedure LoadIndexFile;
    function GetCount: integer;//インデックスファイルからListに読み込む
    procedure SaveIndex;
    procedure setShowRootLine(const Value: boolean);
  public
    //ListIndexから発言番号得る
    function SayIndexOf(ListIndex:integer):integer;
    //リストインデックスを指定して発言内容を得る
    function LoadCtsListIndex(Index: integer): string;
    //発言を追加 ResToが0だとルートになります。
    function AddComment(idxData:TKTIndex;data:string):boolea;
    procedure MakeNewFiles;//新しくidxとctsファイルを作る
    //指定範囲のタイトルツリー形式を得る 範囲はListIndexにて、、
    function LoadIdx(startIndex,endIndex:integer):TStringList;
    //データのフォルダを指定してCreateする
    constructor Create(folderPath:string);Virtual;
    destructor Destroy;overRide;//Free時に保存してます。
    property Count:integer read GetCount;
    property ShowRootLine:boolean read FShowRootLine 
                                  write setShowRootLine;
  end;
implementation
const
  idxFN='Index.dat';  //サンプルなのでファイル名はこの名前に決め打ち
  cntFN='content.dat';
function TKTree.AddComment(idxData: TKTIndex;data:string):boolean;
var
  pIndex:PKTIndex;
  f:File;
  loc:integer;
  InsertIndex:integer;
  Layer:integer;
  function GetInsertIndex(idx:integer):integer;
  var j:integer;
  begin
    Layer:=0;
    result:=ListIndexOf(idx);
    if result<>-1 then begin
      Layer:=PKTIndex(List[result])^.Layer+1;
      if result=List.Count-1 then result:=-1 else
      begin
        j:=1;
        while (result+j<List.Count-1) do begin
          if PKTIndex(List[result+j])^.Layer < Layer then begin
            result:=result+j;
            break;
          end;
          inc(j);
        end;
      end;
    end;
  end;
begin
  result:=False;
  if not FileExists(FPath+cntFN) then Exit;
  assignFile(f,FPath+cntFN);
  reset(f,1);
  try
    loc:=FileSize(f);
    seek(f,loc);
    BlockWrite(f,PChar(data)^,Length(data));
    new(pIndex);
    pIndex^:=idxData;
    pIndex^.From:=loc;
    pIndex^.Size:=Length(data);
    pIndex^.Day:=now;
    pIndex^.Index:=List.Count+1;
    pIndex^.Layer:=0;
    //発言番号は1から始まるのでresToはmaxList.Countまで可能
    if (pIndex^.resTo>0) and (pIndex^.resTo<=List.Count) then begin
      //ルート発言のインデックスを得る
      InsertIndex:=GetInsertIndex(pIndex^.resTo);
      pIndex^.Layer:=Layer;//GetInsertIndexで設定している
      if InsertIndex<>-1 then begin
       List.Insert(InsertIndex,pIndex);
      end else List.Add(pIndex);
    end else List.Add(pIndex);
    result:=True;
  finally closeFile(f); end;
end;
procedure TKTree.ClearList;
var i:integer;
begin
  for i:= 0 to List.Count-1 do Dispose(PKTIndex(List[i]));
end;
constructor TKTree.Create(folderPath: string);
begin
  ShowRootLine:=false;
  List:=TList.Create;
  FPath:=folderPath;
  if not IsDelimiter('\',FPath,Length(FPath)) then FPath:=FPath+'\';
  bufList:=TStringList.Create;
  LoadIndexFile;
end;
destructor TKTree.Destroy;
begin
  SaveIndex;
  ClearList;
  List.Free;
  bufList.Free;
  inherited;
end;
function TKTree.GetCount: integer;
begin
  result:=List.Count;
end;
function TKTree.SayIndexOf(ListIndex: integer): integer;
begin
  if (ListIndex<0) or (ListIndex>List.Count-1) then result:=-1 else
  result:=PKTIndex(List[ListIndex])^.Index;
end;
//指定発言番号のリスト上でのIndexを返す
function TKTree.ListIndexOf(SayIndex: integer): integer;
var
  i:integer;
begin
  result:=-1;
  for i:= 0 to List.Count-1 do begin
    if PKTIndex(List[i])^.Index=SayIndex then begin
      result:=i;
      break;
    end;
  end;
end;
//Listの指定Indexの内容を得る
function TKTree.LoadCtsListIndex(Index:integer):string;
var
  f:file;
  buf:PChar;
begin
  result:='';
  if Index<> -1 then begin
    assignFile(f,FPath+cntFN);
    reset(f,1);
    try
      buf:=StrAlloc(PKTIndex(List[Index])^.Size+1);
      try
        seek(f,PKTIndex(List[Index])^.From);
        BlockRead(f,buf^,PKTIndex(List[Index])^.Size);
        buf[PKTIndex(List[Index])^.Size]:=#0;
        result:=String(buf);
      finally StrDispose(buf);end;
    finally closeFile(f);end;
  end;
end;
function TKTree.LoadIdx(startIndex, endIndex: integer): TStringList;
const space='  ';//２バイトでないとだめです。
var
  i,sp,currLayer:integer;
  currHead,hook,curr:string;
begin
  bufList.Clear;
  if List.Count=0 then Exit;
  for i:= EndIndex downto startIndex do  begin
    with PKTIndex(List[i])^ do begin
      if (not FShowRootLine) and (Layer=0) then begin
        currHead:='';
        currLayer:=Layer;
        hook:='';
      end
      else
      if i=endIndex then begin
        currLayer:=Layer;
        currHead:='';
        for sp:= 1 to currLayer-Fzz do currHead:=currHead+space;
        hook:='└';
      end
      else
      if currLayer=Layer then hook:='├'
      else
      if currLayer<Layer then //右にシフト
      begin
        hook:='└';
        if Fzz<>0 then begin
          if Layer<>1 then currHead:=currHead+'│' else currHead:='';
        end
        else begin
          currHead:=currHead+'│';
        end;
        for sp:= 0 to (Layer-CurrLayer)-2 do currHead:=currHead+space;
        currLayer:=Layer;
      end
      else begin//currLayer>Layer   左にシフト
        if copy(currHead,Length(currHead)-1,2)='│' then hook:='├'
        else hook:='└';
        currLayer:=Layer;
        currHead:=Copy(currHead,1,(currLayer-Fzz)*2);
      end;
      curr:=currHead+Hook+Format('%d %6d %20S %40S',
                                 [Index,layer,Who,Title]);
      bufList.InsertObject(0,curr,Pointer(i));//List上のIndexを渡す
    end;
  end;
  result:=bufList;
end;
procedure TKTree.LoadIndexFile;
var
  f:file of TKTIndex;
  curr:PKTIndex;
begin
  clearList;
  if not FileExists(FPath+idxFN) then MakeNewFiles;
  AssignFile(f,FPath+idxFN); //↑無ければ新規
  reset(f);
  try
    while not eof(f) do begin
      new(curr);
      read(f,curr^);
      List.Add(curr);
    end;
  finally closeFile(f);end;
end;
procedure TKTree.MakeNewFiles;
var
  f:file;
  idx:file Of PKTIndex;
begin
  assignFile(f,FPath+cntFN);
  rewrite(f);
  closeFile(f);
  assignFile(idx,FPath+idxFN);
  rewrite(idx);
  closeFile(idx);
end;
procedure TKTree.SaveIndex;
var
  f:file of TKTIndex;
  i:integer;
begin
  AssignFile(f,FPath+idxFN);
  rewrite(f);
  try
    for i:=0 to List.Count-1 do
      write(f,PKTIndex(List[i])^);
  finally closeFile(f); end;
end;
procedure TKTree.setShowRootLine(const Value: boolean);
begin
  FShowRootLine := Value;
  if value then FZZ:=0 else FZZ:=1;
end;
end.
                                 00/05/01(月) 16:08 凛(MXB01744)

Original document by 凛              氏 ID:(MXB01744)

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