¿Cómo creo un panel alfa mezclado?

Question

Estoy tratando de mostrar un TPanel completamente mezclado alfa en Delphi XE2. He encontrado bastantes intentos en línea, pero ninguno de ellos funciona correctamente.

Lo que estoy tratando de lograr es una forma 'semi modal'. Un formulario que se muestra sobre la parte superior de otros controles con un fondo desvanecido de una manera similar a la que se ve en los navegadores web.

Tengo que trabajar en una forma básica, pero adolece de los siguientes problemas:

• Una gran cantidad de parpadeo al cambiar el tamaño del panel.
• Si se mueve un control sobre la parte superior del panel, deja un rastro.

Aquí está mi esfuerzo hasta ahora (basado en algún código que encontré 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. 

¿Alguien puede ayudar con los problemas o que me señale un panel de mezcla alfa que ya existe?

Answer 1

Gracias por toda su sugerencias. Tomé la entrada y creé un nuevo componente que hace exactamente lo que necesito. Esto es lo que parece:

El comentario de que me señaló en la dirección correcta fue el uno por NGLN que upvoted. Si lo publica como la respuesta, lo aceptaré.

Intenté agregar el código del componente a esta respuesta, pero StackOverflow no lo formateó correctamente. Sin embargo, puede descargar la fuente y una aplicación de demostración completa here.

El componente proporciona la siguiente funcionalidad:

• La forma semi modal es un hijo de la forma principal. Esto significa que puede tabularse igual que los otros controles.
• El área de superposición se dibuja correctamente sin artefactos.
• Los controles debajo del área de superposición se desactivan automáticamente.
• El formulario/superposición semi modal se puede mostrar/ocultar si es necesario, p. pestañas de conmutación.
• Un SemiModalResult se devuelve en un evento.

Todavía hay una serie de pequeños problemas que me gustaría solucionar. Si alguien sabe cómo solucionarlos, házmelo saber.

• Cuando el formulario principal se mueve o cambia de tamaño que necesita para llamar al procedimiento ParentFormMoved . Esto permite que el componente cambie el tamaño/la posición del formulario de superposición. ¿Hay alguna forma de enganchar en el formulario principal y detectar cuándo se mueve?
• Si minimiza el formulario principal y lo restaura, el formulario de superposición aparece inmediatamente, y luego el formulario principal se anima de nuevo a su posición anterior. ¿Hay alguna manera de detectar cuando la forma principal ha terminado de animar?
• Las esquinas redondeadas de la ventana semi modal no son demasiado bonitas. Estoy no estoy seguro de que se pueda hacer mucho al respecto, ya que se trata de la región rectangular .

Answer 2

Su código no muestra el formulario de forma modal, y me pregunto por qué no lo haría. Pero entonces, tal vez no entiendo el término semi modal.

En cualquier caso, creo que the idea crear un formulario medio transparente en el que mostrar el cuadro de diálogo real no tendrán ningún problema:

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; 

de uso:

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