fctreeview.pas

一套及时通讯的原码

function TfcTreeNode.GetFirstChild: TfcTreeNode;
begin
  with FOwner do
    Result := GetNode(TreeView_GetChild(Handle, ItemId));
end;

function TfcTreeNode.GetLastChild: TfcTreeNode;
var
  Node: TfcTreeNode;
begin
  Result := GetFirstChild;
  if Result <> nil then
  begin
    Node := Result;
    repeat
      Result := Node;
      Node := Result.GetNextSibling;
    until Node = nil;
  end;
end;

function TfcTreeNode.GetNext: TfcTreeNode;
var
  NodeID, ParentID: HTreeItem;
  Handle: HWND;
begin
  Handle := FOwner.Handle;
  NodeID := TreeView_GetChild(Handle, ItemId);
  if NodeID = nil then NodeID := TreeView_GetNextSibling(Handle, ItemId);
  ParentID := ItemId;
  while (NodeID = nil) and (ParentID <> nil) do
  begin
    ParentID := TreeView_GetParent(Handle, ParentID);
    NodeID := TreeView_GetNextSibling(Handle, ParentID);
  end;
  Result := FOwner.GetNode(NodeID);
end;

function TfcTreeNode.GetPrev: TfcTreeNode;
var
  Node: TfcTreeNode;
begin
  Result := GetPrevSibling;
  if Result <> nil then
  begin
    Node := Result;
    repeat
      Result := Node;
      Node := Result.GetLastChild;
    until Node = nil;
  end else
    Result := Parent;
end;

function TfcTreeNode.GetAbsoluteIndex: Integer;
var
  Node: TfcTreeNode;
begin
  if Owner.FNodeCache.CacheNode = Self then
    Result := Owner.FNodeCache.CacheIndex
  else begin
    Result := -1;
    Node := Self;
    while Node <> nil do
    begin
      Inc(Result);
      Node := Node.GetPrev;
    end;
  end;
end;

function TfcTreeNode.GetIndex: Integer;
var
  Node: TfcTreeNode;
begin
  Result := -1;
  Node := Self;
  while Node <> nil do
  begin
    Inc(Result);
    Node := Node.GetPrevSibling;
  end;
end;

function TfcTreeNode.GetItem(Index: Integer): TfcTreeNode;
begin
  Result := GetFirstChild;
  while (Result <> nil) and (Index > 0) do
  begin
    Result := GetNextChild(Result);
    Dec(Index);
  end;
  if Result = nil then TreeViewError(SListIndexError);
end;

procedure TfcTreeNode.SetItem(Index: Integer; Value: TfcTreeNode);
begin
  item[Index].Assign(Value);
end;

function TfcTreeNode.IndexOf(Value: TfcTreeNode): Integer;
var
  Node: TfcTreeNode;
begin
  Result := -1;
  Node := GetFirstChild;
  while (Node <> nil) do
  begin
    Inc(Result);
    if Node = Value then Break;
    Node := GetNextChild(Node);
  end;
  if Node = nil then Result := -1;
end;

function TfcTreeNode.GetCount: Integer;
var
  Node: TfcTreeNode;
begin
  Result := 0;
  Node := GetFirstChild;
  while Node <> nil do
  begin
    Inc(Result);
    Node := Node.GetNextChild(Node);
  end;
end;

procedure TfcTreeNode.EndEdit(Cancel: Boolean);
begin
  TreeView_EndEditLabelNow(Handle, Cancel);
end;

procedure TfcTreeNode.InternalMove(ParentNode, Node: TfcTreeNode;
  HItem: HTreeItem; AddMode: TfcAddMode);
var
  I: Integer;
  NodeId: HTreeItem;
  TreeViewItem: TTVItem;
  Children: Boolean;
  IsSelected: Boolean;
begin
  { if ParentNode = Node then Exit; }
  Owner.ClearCache;
  if (AddMode = fctaInsert) and (Node <> nil) then
    NodeId := Node.ItemId else
    NodeId := nil;
  Children := HasChildren;
  IsSelected := Selected;
  if (Parent <> nil) and (Parent.CompareCount(1)) then
  begin
    Parent.Expanded := False;
    Parent.HasChildren := False;
  end;
  with TreeViewItem do
  begin
    mask := TVIF_PARAM;
    hItem := ItemId;
    lParam := 0;
  end;
  TreeView_SetItem(Handle, TreeViewItem);
  with Owner do
    HItem := AddItem(HItem, NodeId, CreateItem(Self), AddMode);
  if HItem = nil then
    raise EOutOfResources.Create(sInsertError);
  for I := Count - 1 downto 0 do
    Item[I].InternalMove(Self, nil, HItem, fctaAddFirst);
  TreeView_DeleteItem(Handle, ItemId);
  FItemId := HItem;
  Assign(Self);
  HasChildren := Children;
  Selected := IsSelected;
end;

procedure TfcTreeNode.MoveTo(Destination: TfcTreeNode; Mode: TfcNodeAttachMode);
var
  AddMode: TfcAddMode;
  Node: TfcTreeNode;
  HItem: HTreeItem;
  OldOnChanging: TfcTVChangingEvent;
  OldOnChange: TfcTVChangedEvent;
begin
  OldOnChanging := TreeView.OnChanging;
  OldOnChange := TreeView.OnChange;
  TreeView.OnChanging := nil;
  TreeView.OnChange := nil;
  try
    if (Destination = nil) or not Destination.HasAsParent(Self) then
    begin
      AddMode := fctaAdd;
      if (Destination <> nil) and not (Mode in [fcnaAddChild, fcnaAddChildFirst]) then
        Node := Destination.Parent else
        Node := Destination;
      case Mode of
        fcnaAdd,
        fcnaAddChild: AddMode := fctaAdd;
        fcnaAddFirst,
        fcnaAddChildFirst: AddMode := fctaAddFirst;
        fcnaInsert:
          begin
            Destination := Destination.GetPrevSibling;
            if Destination = Self then exit;
            if Destination = nil then AddMode := fctaAddFirst
            else AddMode := fctaInsert;
          end;
        fcnaInsertAfter:
          begin
            if Destination.GetNextSibling = nil then AddMode := fctaAdd
            else AddMode := fctaInsert;
          end;
      end;
      if Node <> nil then
        HItem := Node.ItemId else
        HItem := nil;
      InternalMove(Node, Destination, HItem, AddMode);
      Node := Parent;
      if Node <> nil then
      begin
        Node.HasChildren := True;
        Node.Expanded := True;
      end;
    end;
  finally
    TreeView.OnChanging := OldOnChanging;
    TreeView.OnChange := OldOnChange;
    Invalidate;
  end;
end;

procedure TfcTreeNode.MakeVisible;
begin
  TreeView_EnsureVisible(Handle, ItemId);
end;

function TfcTreeNode.GetLevel: Integer;
var
  Node: TfcTreeNode;
begin
  Result := 0;
  Node := Parent;
  while Node <> nil do
  begin
    Inc(Result);
    Node := Node.Parent;
  end;
end;

function TfcTreeNode.IsNodeVisible: Boolean;
var
  Rect: TRect;
begin
  Result := TreeView_GetItemRect(Handle, ItemId, Rect, True);
end;

function TfcTreeNode.EditText: Boolean;
begin
  Result := TreeView_EditLabel(Handle, ItemId) <> 0;
end;

{function TfcTreeNode.ShowBlankImage: boolean;
begin
  result:= not ((TreeView.Images<>nil) and (ImageIndex=-2));
end;
}
function TfcTreeNode.DisplayRect(TextOnly: Boolean): TRect;
begin
  FillChar(Result, SizeOf(Result), 0);
  TreeView_GetItemRect(Handle, ItemId, Result, TextOnly);

  { Special case of imageindex=-2, do not show blank image }
  if TextOnly and (TreeView.Images<>nil) and not TreeView.UseImages(self) then
      result.Left:= result.Left - TImageList(TreeView.Images).Width-1
end;

function TfcTreeNode.AlphaSort: Boolean;
begin
  Result := CustomSort(nil, 0);
end;

function TfcTreeNode.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
var
  SortCB: TTVSortCB;
begin
  Owner.ClearCache;
  with SortCB do
  begin
    if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
    else lpfnCompare := SortProc;
    hParent := ItemId;
    lParam := Data;
  end;
  Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
end;

procedure TfcTreeNode.Delete;
begin
  if not Deleting then Free;
end;

procedure TfcTreeNode.DeleteChildren;
begin
  Owner.ClearCache;
  TreeView_Expand(TreeView.Handle, ItemID, TVE_COLLAPSE or TVE_COLLAPSERESET);
  HasChildren := False;
end;

procedure TfcTreeNode.Assign(Source: TPersistent);
var
  Node: TfcTreeNode;
begin
  Owner.ClearCache;
  if Source is TfcTreeNode then
  begin
    Node := TfcTreeNode(Source);
    Text := Node.Text;
    Data := Node.Data;
    CheckboxType:= Node.CheckboxType;  { 4/26/99 - Do before assign State Index }
    StringData:= Node.StringData;
    StringData2:= Node.StringData2;
    ImageIndex := Node.ImageIndex;
    SelectedIndex := Node.SelectedIndex;
    StateIndex := Node.StateIndex;
    OverlayIndex := Node.OverlayIndex;
    Focused := Node.Focused;
    DropTarget := Node.DropTarget;
    Cut := Node.Cut;
    HasChildren := Node.HasChildren;
//    CheckboxType:= Node.CheckboxType;
    Checked:= Node.Checked;
  end
  else inherited Assign(Source);
end;

{function TfcTreeNode.IsEqual(Node: TfcTreeNode): Boolean;
begin
  Result := (Text = Node.Text) and (Data = Node.Data);
end;
}
procedure TfcTreeNode.ReadData(Stream: TStream; Info: PfcNodeInfo);
var
  I, Size, ItemCount: Integer;
  StrBuffer: PChar;
  Temp: Integer;
  UseExpanded:Boolean;
begin
  Owner.ClearCache;
  Stream.ReadBuffer(Size, SizeOf(Size));

  { 7/6/99 - Save for fcTreeCombo streaming }
  {$ifdef fcDelphi4Up}
  ReadDataSize:= Size;
  {$endif}

  { RSW - Advance if somehow size is greater than node size }
  Stream.ReadBuffer(Info^, fcmin(Size, SizeOf(Info^)));
  Temp := SizeOf(TfcNodeInfo) - (255 - Length(Info^.Text));

  { Support StringData property }
  if Info^.StringDataSize1>0 then
  begin
     StrBuffer:= StrAlloc(Info^.StringDataSize1+1);
     StrBuffer[Info^.StringDataSize1]:= #0;
     Stream.ReadBuffer(StrBuffer^, Info^.StringDataSize1);
     StringData:= StrPas(StrBuffer);
     StrDispose(StrBuffer);
  end
  else StringData:= '';

  { Support StringData property }
  if Info^.StringDataSize2>0 then
  begin
     StrBuffer:= StrAlloc(Info^.StringDataSize2+1);
     StrBuffer[Info^.StringDataSize2]:= #0;
     Stream.ReadBuffer(StrBuffer^, Info^.StringDataSize2);
     StringData2:= StrPas(StrBuffer);
     StrDispose(StrBuffer);
  end
  else StringData2:= '';

  Text := Info^.Text;
  ImageIndex := Info^.ImageIndex;
  SelectedIndex := Info^.SelectedIndex;
  StateIndex := Info^.StateIndex;
  OverlayIndex := Info^.OverlayIndex;
  Data := Info^.Data;
  ItemCount := Info^.Count;
  CheckboxType:= Info^.CheckboxType;
  Checked:= (Info^.Checked and $01)<>0;

  Grayed:= (Info^.Checked and $02)<>0;

  UseExpanded:= Info^.Expanded;

  for I := 0 to ItemCount - 1 do
    with Owner.AddChild(Self, '') do ReadData(Stream, Info);

  // 1/31/2002-PYW-Added new property to respect expanded node settings.
  if (Owner.Owner<>nil) and (Owner.Owner.StreamExpandedNode) then
     Expanded := UseExpanded;

  if TreeView.StreamVersion=1 then
     if Size > Temp then Stream.Position:= Stream.Position + (Size - Temp);
end;

Function TfcTreeNode.GetSizeOfNodeInfo: integer;
begin
  result:= SizeOf(TfcNodeInfo);
end;