Можно ли Alpha Blend контролировать VCL на TForm?

Возможно ли использовать Alpha Blend или реализовать аналогичный эффект для элемента управления VCL на TForm?

Например, рассмотрим следующий скриншот, в котором два TPanels помещаются в TForm в дополнение к другим элементам управления. Обе панели сделаны перетаскиваемыми (см. Как перемещать и изменять размер элементов управления во время выполнения).

Теперь, можно ли сделать эти панели полупрозрачными при перетаскивании, чтобы вы могли видеть, что внизу? (как показано на втором изображении, которое было создано с помощью манипуляции с изображением)

Ответ 1

Вы можете сделать это и в Delphi. Основная идея состоит в том, чтобы поместить элемент управления в авторизованную, граничную форму с включенным альфа-смешением.

Согласно статье, с которой вы связались, в событии 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;

Ответ 2

VCL дает вам возможность указать список перетаскиваемых изображений, который будет использоваться во время перетаскивания, вот краткий пример:

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.

Ответ 3

Чтобы реализовать операцию перетаскивания, отображающую изображение элемента управления, вы должны создать TDragControlObject потом и реализовать GetDragImages, отсюда вы должны обеспечить добавление значения csDisplayDragImage в ControlStyle свойства элементов управления, которые требуется перетащить.

Вы можете найти очень хорошую статью по этой теме здесь Implementing Professional Drag & Drop In VCL/CLX Applications