checktreeview.pas

CheckTreeView 控件

  I: Integer;
begin
  I := Pos( C, S );
  Result := I > 0;
  if Result then
    Delete( S, I, 1 );
end;

constructor TCheckCustomTreeView.Create( AOwner: TComponent );
begin
  inherited;
  {&RCI}
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;

  FSelectionPen := TPen.Create;
  FSelectionPen.Color := clBtnShadow;
  FSelectionPen.Style := psSolid;
  FSelectionPen.OnChange := PenChanged;

  FDisabledColor := clBtnFace;
  FFocusColor := clWindow;
  FNormalColor := clWindow;

  TabStop := True;
  ParentColor := False;
end;


destructor TCheckCustomTreeView.Destroy;
  {$IFDEF DELPHI5}
  procedure FreeNode(ANode: TTreeNode);
  var
    NextChild: TTreeNode;
  begin
    NextChild := ANode.GetFirstChild;
    while Assigned(NextChild) do
    begin
      FreeNode(NextChild);
      NextChild := NextChild.GetNext;
    end;
    Self.Delete(ANode);
  end;

  procedure FreeNodeData;
  var
    RootNode: TTreeNode;
  begin
    RootNode := Items.GetFirstNode;
    while Assigned(RootNode) do
    begin
      FreeNode(RootNode);
      RootNode := RootNode.GetNextSibling;
    end;
  end;
  {$ENDIF}

begin
  FCanvas.Free;
  FSelectionPen.Free;

  {$IFDEF DELPHI5}
  if HandleAllocated and Assigned( Items ) then
    FreeNodeData;
  {$ENDIF}

  inherited;
end;

procedure TCheckCustomTreeView.Loaded;
begin
  inherited;
  UpdateColors;
end;


procedure TCheckCustomTreeView.Notification( AComponent: TComponent; Operation: TOperation );
begin
  inherited;
end;


function TCheckCustomTreeView.DoMouseWheelDown( Shift: TShiftState; MousePos: TPoint ): Boolean;
var
  Info: TScrollInfo;
begin
  Info.cbSize := SizeOf( Info );
  Info.fMask := sif_Pos;

  if GetScrollInfo( Handle, sb_Vert, Info ) then
  begin
    Info.nPos := Info.nPos + Mouse.WheelScrollLines;
    SendMessage( Handle, wm_VScroll, MakeLong( sb_ThumbPosition, Info.nPos ), 0 );

    SetScrollInfo( Handle, sb_Vert, Info, True );
  end;
  Result := True;
end;


function TCheckCustomTreeView.DoMouseWheelUp( Shift: TShiftState; MousePos: TPoint ): Boolean;
var
  Info: TScrollInfo;
begin
  Info.cbSize := SizeOf( Info );
  Info.fMask := sif_Pos;

  if GetScrollInfo( Handle, sb_Vert, Info ) then
  begin
    Info.nPos := Info.nPos - Mouse.WheelScrollLines;
    if Info.nPos >= 0 then
    begin
      SendMessage( Handle, wm_VScroll, MakeLong( sb_ThumbPosition, Info.nPos ), 0 );
      SetScrollInfo( Handle, sb_Vert, Info, True );
    end;
  end;
  Result := True;
end;


function TCheckCustomTreeView.GetAutoExpand: Boolean;
begin
  Result := inherited AutoExpand;
end;


procedure TCheckCustomTreeView.SetAutoExpand( Value: Boolean );
begin
  inherited AutoExpand := Value;
  if AutoExpand then
    FAutoSelect := False;
end;


procedure TCheckCustomTreeView.SetAutoSelect( Value: Boolean );
begin
  if FAutoSelect <> Value then
  begin
    FAutoSelect := Value;
    if FAutoSelect then
      AutoExpand := False;
  end;
end;


function TCheckCustomTreeView.GetColor: TColor;
begin
  Result := inherited Color;
end;


procedure TCheckCustomTreeView.SetColor( Value: TColor );
begin
  if Color <> Value then
  begin
    inherited Color := Value;
    if not FUpdatingColor then
    begin
      if FFocusColor = FNormalColor then
        FFocusColor := Value;
      FNormalColor := Value;
    end;
  end;
end;


function TCheckCustomTreeView.IsColorStored: Boolean;
begin
  Result := Enabled;
end;


function TCheckCustomTreeView.IsFocusColorStored: Boolean;
begin
  Result := ( ColorToRGB( FFocusColor ) <> ColorToRGB( Color ) );
end;

procedure TCheckCustomTreeView.SetDisabledColor( Value: TColor );
begin
  FDisabledColor := Value;
  if not Enabled then
    UpdateColors;
end;


procedure TCheckCustomTreeView.SetFocusColor( Value: TColor );
begin
  FFocusColor := Value;
  if Focused then
    UpdateColors;
end;

procedure TCheckCustomTreeView.SetSelectionPen( Value: TPen );
begin
  FSelectionPen.Assign( Value );
  Invalidate;
end;


procedure TCheckCustomTreeView.PenChanged( Sender: TObject );
begin
  Invalidate;
end;


function TCheckCustomTreeView.UseThemes: Boolean;
begin
  Result := ThemeServices.ThemesEnabled;
end;


procedure TCheckCustomTreeView.CMEnabledChanged( var Msg: TMessage );
begin
  inherited;
  UpdateColors;
end;


procedure TCheckCustomTreeView.WMNCPaint( var Msg: TWMNCPaint );
begin
  inherited;
end; 

procedure TCheckCustomTreeView.WMPaint( var Msg: TWMPaint );
var
  R: TRect;
begin
  inherited;

  if not HideSelection and not Focused and ( Selected <> nil ) then
  begin
    FCanvas.Handle := Msg.DC;                 { Map canvas onto device context }
    try
      R := Selected.DisplayRect( True );

      FCanvas.Pen := FSelectionPen;
      FCanvas.Brush.Style := bsClear;
      FCanvas.Rectangle( R.Left, R.Top, R.Right, R.Bottom );
      FCanvas.Pen.Width := 1;
      FCanvas.Pen.Style := psSolid;
    finally
      FCanvas.Handle := 0;
    end;
  end;
end;


procedure TCheckCustomTreeView.UpdateColors;
begin
  if csLoading in ComponentState then
    Exit;

  FUpdatingColor := True;
  try
    if not Enabled then
      Color := FDisabledColor
    else if Focused then
      Color := FFocusColor
    else
      Color := FNormalColor;
  finally
    FUpdatingColor := False;
  end;
end;

procedure TCheckCustomTreeView.CMEnter( var Msg: TCMEnter );
begin
  inherited;
end;

procedure TCheckCustomTreeView.CMExit( var Msg: TCMExit );
begin
  inherited;
end;


procedure TCheckCustomTreeView.MouseEnter;
begin
  if Assigned( FOnMouseEnter ) then
    FOnMouseEnter( Self );
end;

procedure TCheckCustomTreeView.CMMouseEnter( var Msg: TMessage );
begin
  inherited;
  {$IFDEF VCL70_OR_HIGHER}
  if csDesigning in ComponentState then
    Exit;
  {$ENDIF}
  MouseEnter;
end;

procedure TCheckCustomTreeView.MouseLeave;
begin
  if Assigned( FOnMouseLeave ) then
    FOnMouseLeave( Self );
end;


procedure TCheckCustomTreeView.Collapse( Node: TTreeNode );
begin
  if FAutoSelect then
    Node.Selected := True;
  inherited;
end;


procedure TCheckCustomTreeView.Expand( Node: TTreeNode );
begin
  inherited;
  if FAutoSelect then
    Node.Selected := True;
end;


procedure TCheckCustomTreeView.FullCollapse;
var
  SaveAutoSelect: Boolean;
begin
  SaveAutoSelect := FAutoSelect;
  FAutoSelect := False;
  inherited;
  FAutoSelect := SaveAutoSelect;
end;


procedure TCheckCustomTreeView.FullExpand;
var
  SaveAutoSelect: Boolean;
begin
  SaveAutoSelect := FAutoSelect;
  FAutoSelect := False;
  inherited;
  FAutoSelect := SaveAutoSelect;
end;


procedure TCheckCustomTreeView.CMMouseLeave( var Msg: TMessage );
begin
  {&RV}
  inherited;
  MouseLeave;
end;

procedure TCheckCustomTreeView.WMSize( var Msg: TWMSize );
begin
  inherited;
end;


function TCheckCustomTreeView.PathFromNode( Node: TTreeNode ): string;
begin
  if Node <> nil then
  begin
    Result := Node.Text + '\';
    while Node.Parent <> nil do
    begin
      Node := Node.Parent;
      Result := Node.Text + '\' + Result;
    end;
  end
  else
    Result := '';
end;


function TCheckCustomTreeView.NodeFromPath( Path: string ): TTreeNode;
var
  OldCursor: TCursor;
  I: Integer;
  Found: Boolean;
  Node, SearchNode, MatchingNode: TTreeNode;
  FindPath: string;
begin
  Result := nil;

  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    if LastChar( Path ) <> '\' then
      Path := Path + '\';
    Path := AnsiUpperCase( Path );

    Node := nil;

    for I := 1 to CountChar( '\', Path ) do
    begin
      FindPath := CopyEx( Path, 1, '\', I );
      MatchingNode := nil;
      if Items.Count > 0 then
      begin
        if Node <> nil then
          SearchNode := Node.GetFirstChild
        else
          SearchNode := Items[ 0 ];

        Found := False;
        while not Found and ( SearchNode <> nil ) do
        begin
          if AnsiUpperCase( PathFromNode( SearchNode ) ) = FindPath then
          begin
            MatchingNode := SearchNode;
            Found := True;
          end;
          SearchNode := SearchNode.GetNextSibling;
        end;
      end;

      Node := MatchingNode;
      if Node = nil then
        Exit;
    end;
    Result := Node;
  finally
    Screen.Cursor := OldCursor;
  end;
end;


procedure TCheckCustomTreeView.SelectByPath( const Path: string );
var
  Node: TTreeNode;
begin
  Node := NodeFromPath( Path );
  if Node <> nil then
    Node.Selected := True;
end;


procedure TCheckCustomTreeView.UpdateStateIndexDisplay( Node: TTreeNode );
var
  I: Integer;
  Item: TTVItem;
  Value: Integer;
begin
  Value := Node.StateIndex;
  if Value >= 0 then
    Dec( Value );
  with Item do
  begin
    mask := TVIF_STATE or TVIF_HANDLE;
    stateMask := TVIS_STATEIMAGEMASK;
    hItem := Node.ItemId;
    state := IndexToStateImageMask( Value + 1 );
  end;
  TreeView_SetItem( Node.TreeView.Handle, Item );

  for I := 0 to Node.Count - 1 do
  begin
    if Node.Item[ I ].HasChildren then
      UpdateStateIndexDisplay( Node.Item[ I ] )
    else
    begin
      Value := Node.Item[ I ].StateIndex;
      if Value >= 0 then
        Dec( Value );
      with Item do
      begin
        mask := TVIF_STATE or TVIF_HANDLE;
        stateMask := TVIS_STATEIMAGEMASK;
        hItem := Node.Item[ I ].ItemId;
        state := IndexToStateImageMask( Value + 1 );
      end;
      TreeView_SetItem( Node.TreeView.Handle, Item );
    end;
  end;
end;


procedure TCheckCustomTreeView.InvalidateNode( Node: TTreeNode; TextOnly: Boolean; EraseBkgnd: Boolean );
var
  R: TRect;
begin
  R := Node.DisplayRect( TextOnly );
  InvalidateRect( Handle, @R, EraseBkgnd );
end;


procedure TCheckCustomTreeView.CMSysColorChange( var Msg: TMessage );
begin
  inherited;
  if Color < 0 then
    Perform( cm_ColorChanged, Msg.wParam, Msg.lParam );
end;


procedure TCheckCustomTreeView.CNNotify( var Msg: TWMNotify );