Is it possible to Alpha Blend a VCL control on a TForm?

Question

Is it possible to Alpha Blend or implement a similar effect for a VCL control on a TForm?

For example, consider the following screenshot where two TPanels are placed on a TForm in addition to other controls. Both the panels are made draggable (See How to Move and Resize Controls at Run Time).

Now, is it possible to make these panels translucent while dragging so that you can see what is underneath? (as shown in the second image which was produced by image manipulation)

Answer 1

The VCL gives you the opportunity to specify a drag image list to be used during drag-and-drop, here's a quick example:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TPanel = class(Vcl.ExtCtrls.TPanel)
  protected
    function GetDragImages: TDragImageList; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Label1: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure PanelStartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure PanelEndDrag(Sender, Target: TObject; X, Y: Integer);
  private
    FDragImages: TDragImageList;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TPanel }

function TPanel.GetDragImages: TDragImageList;
begin
  Result := (Owner as TForm1).FDragImages;
end;

type
  TControlProc = reference to procedure(Control: TControl);

procedure IterateControls(Control: TControl; Proc: TControlProc);
var
  I: Integer;
begin
  if Assigned(Control) then
    Proc(Control);
  if Control is TWinControl then
    for I := 0 to TWinControl(Control).ControlCount - 1 do
      IterateControls(TWinControl(Control).Controls[I], Proc);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDragImages := nil;
  // set display drag image style
  IterateControls(Self,
    procedure(Control: TControl)
    begin
      Control.ControlStyle := Control.ControlStyle + [csDisplayDragImage];
    end
  );
end;

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TPanel;
end;

procedure TForm1.PanelEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  FreeAndNil(FDragImages);
end;

procedure TForm1.PanelStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  Image: TBitmap;
begin
  if not (Sender is TPanel) then
    Exit;

  Image := TBitmap.Create;
  try
    Image.PixelFormat := pf32bit;
    Image.Width := TControl(Sender).Width;
    Image.Height := TControl(Sender).Height;
    TPanel(Sender).PaintTo(Image.Canvas, 0, 0);

    FDragImages := TDragImageList.Create(nil);
    FDragImages.Width := Image.Width;
    FDragImages.Height := Image.Height;
    FDragImages.SetDragImage(FDragImages.Add(Image, nil), 0, 0);
    FDragImages.ShowDragImage;
  except
    Image.Free;
    FreeAndNil(FDragImages);
    raise;
  end;
end;

end.