如何创建alpha混合面板？

Question

如何创建alpha混合面板？

nor*_*aul 11 delphi delphi-xe2

我试图在Delphi XE2中显示一个真正的alpha混合TPanel.我在网上发现了不少尝试,但都没有正常工作.

我想要实现的是一种"半模态"形式.显示在其他控件顶部的窗体,其背景类似于Web浏览器中显示的淡化背景.

在此输入图像描述

我已经让它以基本形式工作,但它遇到以下问题:

调整面板大小时会出现大量闪烁.
如果控件移动到面板顶部,则会留下痕迹.

这是我到目前为止的努力(基于我在这里找到的一些代码).

unit SemiModalFormU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type
  ISemiModalResultHandler = interface
    ['{0CC5A5D0-1545-4257-A936-AD777E0DAFCF}']
    procedure SemiModalFormClosed(Form: TForm);
  end;

  TTransparentPanel = class(TCustomPanel)
  private
    FBackground: TBitmap;
    FBlendColor: TColor;
    FBlendAlpha: Byte;

    procedure ColorBlend(const ACanvas: TCanvas; const ARect: TRect; const ABlendColor: TColor; const ABlendValue: Byte);
    procedure SetBlendAlpha(const Value: Byte);
    procedure SetBlendColor(const Value: TColor);
  protected
    procedure CaptureBackground;
    procedure Paint; override;

    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMMove(var Message: TMessage); message WM_MOVE;
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    procedure ClearBackground;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property BlendColor: TColor read FBlendColor write SetBlendColor;
    property BlendAlpha: Byte read FBlendAlpha write SetBlendAlpha;

    property Align;
    property Alignment;
    property Anchors;
  end;

  TSemiModalForm = class(TComponent)
  strict private
    FFormParent: TWinControl;
    FBlendColor: TColor;
    FBlendAlpha: Byte;
    FSemiModalResultHandler: ISemiModalResultHandler;
    FForm: TForm;
    FTransparentPanel: TTransparentPanel;
    FOldFormOnClose: TCloseEvent;
  private
    procedure OnTransparentPanelResize(Sender: TObject);
    procedure RepositionForm;
    procedure SetFormParent(const Value: TWinControl);
    procedure OnFormClose(Sender: TObject; var Action: TCloseAction);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure ShowSemiModalForm(AForm: TForm; SemiModalResultHandler: ISemiModalResultHandler); virtual;

    property ModalPanel: TTransparentPanel read FTransparentPanel;
  published
    constructor Create(AOwner: TComponent); override;

    property BlendColor: TColor read FBlendColor write FBlendColor;
    property BlendAlpha: Byte read FBlendAlpha write FBlendAlpha;
    property FormParent: TWinControl read FFormParent write SetFormParent;
  end;

implementation

procedure TTransparentPanel.CaptureBackground;
var
  canvas: TCanvas;
  dc: HDC;
  sourcerect: TRect;
begin
  FBackground := TBitmap.Create;

  with Fbackground do
  begin
    width := clientwidth;
    height := clientheight;
  end;

  sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);
  sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight);

  dc := CreateDC('DISPLAY', nil, nil, nil);
  try
    canvas := TCanvas.Create;
    try
      canvas.handle := dc;
      Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect);
    finally
      canvas.handle := 0;
      canvas.free;
    end;
  finally
    DeleteDC(dc);
  end;
end;

constructor TTransparentPanel.Create(aOwner: TComponent);
begin
  inherited;

  ControlStyle := controlStyle - [csSetCaption];

  FBlendColor := clWhite;
  FBlendAlpha := 200;
end;

destructor TTransparentPanel.Destroy;
begin
  FreeAndNil(FBackground);

  inherited;
end;

procedure TTransparentPanel.Paint;
begin
  if csDesigning in ComponentState then
    inherited
end;

procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (Visible) and
     (HandleAllocated) and
     (not (csDesigning in ComponentState)) then
  begin
    FreeAndNil(Fbackground);

    Hide;

    inherited;

    Parent.Update;

    Show;
  end
  else
    inherited;
end;

procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);
var
  ACanvas: TCanvas;
begin
  if csDesigning in ComponentState then
    inherited
  else
  begin
    if not Assigned(FBackground) then
      Capturebackground;

    ACanvas := TCanvas.create;
    try
      ACanvas.handle := msg.DC;
      ACanvas.draw(0, 0, FBackground);
      ColorBlend(ACanvas, Rect(0, 0, Width, Height), FBlendColor, FBlendAlpha);
    finally
      FreeAndNil(ACanvas);
    end;

    msg.result := 1;
  end;
end;

procedure TTransparentPanel.WMMove(var Message: TMessage);
begin
 CaptureBackground;
end;

procedure TTransparentPanel.WMParentNotify(var Message: TWMParentNotify);
begin
  CaptureBackground;
end;

procedure TTransparentPanel.ClearBackground;
begin
  FreeAndNil(FBackground);
end;

procedure TTransparentPanel.ColorBlend(const ACanvas: TCanvas; const ARect: TRect;
  const ABlendColor: TColor; const ABlendValue: Byte);
var
  BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  try
    BMP.Canvas.Brush.Color := ABlendColor;
    BMP.Width := ARect.Right - ARect.Left;
    BMP.Height := ARect.Bottom - ARect.Top;
    BMP.Canvas.FillRect(Rect(0,0,BMP.Width, BMP.Height));

    ACanvas.Draw(ARect.Left, ARect.Top, BMP, ABlendValue);
  finally
    FreeAndNil(BMP);
  end;
end;

procedure TTransparentPanel.SetBlendAlpha(const Value: Byte);
begin
  FBlendAlpha := Value;

  Paint;
end;

procedure TTransparentPanel.SetBlendColor(const Value: TColor);
begin
  FBlendColor := Value;

  Paint;
end;

{ TSemiModalForm }

constructor TSemiModalForm.Create(AOwner: TComponent);
begin
  inherited;

  FBlendColor := clWhite;
  FBlendAlpha := 150;

  FTransparentPanel := TTransparentPanel.Create(Self);
end;

procedure TSemiModalForm.SetFormParent(const Value: TWinControl);
begin
  FFormParent := Value;
end;

procedure TSemiModalForm.ShowSemiModalForm(AForm: TForm;
  SemiModalResultHandler: ISemiModalResultHandler);
begin
  if FForm = nil then
  begin
    FForm := AForm;
    FSemiModalResultHandler := SemiModalResultHandler;

    FTransparentPanel.Align := alClient;
    FTransparentPanel.BringToFront;
    FTransparentPanel.Parent := FFormParent;
    FTransparentPanel.BlendColor := FBlendColor;
    FTransparentPanel.BlendAlpha := FBlendAlpha;

    FTransparentPanel.OnResize := OnTransparentPanelResize;

    AForm.Parent := FTransparentPanel;
    FOldFormOnClose := AForm.OnClose;
    AForm.OnClose := OnFormClose;

    RepositionForm;

    AForm.Show;

    FTransparentPanel.ClearBackground;
    FTransparentPanel.Visible := TRUE;
  end;
end;

procedure TSemiModalForm.OnFormClose(Sender: TObject; var Action: TCloseAction);
begin
  FForm.OnClose := FOldFormOnClose;

  try
    FForm.Visible := FALSE;

    FSemiModalResultHandler.SemiModalFormClosed(FForm);
  finally
    FForm.Parent := nil;
    FForm := nil;

    FTransparentPanel.Visible := FALSE;
  end;
end;

procedure TSemiModalForm.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) then
  begin
    if AComponent = FFormParent then
      SetFormParent(nil);
  end;
end;

procedure TSemiModalForm.OnTransparentPanelResize(Sender: TObject);
begin
  RepositionForm;
end;

procedure TSemiModalForm.RepositionForm;
begin
  FForm.Left := (FTransparentPanel.Width div 2) - (FForm.Width div 2);
  FForm.Top := (FTransparentPanel.Height div 2) - (FForm.Height div 2);
end;

end.

Run Code Online (Sandbox Code Playgroud)

任何人都可以帮助我解决这些问题,还是指向一个已经存在的alpha混合面板？