Subversion Repositories fastphp

unit FastPHPTreeView;

interface

uses

  SysUtils, Classes, ComCtrls;

(*

<FastPHPData>    ::= <FastPHPData100> .

Version 1.00 (signature "FAST100!"):

<FastPHPData100> ::= <Signature100> ( <Nodes> <Exit> | <Exit> ) .

<Signature100>   ::= "F" "A" "S" "T" "1" "0" "0" "!" .

<Nodes>          ::= <Node> | ( <Nodes> <Node> ) .

<Node>           ::= <LeafNode> | ( <LeafNode> <IncreaseLevel> <Nodes> <DecreaseLevel> ) .

<LeafNode>       ::= "N" <Icon> <LineNo> <DescLen> <Desc> .

<IncreaseLevel>  ::= "I" .

<DecreaseLevel>  ::= "D" .

<Exit>           ::= "X" .

<LineNo>         ::= <Int8> .

<DescLen>        ::= <Int4> .

<Desc>           ::= (Utf8-String) .

<Icon>           ::= <NoIcon> | <ImageIndex> .

<NoIcon>         ::= "_" "_" "_" "_" .

<ImageIndex>     ::= <Int4> .

<Int1>           ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .

<Int2>           ::= <Int1> <Int1> .

<Int4>           ::= <Int2> <Int2> .

<Int8>           ::= <Int4> <Int4> .

*)

type

  TTreeViewFastPHP = class helper for TTreeView

  private

    class function Read(var ptr: PChar; len: integer): string; inline;

    procedure Rec100(tn: TTreeNode; var ptr: PChar);

  protected

    procedure DoFillWithFastPHPData(ptr: PChar);

  public

    procedure FillWithFastPHPData(data: string);

  end;

  EFastNodeException = class(Exception);

implementation

uses

  StrUtils, Windows;

const

  LEN_MAGIC   = 8;

  LEN_ICON    = 4;

  LEN_LINENO  = 8;

  LEN_DESCLEN = 4;

{$EXTERNALSYM LockWindowUpdate}

function LockWindowUpdate(hWndLock: HWND): BOOL; stdcall; external user32 name 'LockWindowUpdate';

function HexToInt(HexNum: string): LongInt;

begin

  Result := StrToInt('$' + HexNum);

end;

procedure TTreeViewFastPHP.DoFillWithFastPHPData(ptr: PChar);

  function _NodeID(tn: TTreeNode): string;

  var

    tmp: TTreeNode;

  begin

    // Attention: This function requires that the tree node items are unique

    //            e.g. Class1->function1() is unique

    result := tn.Text;

    tmp := tn.Parent;

    while tmp <> nil do

    begin

      result := tmp.Text + #0 + result;

      tmp := tmp.Parent;

    end;

  end;

var

  s: String;

  tn: TTreeNode;

  expanded: TStringList;

  selected, magic: string;

  horPos, verPos: integer;

  i: integer;

  crc32: string;

begin

  // No update if the user is dragging the scrollbar

  // (otherwise the program will somehow lock up)

  if GetCapture = Handle then exit;

  // Don't rebuild the treeview if nothing has changed (use the Tag property to store the CRC32)

  crc32 := Read(ptr, 8);

  if crc32 = IntToHex(Tag, 8) then exit;

  Tag := HexToInt(crc32);

  selected := '';

  expanded := TStringList.Create;

  horPos := GetScrollPos(Handle, SB_HORZ);

  verPos := GetScrollPos(Handle, SB_VERT);

  LockWindowUpdate(Parent.Handle); // Parent is better choice for FastPHP... but for other applications it might be wrong?

  Self.Items.BeginUpdate;

  try

    {$REGION 'Remember our current state (selected and expanded flags)'}

    for i := 0 to Self.Items.Count-1 do

    begin

      tn := Self.Items.Item[i];

      s := _NodeID(tn);

      if tn.Selected then selected := s;

      if tn.Expanded and tn.HasChildren then expanded.Add(s);

    end;

    {$ENDREGION}

    {$REGION 'Update the treeview'}

    Self.Items.Clear;

    try

      magic := Read(ptr, LEN_MAGIC);

      if magic = 'FAST100!' then

        Rec100(nil, ptr)

      else

        raise EFastNodeException.CreateFmt('FastNode version "%s" not supported.', [magic]);

    except

      on E: Exception do

      begin

        Self.Items.Clear;

        tn := Self.Items.Add(nil, 'ERROR: ' + E.Message);

        tn.ImageIndex := -1;

        tn.SelectedIndex := -1;

      end;

    end;

    {$ENDREGION}

    {$REGION 'Recover the previous current state (selected and expanded flags)'}

    for i := 0 to Self.Items.Count-1 do

    begin

      tn := Self.Items.Item[i];

      s := _NodeID(tn);

      if selected = s then tn.Selected := true;

      if expanded.IndexOf(s) >= 0 then tn.Expand(false);

    end;

    {$ENDREGION}

  finally

    Self.Items.EndUpdate;

    LockWindowUpdate(0);

    SetScrollPos(Handle, SB_HORZ, horPos, false);

    SetScrollPos(Handle, SB_VERT, verPos, false);

    expanded.Free;

  end;

end;

procedure TTreeViewFastPHP.FillWithFastPHPData(data: string);

begin

  data := Trim(data);

  if not EndsStr('X', data) then raise EFastNodeException.Create('FastNode string must end with "X"');

  DoFillWithFastPHPData(PChar(data));

end;

class function TTreeViewFastPHP.Read(var ptr: PChar; len: integer): string;

begin

  result := Copy(string(ptr), 1, len);

  inc(ptr, len);

end;

procedure TTreeViewFastPHP.Rec100(tn: TTreeNode; var ptr: PChar);

var

  typ, icon, lineno, len, caption: string;

  lastTn: TTreeNode;

begin

  try

    lastTn := nil;

    while true do

    begin

      repeat

        typ := Read(ptr, 1);

      until Trim(typ) <> '';

      if typ = 'N' then // new node

      begin

        icon   := Read(ptr, LEN_ICON);

        lineno := Read(ptr, LEN_LINENO);

        len    := Read(ptr, LEN_DESCLEN);

        caption := Utf8Decode(Read(ptr, StrToInt(len)));

        if tn = nil then

          lastTn := Self.Items.Add(nil, caption)

        else

          lastTn := Self.Items.AddChild(tn, caption);

        {$REGION 'Determinate icon'}

        if icon = '____' then

          lastTn.ImageIndex := -1

        else

          lastTn.ImageIndex := StrToInt(icon);

        lastTn.SelectedIndex := lastTn.ImageIndex;

        {$ENDREGION}

        lastTn.Data := Pointer(StrToInt(lineno)); // Hack...

      end

      else if typ = 'I' then // increase level

      begin

        if LastTn = nil then raise EFastNodeException.Create('Fast100: Increase command requires previous node');

        Rec100(lastTn, ptr);

      end

      else if typ = 'D' then Exit // decrease level

      else if typ = 'X' then Abort // exit

      else raise EFastNodeException.CreateFmt('Fast100: Command "%s" unknown', [typ]);

    end;

  except

    on E: EAbort do

      if tn = nil then

        exit

      else

        raise;

    else

      raise;

  end;

end;

end.