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

前端 未结 3 1521
北海茫月
北海茫月 2020-12-14 03:51

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 place

3条回答
  •  庸人自扰
    2020-12-14 04:45

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

    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.
    

提交回复
热议问题