fctreeview.pas

一套及时通讯的原码

procedure TfcTreeNode.WriteData(Stream: TStream; Info: PfcNodeInfo);
var
  Size, L, ItemCount: Integer;
  Node: TfcTreeNode;
begin
  L := Length(Text);
  if L > 255 then L := 255;
  Size := GetSizeOfNodeInfo + L - 255;
//  Size := SizeOf(TfcNodeInfo) + L - 255;
  FillChar(Info^, SizeOf(TfcNodeInfo), 0);
  Info^.Text := Text;
  Info^.ImageIndex := ImageIndex;
  Info^.SelectedIndex := SelectedIndex;
  Info^.OverlayIndex := OverlayIndex;
  Info^.StateIndex := StateIndex;
  Info^.Data := Data;
  ItemCount := Count;
  Info^.Count := ItemCount;
  Info^.CheckboxType:= CheckboxType;
  Info^.Checked:= ord(Checked) + $02 * Ord(Grayed);
  Info^.Expanded := Expanded;
  Info^.StringDataSize1:= length(StringData);
  Info^.StringDataSize2:= length(StringData2);
  Stream.WriteBuffer(Size, SizeOf(Size));
  Stream.WriteBuffer(Info^, Size);

  { Support StringData properties }
  if Info^.StringDataSize1>0 then begin
     Stream.WriteBuffer(PChar(StringData)^, length(StringData));
  end;

  if Info^.StringDataSize2>0 then begin
     Stream.WriteBuffer(PChar(StringData2)^, length(StringData2));
  end;

  Node := GetFirstChild;
  while Node <> nil do
  begin
    Node.WriteData(Stream, Info);
    Node := Node.GetNextSibling;
  end;

//  for I := 0 to ItemCount - 1 do Item[I].WriteData(Stream, Info);
end;

{ TfcTreeNodes }

constructor TfcTreeNodes.Create(AOwner: TfcCustomTreeView);
begin
  inherited Create;
  FOwner := AOwner;
end;

destructor TfcTreeNodes.Destroy;
begin
  InDestroy:= True;
  Clear;
//  FOwner := nil;
  inherited Destroy;
end;

function TfcTreeNodes.GetCount: Integer;
begin
  if Owner.HandleAllocated then Result := TreeView_GetCount(Handle)
  else Result := 0;
end;

function TfcTreeNodes.GetHandle: HWND;
begin
  Result := Owner.Handle;
end;

procedure TfcTreeNodes.Delete(Node: TfcTreeNode);
begin
  if (Node.ItemId = nil) then
    Owner.Delete(Node);
  Node.Delete;
end;

procedure TfcTreeNodes.Clear;
var PrevNode, Node: TfcTreeNode;
begin
  ClearCache;
  if { (Owner <> nil) and ksw - prevent problem }Owner.HandleAllocated then
  begin
     if count<=0 then exit;

     Owner.SkipChangeMessages:= True;

     try
        BeginUpdate;

        Owner.Selected:= nil;

        { Clearing by scanning backwards seems to be significantly faster }
        { TreeView_DeleteAllItem's current implementation is slower than this
        { technique. Scanning forwards is also slower. }
        Node := GetFirstNode;
        Owner.TopItem:= Node;

        { Retrieve last node }
        while Node.GetNextSibling <> nil do Node:= Node.GetNextSibling;
        while Node.GetNext <> nil do Node:= Node.GetNext;

        While Node<>Nil do
        begin
            PrevNode:= Node;
            Node := Node.GetPrev;
            TreeView_DeleteItem(PrevNode.Handle, PrevNode.ItemId);
        end;
     finally
        Owner.SkipChangeMessages:= False;
        if not inDestroy then EndUpdate;
     end
  end
end;

{procedure TfcTreeNodes.Clear;
begin
  ClearCache;
  if Owner.HandleAllocated then
    TreeView_DeleteAllItems(Handle);
end;}

function TfcTreeNodes.AddChildFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
begin
  Result := AddChildObjectFirst(Node, S, nil);
end;

function TfcTreeNodes.AddChildObjectFirst(Node: TfcTreeNode; const S: string;
  Ptr: Pointer): TfcTreeNode;
begin
  Result := InternalAddObject(Node, S, Ptr, fctaAddFirst);
end;

function TfcTreeNodes.AddChild(Node: TfcTreeNode; const S: string): TfcTreeNode;
begin
  Result := AddChildObject(Node, S, nil);
end;

function TfcTreeNodes.AddChildObject(Node: TfcTreeNode; const S: string;
  Ptr: Pointer): TfcTreeNode;
begin
  Result := InternalAddObject(Node, S, Ptr, fctaAdd);
end;

function TfcTreeNodes.AddFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
begin
  Result := AddObjectFirst(Node, S, nil);
end;

function TfcTreeNodes.AddObjectFirst(Node: TfcTreeNode; const S: string;
  Ptr: Pointer): TfcTreeNode;
begin
  if Node <> nil then Node := Node.Parent;
  Result := InternalAddObject(Node, S, Ptr, fctaAddFirst);
end;

function TfcTreeNodes.Add(Node: TfcTreeNode; const S: string): TfcTreeNode;
begin
  Result := AddObject(Node, S, nil);
end;

procedure TfcTreeNodes.Repaint(Node: TfcTreeNode);
var
  R: TRect;
begin
  if FUpdateCount < 1 then
  begin
    while (Node <> nil) and not Node.IsVisible do Node := Node.Parent;
    if Node <> nil then
    begin
      R := Node.DisplayRect(False);
      InvalidateRect(Owner.Handle, @R, True);
    end;
  end;
end;

function TfcTreeNodes.AddObject(Node: TfcTreeNode; const S: string;
  Ptr: Pointer): TfcTreeNode;
begin
  if Node <> nil then Node := Node.Parent;
  Result := InternalAddObject(Node, S, Ptr, fctaAdd);
end;

function TfcTreeNodes.Insert(Node: TfcTreeNode; const S: string): TfcTreeNode;
begin
  Result := InsertObject(Node, S, nil);
end;

procedure TfcTreeNodes.AddedNode(Value: TfcTreeNode);
begin
  if Value <> nil then
  begin
    Value.HasChildren := True;
    Repaint(Value);
  end;
end;

function TfcTreeNodes.InsertObject(Node: TfcTreeNode; const S: string;
  Ptr: Pointer): TfcTreeNode;
var
  Item, ItemId: HTreeItem;
  Parent: TfcTreeNode;
  AddMode: TfcAddMode;
begin
  Result := Owner.CreateNode;
  try
    Item := nil;
    ItemId := nil;
    Parent := nil;
    AddMode := fctaInsert;
    if Node <> nil then
    begin
      Parent := Node.Parent;
      if Parent <> nil then Item := Parent.ItemId;
      Node := Node.GetPrevSibling;
      if Node <> nil then ItemId := Node.ItemId
      else AddMode := fctaAddFirst;
    end;
    Result.Data := Ptr;
    Result.Text := S;
    Item := AddItem(Item, ItemId, CreateItem(Result), AddMode);
    if Item = nil then
      raise EOutOfResources.Create(sInsertError);
    Result.FItemId := Item;
    AddedNode(Parent);
    if not Owner.MultiSelectCheckboxNeeded(Result) then
       Result.StateIndex:= -1; { 5/15/98 - Required since its not initialized to -1}
  except
    Result.Free;
    raise;
  end;
end;

function TfcTreeNodes.InternalAddObject(Node: TfcTreeNode; const S: string;
  Ptr: Pointer; AddMode: TfcAddMode): TfcTreeNode;
var
  Item: HTreeItem;
begin
  Result := Owner.CreateNode;
  try
    if Node <> nil then Item := Node.ItemId
    else Item := nil;
    Result.Data := Ptr;
    Result.Text := S;
    Item := AddItem(Item, nil, CreateItem(Result), AddMode);
    if Item = nil then
      raise EOutOfResources.Create(sInsertError);
    Result.FItemId := Item;
    AddedNode(Node);
    if not Owner.MultiSelectCheckboxNeeded(Result) then
       Result.StateIndex:= -1; { 5/15/98 - Required since its not initialized to -1}
  except
    Result.Free;
    raise;
  end;
end;

function TfcTreeNodes.CreateItem(Node: TfcTreeNode): TTVItem;
begin
  Node.FInTree := True;
  with Result do
  begin
    mask := TVIF_TEXT or TVIF_PARAM or TVIF_IMAGE or TVIF_SELECTEDIMAGE;
    lParam := Longint(Node);
    pszText := LPSTR_TEXTCALLBACK;
    iImage := I_IMAGECALLBACK;
    iSelectedImage := I_IMAGECALLBACK;
  end;
end;

function TfcTreeNodes.AddItem(Parent, Target: HTreeItem;
  const Item: TTVItem; AddMode: TfcAddMode): HTreeItem;
var
  InsertStruct: TTVInsertStruct;
begin
  ClearCache;
  with InsertStruct do
  begin
    hParent := Parent;
    case AddMode of
      fctaAddFirst:
        hInsertAfter := TVI_FIRST;
      fctaAdd:
        hInsertAfter := TVI_LAST;
      fctaInsert:
        hInsertAfter := Target;
    end;
  end;
  InsertStruct.item := Item;
  FOwner.FChangeTimer.Enabled := False;
  Result := TreeView_InsertItem(Handle, InsertStruct);
end;

function TfcTreeNodes.GetFirstNode: TfcTreeNode;
begin
  Result := GetNode(TreeView_GetRoot(Handle));
end;

function TfcTreeNodes.GetNodeFromIndex(Index: Integer): TfcTreeNode;
var
  I: Integer;
begin
  if Index < 0 then TreeViewError(sInvalidIndex);
  if (FNodeCache.CacheNode <> nil) and (Abs(FNodeCache.CacheIndex - Index) <= 1) then
  begin
    with FNodeCache do
    begin
      if Index = CacheIndex then Result := CacheNode
      else if Index < CacheIndex then Result := CacheNode.GetPrev
      else Result := CacheNode.GetNext;
    end;
  end
  else begin
    Result := GetFirstNode;
    I := Index;
    while (I <> 0) and (Result <> nil) do
    begin
      Result := Result.GetNext;
      Dec(I);
    end;
  end;
  if Result = nil then TreeViewError(sInvalidIndex);
  FNodeCache.CacheNode := Result;
  FNodeCache.CacheIndex := Index;
end;

function TfcTreeNodes.GetNode(ItemId: HTreeItem): TfcTreeNode;
var
  Item: TTVItem;
begin
  with Item do
  begin
    hItem := ItemId;
    mask := TVIF_PARAM;
  end;
  if TreeView_GetItem(Handle, Item) then Result := TfcTreeNode(Item.lParam)
  else Result := nil;
end;

procedure TfcTreeNodes.SetItem(Index: Integer; Value: TfcTreeNode);
begin
  GetNodeFromIndex(Index).Assign(Value);
end;

procedure TfcTreeNodes.BeginUpdate;
begin
  if FUpdateCount = 0 then SetUpdateState(True);
  Inc(FUpdateCount);
end;

procedure TfcTreeNodes.SetUpdateState(Updating: Boolean);
begin
  SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then Owner.Refresh;
end;

procedure TfcTreeNodes.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount = 0 then SetUpdateState(False);
end;

procedure TfcTreeNodes.Assign(Source: TPersistent);
var
  TreeNodes: TfcTreeNodes;
  MemStream: TMemoryStream;
begin
  ClearCache;

  { 12/1/98 (RSW) Clear treeview display }
  SendMessage(Owner.Handle, WM_ERASEBkgnd, Owner.Canvas.Handle, 0);

  if Source is TfcTreeNodes then
  begin
    Owner.FStreamVersion:= 1;

    TreeNodes := TfcTreeNodes(Source);
    Clear;
    MemStream := TMemoryStream.Create;
    try
      TreeNodes.WriteData(MemStream);
      MemStream.Position := 0;
      ReadData(MemStream);
    finally
      MemStream.Free;
    end;
  end
  else inherited Assign(Source);

  if Count>0 then Owner.Selected:= Owner.Items[0];
  Owner.invalidate;
  // RSW - 1/13/99 Make sure some node is selected as the treeview common control
  // has problems in repainting in certain cases if no control has the selection

end;

procedure TfcTreeNodes.DefineProperties(Filer: TFiler);
{
  function WriteNodes: Boolean;
  var
    I: Integer;
    Nodes: TfcTreeNodes;
  begin
    Nodes := TfcTreeNodes(Filer.Ancestor);