13

TFormのVCLコントロールにAlphaBlendまたは同様の効果を実装することは可能ですか？

たとえば、他のコントロールに加えて2つのTPanelがTFormに配置されている次のスクリーンショットについて考えてみます。両方のパネルがドラッグ可能になっています（実行時にコントロールを移動およびサイズ変更する方法を参照 ）。

さて、ドラッグ中にこれらのパネルを半透明にして、下にあるものが見えるようにすることは可能ですか？（画像操作によって生成された2番目の画像に示されているように）

サンプルフォーム画像

TLamaとUweRaabeによって提案されたソリューション

4

3 に答える 3

17

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.
于 2012-09-27T20:17:18.630 に答える
8

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;
于 2012-09-27T19:49:16.697 に答える
6

コントロールの画像を表示するドラッグ操作を実装するには、TDragControlObject子孫を作成してメソッドを実装する必要があります。ここから、ドラッグするコントロールのControlStyleプロパティにcsDisplayDragImage値をGetDragImages追加する必要があります。

このトピックに関する非常に優れた記事をここで見つけることができますImplementing Professional Drag & Drop In VCL/CLX Applications

于 2012-09-27T20:03:07.107 に答える