如何創建alpha混合面板？

Question

我想在Delphi XE2中顯示真正的alpha混合TPanel。我在網上發現了很多嘗試，但沒有一個能正常工作。

我想要實現的是一種「半模態」形式。以類似於Web瀏覽器中顯示的方式顯示在具有褪色背景的其他控件頂部的窗體。

我有它的基本形式的工作，但它具有以下問題：調整面板時

• 大量的閃爍。
• 如果控件在面板頂部移動，則會留下蹤跡。

這是我迄今爲止的努力（根據我發現的一些代碼here）。

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. 

任何人可以幫助我的問題或指向我一個已經存在的alpha混合面板？

Answer 1

感謝所有建議。我已經接受了輸入並創建了一個完全符合我需要的新組件。這裏是什麼樣子：

是我指出了正確的方向的註釋是一個由NGLN我upvoted。如果您將它作爲答案發布，我會接受它。

我試圖將組件代碼添加到此答案，但StackOverflow不會正確格式化它。但是，您可以下載源代碼和完整的演示應用程序here。

該組件提供了以下功能：

• 半模態形式是主要形式的一個孩子。這意味着它可以被標記爲與其他控件一樣。
• 覆蓋區域繪製正確，沒有任何人爲現象。
• 覆蓋區域下的控件被自動禁用。
• 如果需要，可以顯示/隱藏半模式表格/覆蓋圖。 切換標籤。
• SemiModalResult在事件中傳回。

我還想解決一些小問題。如果有人知道如何解決這些問題，請告訴我。

• 當父窗體移動或調整大小時，它需要調用 ParentFormMoved過程。這允許組件重新設置/重新定位疊加窗體。有什麼方法可以將父表單掛接到 並檢測它何時移動？
• 如果您最小化主窗體，然後恢復它，覆蓋窗體將立即出現，然後主窗體將恢復到之前的位置。有什麼方法可以檢測主窗體何時完成動畫？
• 半模式窗口的圓角不太漂亮。我是 不知道有多少可以做到這一點，因爲它的下降到 矩形區域。

Answer 2

您的代碼不會以模態方式顯示錶單，我不知道爲什麼您不會。但是，也許我不明白朮語半模式。

在任何情況下，我認爲the idea建立在其上顯示實際的對話框會做就好了一個半透明形式：

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;