Làm cách nào để tạo bảng điều khiển kết hợp alpha?

Question

Tôi đang cố gắng hiển thị một TPanel pha trộn alpha thực sự trong Delphi XE2. Tôi đã tìm thấy một vài nỗ lực trực tuyến, nhưng không ai trong số họ làm việc một cách chính xác.

Điều tôi đang cố gắng đạt được là hình thức 'nửa phương thức'. Một biểu mẫu được hiển thị trên đầu các điều khiển khác với nền mờ dần theo cách tương tự như trong trình duyệt web.

Tôi đã có nó làm việc trong một hình thức cơ bản, nhưng nó bị những vấn đề sau đây:

• Một số lượng lớn các nhấp nháy khi thay đổi kích thước bảng điều khiển.
• Nếu điều khiển được di chuyển trên đầu bảng điều khiển, nó sẽ để lại một đường nhỏ.

Đây là nỗ lực của tôi cho đến nay (dựa trên một số mã tôi tìm thấy 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. 

Ai đó có thể giúp tôi khắc phục sự cố hoặc chỉ cho tôi bảng alpha pha trộn đã tồn tại?

Answer 1

Cảm ơn tất cả bạn đề xuất. Tôi đã lấy đầu vào và tạo ra một thành phần mới thực hiện chính xác những gì tôi cần. Đây là những gì nó trông giống như:

Các bình luận rằng chỉ cho tôi đi đúng hướng là từng người NGLN rằng tôi bỏ phiếu tán. Nếu bạn đăng nó như là câu trả lời tôi sẽ chấp nhận nó.

Tôi đã cố gắng thêm mã thành phần vào câu trả lời này, nhưng StackOverflow sẽ không định dạng chính xác. Tuy nhiên, bạn có thể tải xuống nguồn và ứng dụng demo đầy đủ here.

Thành phần cung cấp các chức năng sau:

• Các dạng phương thức bán là một đứa trẻ có dạng chính. Điều này có nghĩa rằng nó có thể được tabbed giống như các điều khiển khác.
• Diện tích lớp phủ được vẽ chính xác mà không có đồ tạo tác.
• Các điều khiển trong vùng phủ sẽ tự động bị tắt.
• Biểu mẫu/lớp phủ bán phương thức có thể được hiển thị/ẩn nếu được yêu cầu, ví dụ: tab chuyển đổi.
• Một SemiModalResult được trả lại trong một sự kiện.

Vẫn còn một số vấn đề nhỏ mà tôi muốn giải quyết. Nếu có ai biết cách sửa chúng, hãy cho tôi biết.

• Khi biểu mẫu gốc được di chuyển hoặc đổi kích thước, cần phải gọi thủ tục ParentFormMoved. Điều này cho phép các thành phần để thay đổi kích thước/định vị lại biểu mẫu lớp phủ. Có cách nào để móc vào biểu mẫu gốc và phát hiện khi nó được di chuyển không?
• Nếu bạn bắt chước biểu mẫu chính, sau đó khôi phục, biểu mẫu lớp phủ sẽ xuất hiện ngay lập tức, sau đó biểu mẫu chính sẽ hoạt ảnh trở lại vị trí trước đó của nó. Có cách nào để phát hiện khi biểu mẫu chính đã hoàn thành hoạt ảnh không?
• Các góc tròn của cửa sổ bán phương thức không quá đẹp. Tôi là không chắc chắn có nhiều điều có thể được thực hiện về điều này vì nó rơi xuống khu vực hình chữ nhật .

Answer 2

Mã của bạn không hiển thị biểu mẫu một cách bình thường và tôi tự hỏi tại sao bạn không làm như vậy. Nhưng sau đó, có lẽ tôi không hiểu thuật ngữ phương thức bán.

Trong mọi trường hợp, tôi nghĩ the idea để tạo ra một hình thức nửa trong suốt cho phép hiển thị hộp thoại thực tế sẽ làm tốt:

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; 

Cách sử dụng:

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