drawtreedemo.pas

来自「本系统前端界面采用WINDOWS 窗口风格」· PAS 代码 · 共 746 行 · 第 1/2 页

          pf8bit:
            Data.Properties := Data.Properties + ', 256 colors';
          pf15bit:
            Data.Properties := Data.Properties + ', 32K colors';
          pf16bit:
            Data.Properties := Data.Properties + ', 64K colors';
          pf24bit:
            Data.Properties := Data.Properties + ', 16M colors';
          pf32bit:
            Data.Properties := Data.Properties + ', 16M+ colors';
        end;
        if Cardinal(Data.Image.Height) + 4 > TVirtualDrawTree(Sender).DefaultNodeHeight then
            Sender.NodeHeight[Node] := Data.Image.Height + 4;
      except
        Data.Image.Free;
        Data.Image := nil;
      end;
    finally
      Picture.Free;
    end;
  end;
  Data.Attributes := ReadAttributes(Data.FullPath);
  if ((Data.Attributes and SFGAO_HASSUBFOLDER) <> 0) or
    (((Data.Attributes and SFGAO_FOLDER) <> 0) and HasChildren(Data.FullPath)) then
    Include(InitialStates, ivsHasChildren);

end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);

var
  Data: PShellObjectData;
  
begin
  Data := Sender.GetNodeData(Node);
  Data.Image.Free;
  Finalize(Data^); // Clear string data.
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1DrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);

// This is the main paint routine for a node in a draw tree. There is nothing special here. Demonstrating the
// specific features of a draw tree (compared to the string tree) is a bit difficult, since the only difference is
// that the draw tree does not handle node content (captions in the case of the string tree).

var
  Data: PShellObjectData;
  X: Integer;
  S: WideString;
  R: TRect;

begin   
  with Sender as TVirtualDrawTree, PaintInfo do
  begin
    Data := Sender.GetNodeData(Node);
    if (Column = FocusedColumn) and (Node = FocusedNode) then
      Canvas.Font.Color := clHighlightText
    else
      if (Data.Attributes and SFGAO_COMPRESSED) <> 0 then
        Canvas.Font.Color := clBlue
      else
        Canvas.Font.Color := clWindowText;

    SetBKMode(Canvas.Handle, TRANSPARENT);
    
    R := ContentRect;
    InflateRect(R, -TextMargin, 0);
    Dec(R.Right);
    Dec(R.Bottom);
    S := '';
    case Column of
      0, 2:
        begin
          if Column = 2 then
          begin
            if Assigned(Data.Image) then
              S:= Data.Properties;
          end
          else
            S := Data.Display;
          if Length(S) > 0 then
          begin
            with R do
            begin
              if (NodeWidth - 2 * Margin) > (Right - Left) then
                S := ShortenString(Canvas.Handle, S, Right - Left, False);
            end;
            DrawTextW(Canvas.Handle, PWideChar(S), Length(S), R, DT_TOP or DT_LEFT or DT_VCENTER or DT_SINGLELINE, False);
          end;
        end;
      1:
        begin
          if Assigned(Data.Image) then
          begin
            X := ContentRect.Left + (VDT1.Header.Columns[1].Width - Data.Image.Width - Margin) div 2;
            BitBlt(Canvas.Handle, X, ContentRect.Top + 2, Data.Image.Width, Data.Image.Height, Data.Image.Canvas.Handle,
              0, 0, SRCCOPY);
          end;
        end;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1GetNodeWidth(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  var NodeWidth: Integer);

// Since the draw tree does not know what is in a cell, we have to return the width of the content (not the entire
// cell width, this could be determined by the column width).

var
  Data: PShellObjectData;
  AMargin: Integer;

begin
  with Sender as TVirtualDrawTree do
    AMargin := TextMargin;

  begin
    Data := Sender.GetNodeData(Node);
    case Column of
      0:
        begin
          if Node.Parent = Sender.RootNode then
            NodeWidth := Canvas.TextWidth(Data.FullPath) + 2 * AMargin
          else
            NodeWidth := Canvas.TextWidth(ExtractFileName(Data.FullPath)) + 2 * AMargin;
        end;
      1:
        begin
          if Assigned(Data.Image) then
            NodeWidth := Data.Image.Width;
        end;
      2:
        NodeWidth := Canvas.TextWidth(Data.Properties) + 2 * AMargin;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);

// Called just before a node with children (only folder nodes can have children) is expanded.

var
  Data,
  ChildData: PShellObjectData;
  SR: TSearchRec;
  ChildNode: PVirtualNode;
  NewName: String;

begin
  Data := Sender.GetNodeData(Node);
  if FindFirst(IncludeTrailingBackslash(Data.FullPath) + '*.*', faAnyFile, SR) = 0 then
  begin
    Screen.Cursor := crHourGlass;
    try
      repeat
        if (SR.Name <> '.') and (SR.Name <> '..') then
        begin
          NewName := IncludeTrailingBackslash(Data.FullPath) + SR.Name;
          if (SR.Attr and faDirectory <> 0) or CanDisplay(NewName) then
          begin
            ChildNode := Sender.AddChild(Node);
            ChildData := Sender.GetNodeData(ChildNode);
            ChildData.FullPath := NewName;
            ChildData.Attributes := ReadAttributes(NewName);
            if (ChildData.Attributes and SFGAO_FOLDER) = 0 then
              ChildData.Properties := Format('%n KB, ', [SR.Size / 1024]);
            GetOpenAndClosedIcons(ChildData.FullPath, ChildData.OpenIndex, ChildData.CloseIndex);

            Sender.ValidateNode(Node, False);
          end;
        end;
      until FindNext(SR) <> 0;
      ChildCount := Sender.ChildCount[Node];

      // finally sort node
      if ChildCount > 0 then
        Sender.Sort(Node, 0, TVirtualStringTree(Sender).Header.SortDirection, False);
    finally
      FindClose(SR);
      Screen.Cursor := crDefault;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
  Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer);

// Returns the proper node image which has been determine on initialization time. Also overlay images are
// used properly for shared folders.

var
  Data: PShellObjectData;
  
begin
  if Column = 0 then
  begin
    Data := Sender.GetNodeData(Node);
    case Kind of
      ikNormal,
      ikSelected:
        begin
          if Sender.Expanded[Node] then
            Index := Data.OpenIndex
          else
            Index := Data.CloseIndex;
        end;
      ikOverlay:
        if (Data.Attributes and SFGAO_SHARE) <> 0 then
          Index := 0
        else
          if (Data.Attributes and SFGAO_LINK) <> 0 then
            Index := 1;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1GetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect);

// Draw trees must manage parts of the hints themselves. Here we return the size of the hint window we want to show
// or an empty rectangle in the case we don't want a hint at all.

var
  Data: PShellObjectData;
  
begin
  Data := Sender.GetNodeData(Node);
  if Assigned(Data) and Assigned(Data.Image) and (Column = 1) then
    R := Rect(0, 0, 2 * Data.Image.Width, 2 * Data.Image.Height)
  else
    R := Rect(0, 0, 0, 0);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1DrawHint(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; R: TRect;
  Column: TColumnIndex);

// Here we actually paint the hint. It is the image in a larger size.

var
  Data: PShellObjectData;

begin
  Data := Sender.GetNodeData(Node);
  if Assigned(Data) and Assigned(Data.Image) and (Column = 1) then
  begin
    SetStretchBltMode(Canvas.Handle, HALFTONE);
    StretchBlt(Canvas.Handle, 0, 0, 2 * Data.Image.Width, 2 * Data.Image.Height, Data.Image.Canvas.Handle, 0, 0,
      Data.Image.Width, Data.Image.Height, SRCCOPY);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1CompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
  var Result: Integer);

// The node comparison routine is the heart of the tree sort. Here we have to tell the caller which node we consider
// being "larger" or "smaller".

var
  Data1,
  Data2: PShellObjectData;

begin
  Data1 := Sender.GetNodeData(Node1);
  Data2 := Sender.GetNodeData(Node2);

  // Folder are always before files. Check if *both* are folders or *both* are non-folders, but not different.
  if ((Data1.Attributes xor Data2.Attributes) and SFGAO_FOLDER) <> 0 then
  begin
    // One of both is a folder the other is a file.
    if (Data1.Attributes and SFGAO_FOLDER) <> 0 then
      Result := -1
    else
      Result := 1;
  end
  else
    // Both are of same type (folder or file). Just compare captions.
    // Note that we use ANSI comparison, while the strings are Unicode. Since this will implicitely convert the captions
    // to ANSI for comparation it might happen that the sort order is wrong for names which contain text in a language
    // other than the current OS language. A full blown Unicode comparison is beyond the scope of this demo.
    Result := CompareText(Data1.FullPath, Data2.FullPath);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1HeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);

// Click handler to switch the column on which will be sorted. Since we cannot sort image data sorting is actually
// limited to the main column.

begin
  if Button = mbLeft then
  begin
    with Sender do
    begin
      if Column <> MainColumn then
        SortColumn := NoColumn
      else
      begin
        if SortColumn = NoColumn then
        begin
          SortColumn := Column;
          SortDirection := sdAscending;
        end
        else
          if SortDirection = sdAscending then
            SortDirection := sdDescending
          else
            SortDirection := sdAscending;
        Treeview.SortTree(SortColumn, SortDirection, False);
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.TrackBar1Change(Sender: TObject);

// This part has nothing to do with the tree content and is only to show the effect of vertical image alignment for nodes
// (since this does not justify an own demo).
// Btw: look how fast this stuff is. Even with several thousands of nodes you still can adjust the position interactively.

var
  Run: PVirtualNode;

begin
  Label3.Caption := Format('%d%%', [Trackbar1.Position]);
  with VDT1, Trackbar1 do
  begin
    BeginUpdate;
    try
      Run := GetFirst;
      while Assigned(Run) do
      begin
        VerticalAlignment[Run] := Position;
        Run := GetNextVisible(Run);
      end;
    finally
      EndUpdate;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDrawTreeForm.VDT1StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);

begin
  if not (csDestroying in ComponentState) then
    UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;

//----------------------------------------------------------------------------------------------------------------------

end.