delphi - アルファブレンドパネルを作成するにはどうすればよいですか？

Question

DelphiXE2で真にアルファブレンドされた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.

誰かが私に問題を手伝ってくれたり、すでに存在するアルファブレンドパネルを教えてもらえますか？

score 10 · Accepted Answer

ご提案いただきありがとうございます。入力を取り、必要なことを正確に実行する新しいコンポーネントを作成しました。外観は次のとおりです。

ここに画像の説明を入力

私を正しい方向に向けたコメントは、私が支持したNGLNによるものでした。あなたが答えとして投稿すれば、私はそれを受け入れます。

コンポーネントコードをこの回答に追加しようとしましたが、StackOverflow は正しくフォーマットしませんでした。ただし、ソースと完全なデモアプリケーションはこちらからダウンロードできます。

このコンポーネントは、次の機能を提供します。

セミモーダルフォームは、メインフォームの子です。これは、他のコントロールと同じようにタブで移動できることを意味します。
オーバーレイ領域はアーティファクトなしで正しく描画されます。
オーバーレイ領域の下のコントロールは自動的に無効になります。
タブの切り替えなど、必要に応じてセミモーダルフォーム/オーバーレイを表示/非表示にすることができます。
SemiModalResult はイベントで返されます。

私が解決したい小さな問題がまだたくさんあります。誰かがそれらを修正する方法を知っている場合は、私に知らせてください。

親フォームが移動またはサイズ変更された場合、ParentFormMoved プロシージャを呼び出す必要があります。これにより、コンポーネントはオーバーレイフォームのサイズや位置を変更できます。親フォームにフックして、いつ移動したかを検出する方法はありますか?
メインフォームを模倣してから元に戻すと、オーバーレイフォームがすぐに表示され、メインフォームがアニメーション化されて元の位置に戻ります。メインフォームのアニメーションが終了したことを検出する方法はありますか?
セミモーダルウィンドウの丸みを帯びた角はあまりきれいではありません。長方形の領域にまで及ぶため、これについてできることはあまりありません。

score 3 · Accepted Answer

あなたのコードはフォームをモーダルに表示しません。しかし、セミモーダルという用語を理解していないかもしれません。

いずれにせよ、実際のダイアログを表示する半透明のフォームを作成するというアイデアはうまくいくと思います。

function ShowObviousModal(AForm: TForm; AParent: TWinControl = nil): Integer;
var
  Layer: TForm;
begin
  if AParent = nil then
    AParent := Application.MainForm;
  Layer := TForm.Create(nil);
  try
    Layer.AlphaBlend := True;
    Layer.AlphaBlendValue := 128;
    Layer.BorderStyle := bsNone;
    Layer.Color := clWhite;
    with AParent, ClientOrigin do
      SetWindowPos(Layer.Handle, HWND_TOP, X, Y, ClientWidth, ClientHeight,
        SWP_SHOWWINDOW);
    Result := AForm.ShowModal;
  finally
    Layer.Free;
  end;
end;

使用法：

procedure TForm1.Button1Click(Sender: TObject);
begin
  FDialog := TForm2.Create(Self);
  try
    if ShowObviousModal(FDialog) = mrOk then
      Caption := 'OK';
  finally
    FDialog.Free;
  end;
end;

delphi - アルファブレンドパネルを作成するにはどうすればよいですか？

2 に答える 2

Related

Reference