是否可以在 TForm 上对 VCL 控件进行 Alpha 混合？

Question

是否可以对 TForm 上的 VCL 控件进行 Alpha 混合或实现类似的效果？

例如，考虑以下屏幕截图，其中两个 TPanel 放置在 TForm 上以及其他控件。两个面板都可以拖动（参见How to Move and Resize Controls at Run Time）。

现在，是否可以在拖动时使这些面板半透明，以便您可以看到下面的内容？ （如通过图像处理产生的第二张图像所示）

Answer 1

VCL 让您有机会在拖放过程中使用 specify a drag image list，这是一个简单的示例：

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.

Answer 2

您也可以在 Delphi 中执行此操作。基本思想是将控件放入启用了 alpha 混合的自动调整大小的边框形式。

根据您链接到的文章，在 MouseDown 事件中添加以下行：

  P := TWinControl(Sender).ClientToScreen(Point(0,0));
  frm := TForm.Create(nil);
  TWinControl(Sender).Parent := frm;
  frm.BorderStyle := bsNone;
  frm.AlphaBlend := true;
  frm.AlphaBlendValue := 128;
  frm.AutoSize := true;
  frm.Left := P.X;
  frm.Top := P.Y;
  frm.Position := poDesigned;
  frm.Show;

在 MouseMove 事件中设置父控件的 Left 和 Top 属性：

  GetCursorPos(newPos);

  Screen.Cursor := crSize;
  Parent.Left := Parent.Left - oldPos.X + newPos.X;
  Parent.Top := Parent.Top - oldPos.Y + newPos.Y;
  oldPos := newPos;

并在 MouseUp 事件中释放表单，将控件父级设置回原始父级并将屏幕位置转换为相对于它的新位置：

frm := TWinControl(Sender).Parent;
P := Point(frm.Left, frm.Top);
P := ScreenToClient(P);
TWinControl(Sender).Parent := Self;
TWinControl(Sender).Left := P.X;
TWinControl(Sender).Top := P.Y;
frm.Free;
Screen.Cursor := crDefault;
ReleaseCapture;
inReposition := False;

Answer 3

要实现显示控件图像的拖动操作，您必须创建TDragControlObject后代并实现GetDragImages方法，从这里您必须确保将 csDisplayDragImage 值添加到ControlStyle 要拖动的控件的属性。

你可以在这里Implementing Professional Drag & Drop In VCL/CLX Applications找到一篇关于这个主题的非常好的文章