TREEVIEW AVEC ALPHABLENDING

unit AlphaTreeView;

interface

uses
  Windows, Forms, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, ComCtrls;

type
  THoundred=0..100;
  
  TAlphaTreeView = class(TTreeView)
  private
    FParentForm:TForm;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: THoundred;
    FBuffer: TBitmap;
    FOnCustomDraw:TNotifyEvent;
    FOnCustomDrawItem:TNotifyEvent;
    FOnCollapsed:TNotifyEvent;
    FOnExpanded:TNotifyEvent;
    function GetParentForm(Child:TComponent):TForm;
    function CopyControlsImage(Parent:TForm):TBitmap;
    procedure CreateBuffer;
    procedure CustomPaint;
  protected
    procedure Paint;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure RefreshData;
    procedure SetAlphaBlend(IsAlphaBlend: Boolean);
    procedure CustDrawButton(ARect: TRect; Node: TTreeNode);
    procedure CustDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure CustDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);
    procedure CustRefresh(Sender: TObject; Node: TTreeNode);
  published
    property AlphaBlend:Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue:THoundred read FAlphaBlendValue write FAlphaBlendValue;
    property OnCustomDraw : TNotifyEvent read FOnCustomDraw write FOnCustomDraw;
    property OnCustomDrawItem : TNotifyEvent read FOnCustomDrawItem write FOnCustomDrawItem;
    property OnCollapsed : TNotifyEvent read FOnCollapsed write FOnCollapsed;
    property OnExpanded : TNotifyEvent read FOnExpanded write FOnExpanded;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('AlphaComponents', [TAlphaTreeView]);
end;

{ TAlphaTreeView }

// Méthode invoquée à la création du composant
constructor TAlphaTreeView.Create(AOwner: TComponent);
begin
  inherited;
  FOnCustomDraw:=nil;
  FOnCustomDrawItem:=nil;
  FOnCollapsed:=nil;
  FOnExpanded:=nil;

  // Les 4 lignes suivantes permettent de shunter les méthodes déclanchées par des événements
  Inherited OnCustomDraw:=CustDraw;
  Inherited OnCustomDrawItem:=CustDrawItem;
  Inherited OnCollapsed:=CustRefresh;
  Inherited OnExpanded:=CustRefresh;

  // Initialise les options du controle
  FAlphaBlend:=False;
  FAlphaBlendValue:=0;
 
  // Créer un buffer graphique
  FBuffer:=TBitmap.Create;
  RefreshData;
  Repaint;
end;

// Méthode invoquée à la destruction du composant
destructor TAlphaTreeView.Destroy;
begin
  FreeAndNil(FBuffer);
  inherited;
end;

// Procédure qui charge le buffer graphique
procedure TAlphaTreeView.CreateBuffer;
begin
  FBuffer:=CopyControlsImage(FParentForm);
end;

// Procédure qui permet de mettre à jour certaines donnée (buffer...)
procedure TAlphaTreeView.RefreshData;
begin
  FParentForm:=GetParentForm(Self);
  CreateBuffer;
end;

// Fonction qui récupère dans un canvas (TBitmap) tous les controles de type TImage de la form
function TAlphaTreeView.CopyControlsImage(Parent: TForm): TBitmap;
var I:Word;
    ChildImage:TImage;
begin
  Result:=TBitmap.Create;
  Result.Height:=Parent.ClientHeight;
  Result.Width:=Parent.ClientWidth;
  Result.Canvas.Brush.Color:=Parent.Color;
  Result.Canvas.FillRect(Parent.ClientRect);

  // Recherche tous les contrôles de type TImage qui sont dans la form
  for I:=0 to Parent.ComponentCount-1 do
  begin
    if (Parent.Components[I] is TImage) then
    begin
      // Copie le canva du TImage dans le canvas du bitmap retourné par la fontion
      ChildImage:=(Parent.Components[I] as TImage);
      Result.Canvas.Draw(ChildImage.Left,ChildImage.Top,ChildImage.Picture.Graphic);
    end;
  end;
end;

// Fonction qui permet de récupérer la form du control AlphaTreeview
function TAlphaTreeView.GetParentForm(Child: TComponent): TForm;
begin
  if Child.Owner is TForm then Result:=Child.Owner as TForm
  else Result:=GetParentForm(Child.Owner) as TForm;
end;

// Procédure perso pour désinner AlphaTreeView
procedure TAlphaTreeView.CustomPaint;
var  img:TBitmap;
     X,Y: integer;
     R,G,B: Word;
     T_R,T_G,T_B: Word;
     RGB_Value: longint;
begin
  // Si la propriété AlphaBlend du controle est vraie
  if (FAlphaBlend) then
  begin
    // Récupère le canvas de la form (juste avec les TImages)
    img:=CopyControlsImage(FParentForm);

//  BitBlt(FBuffer.Handle, 0, 0, Width, Height,img.Canvas.Handle, left, top, SrcCopy);
    // Copie le canvas de la form dans le controle AlphaTreeView et
    // ajuste la zone de dessin en fonction des bordures de AlphaTreeView
    // (sinon, risque de décalage entre les arrières plans de AlphaTreeView et de la form)
    if (BorderStyle=bsSingle) then
      BitBlt(Canvas.Handle, 0, 0, Width, Height,img.Canvas.Handle, left+2, top+2, SrcCopy)
    else
      BitBlt(Canvas.Handle, 0, 0, Width, Height,img.Canvas.Handle, left, top, SrcCopy);

    img.free;
    
    // Récupère les composantes RGB de la couleur de fond de AlphaTreeView
    T_R := GetRValue(Color);
    T_G := GetGValue(Color);
    T_B := GetBValue(Color);

    // Effectue un parcours complet des pixels du canvas du composant AlphaTreeView
    // pour appliquer un effet AlphaBlending
    for Y := 0 to Height - 1 do
    begin
      for X := 0 to Width - 1 do
      begin
        // Lecture des composantes RGB du pixel en cours
//        RGB_Value:=ColorToRGB(FBuffer.Canvas.Pixels[X,Y]);
        RGB_Value:=ColorToRGB(Canvas.Pixels[X,Y]);
        R := GetRvalue(RGB_Value);
        G := GetGValue(RGB_Value);
        B := GetBValue(RGB_Value);

        // Applique un effet Alphablending à partir de la propriété AlphaBlendValue
        R := (R * AlphaBlendValue + (100 - AlphaBlendValue) * T_R) div 100;
        G := (G * AlphaBlendValue + (100 - AlphaBlendValue) * T_G) div 100;
        B := (B * AlphaBlendValue + (100 - AlphaBlendValue) * T_B) div 100;

        // Applique la nouvelle couleur de pixel
//        FBuffer.Canvas.Pixels[X,Y] := RGB(R,G,B);
        Canvas.Pixels[X,Y] := RGB(R,G,B);
      end;
    end;

//    BitBlt(Canvas.Handle, 0, 0, Width, Height,FBuffer.Canvas.Handle, left+2, top+2, SrcCopy);


{    if (BorderStyle=bsSingle) then
      BitBlt(Canvas.Handle, 0, 0, Width, Height,FBuffer.Canvas.Handle, left+2, top+2, SrcCopy)
    else
      BitBlt(Canvas.Handle, 0, 0, Width, Height,FBuffer.Canvas.Handle, left, top, SrcCopy);
}

  end;
end;

// Procédure pour utiliser le double buffer (non utilisé pour le moment)
procedure TAlphaTreeView.Paint;
begin
if (not FAlphaBlend) or (csDesigning in ComponentState) then
  inherited
else
  begin
    CreateBuffer;
    CustomPaint;
  end;
end;

// Procédure utilisée pour dessiner le contrôle
procedure TAlphaTreeView.CustDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);
begin
  CustomPaint;
end;


procedure TAlphaTreeView.SetAlphaBlend(IsAlphaBlend: Boolean);
begin
if FAlphaBlend<>IsAlphaBlend then
  begin
    FAlphaBlend:=IsAlphaBlend;
    Invalidate;
  end;
end;


// Procédure pour dessiner les lignes/boutons de AlphaTreeView
procedure TAlphaTreeView.CustDrawButton(ARect: TRect; Node: TTreeNode);
var
  cx, cy, cx2, cy2 : Integer;
begin
//  cx := ARect.Left + Indent div 2;
//  cy := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
  // cx,cy représente le coin supérieur gauche
  cx := ARect.Left;
  cy := ARect.Top;

  with Canvas do
  begin
    Pen.Color := clGray;

    // Pour commencer, si le noeud à des enfants, on dessine un bouton pour étendre/réduire
    if Node.HasChildren then
    begin
      // Dessine le cadre du bouton extension/réduction
      cx2:=cx+5;
      cy2:=cy+2;
      PenPos := Point(cx2, cy2);
      LineTo(cx2,cy2+8);
      LineTo(cx2+8,cy2+8);
      LineTo(cx2+8,cy2);
      LineTo(cx2,cy2);

      Pen.Color := clBlack;
      // Dessine la barre horizontale ('-')
      PenPos := Point(cx2+2, cy2+4);
      LineTo(cx2+7, cy2+4);

      // Dessine la barre verticale si le noeud est réduit ('+')
      if not Node.Expanded then
      begin
        PenPos := Point(cx2+4, cy2+2);
        LineTo(cx2+4, cy2+7);
      end;
      Pen.Color := clGray;

      if Node.Parent <> nil then
      begin
        cx2 := cx + 9;
        cy2 := cy - 2;

        while (cy2 < cy + 2) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end;
    end
    // Sinon (pas d enfant), trace une barre verticale en pointillés
    else
    begin
      cx2 := cx + 9;
      if (Node.AbsoluteIndex = 0) then cy2 := cy + 6
      else cy2 := cy - 2;

      if (Node.getNextSibling <> nil) then
      begin
        while (cy2 < ARect.Bottom + 3) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end
      else begin
        while (cy2 < cy + 5) do
        begin
          PenPos := Point(cx2,cy2);
          LineTo(cx2,cy2+1);
          cy2 := cy2 + 2;
        end;
      end;
    end;

    // Pour tous les noeuds, trace une ligne horizontale en pointillés (entre le bouton et le label du noeud)
    if Node.HasChildren then cx2 := cx + 15
    else cx2 := cx + 9;
    cy2 := cy + 6;

    while (cx2 < cx + 18) do
    begin
      PenPos := Point(cx2,cy2);
      LineTo(cx2+1,cy2);
      cx2 := cx2 + 2;
    end;

    if ((Node.GetNextVisible <> nil) and (Node.GetNextVisible.Level = Node.Level))
    or (Node.GetNextSibling <> nil) then
    begin
      cx2 := cx + 9;
      cy2 := cy + 12;
      while cy2 < cy + 18 do
      begin

        PenPos := Point(cx2, cy2);
        LineTo(cx2,cy2+1);
        cy2 := cy2 + 2;
      end;
    end;

    // Connecte les sous-noeuds au noeud parent
    Node := Node.Parent;
    if Node <> nil then
    begin
      cx2 := 9;
      cy2 := ARect.Top - 2;
      while (cy2 < ARect.Bottom - 1) do
      begin
        PenPos := Point(cx2, cy2);
        LineTo(cx2, cy2 + 1);
        cy2 := cy2 + 2;
      end;
    end;
  end;
  inherited
end;

// Procédure pour dessiner les noeuds de AlphaTreeView
procedure TAlphaTreeView.CustDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  NodeRect: TRect;
begin
  DefaultDraw := false; // nécessaire pour forcer le dessin manuel des items
  with Canvas do
  begin
    if cdsSelected in State then
    begin
      NodeRect := Node.DisplayRect(True);
      FillRect(NodeRect);
    end;
    NodeRect := Node.DisplayRect(False);

    Brush.Style := bsClear;

    NodeRect.Top := NodeRect.Top+1;
    NodeRect.Left := NodeRect.Left + (Node.Level * Indent);
    // Appel à la procédure de dessin des lignes
    CustDrawButton(NodeRect, Node);

    NodeRect.Left := NodeRect.Left + Indent;

    TextOut(NodeRect.Left, NodeRect.Top, Node.Text);
  end;
  inherited
end;

procedure TAlphaTreeView.CustRefresh(Sender: TObject; Node: TTreeNode);
begin
  Repaint;
end;

end.