Làm cách nào để kiểm soát biểu mẫu WS_EX_LAYERED?

Question

Tôi đang sử dụng mã này vẽ một dạng trong suốt của một màu đồng nhất.

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
var 
    BlendFunction: TBlendFunction; 
    BitmapPos: TPoint; 
    BitmapSize: TSize; 
    exStyle: DWORD; 
    Bitmap: TBitmap; 
begin 
    exStyle := GetWindowLongA(Handle, GWL_EXSTYLE); 
    if (exStyle and WS_EX_LAYERED = 0) then 
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED); 

    Bitmap := TBitmap.Create; 
    try 
    Bitmap.PixelFormat := pf32bit; 
    Bitmap.SetSize(Width, Height); 
    Bitmap.Canvas.Brush.Color:=clRed; 
    Bitmap.Canvas.FillRect(Rect(0,0, Bitmap.Width, Bitmap.Height)); 
    BitmapPos := Point(0, 0); 
    BitmapSize.cx := Bitmap.Width; 
    BitmapSize.cy := Bitmap.Height; 
    BlendFunction.BlendOp := AC_SRC_OVER; 
    BlendFunction.BlendFlags := 0; 
    BlendFunction.SourceConstantAlpha := 150; 
    BlendFunction.AlphaFormat := 0; 

    UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle, 
     @BitmapPos, 0, @BlendFunction, ULW_ALPHA); 

    Show; 
    finally 
    Bitmap.Free; 
    end; 
end; 

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest); 
begin 
    Message.Result := HTCAPTION; 
end; 

end. 

Nhưng không ai trong số các điều khiển xuất hiện trong hình thức, đã tôi đọc câu hỏi này UpdateLayeredWindow with normal canvas/textout nhưng sử dụng SetLayeredWindowAttributes (như câu trả lời chấp nhận đề nghị) với LWA_COLORKEY hoặc LWA_ALPHA không hoạt động.

Có thể vẽ điều khiển (TButton, TEdit) ở dạng lớp có sử dụng chức năng UpdateLayeredWindow?

Answer 1

Tài liệu tôi đã thu thập lại trong nhận xét cho câu hỏi có chút mơ hồ. Trích dẫn bên dưới từ Using Layered Windows (msdn) rõ ràng hơn nhiều trong đó, nếu bạn định sử dụng UpdateLayeredWindows, bạn sẽ không thể sử dụng khung vẽ tích hợp được cung cấp bởi VCL. Hàm ý là, bạn sẽ chỉ thấy những gì bạn đã vẽ trên bitmap.

Để sử dụng UpdateLayeredWindow, các bit trực quan cho một cửa sổ lớp phải được trả lại vào một bitmap tương thích. Sau đó, thông qua Ngữ cảnh thiết bị GDI tương thích, bitmap được cung cấp cho API UpdateLayeredWindow, cùng với thông tin về màu sắc và pha trộn mong muốn . Bản đồ bitmap cũng có thể chứa thông tin alpha mỗi pixel một thông tin .

Lưu ý rằng khi sử dụng UpdateLayeredWindow các ứng dụng không cần phải đáp ứng WM_PAINT hoặc vẽ tin nhắn khác, bởi vì nó đã cung cấp những hình ảnh đại diện cho cửa sổ và hệ thống sẽ chăm sóc lưu trữ hình ảnh, soạn và hiển thị trên màn hình. UpdateLayeredWindow khá mạnh, nhưng thường là yêu cầu sửa đổi cách ứng dụng Win32 hiện có.

Sau code đang nỗ lực để chứng minh làm thế nào bạn có thể làm cho VCL pre-render bitmap cho bạn bằng cách sử dụng phương pháp PaintTo của mẫu, trước khi bạn áp dụng hiệu ứng hình ảnh của bạn ((nó không phải là tôi' m đề nghị sử dụng phương pháp này, chỉ cần cố gắng để hiển thị những gì nó sẽ đưa đến ..) Cũng xin lưu ý rằng, nếu tất cả các bạn sẽ làm là để "làm cho một hình thức bán màu trong suốt rắn", TLama của gợi ý cho câu hỏi là cách để đi.

Tôi đã đặt mã trong một WM_PRINTCLIENT để có một số trực tiếp. Tuy nhiên, điều này hơi vô nghĩa vì không phải tất cả các hành động yêu cầu chỉ thị trực quan sẽ kích hoạt 'WM_PRINTCLIENT'. Ví dụ trong dự án dưới đây, nhấp vào nút hoặc hộp kiểm sẽ được phản ánh trên hình thức xuất hiện, nhưng viết trong bản ghi nhớ sẽ không.

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    Memo1: TMemo; 
    CheckBox1: TCheckBox; 
    Label1: TLabel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    protected 
    procedure WMPrintClient(var Msg: TWMPrintClient); message WM_PRINTCLIENT; 
    private 
    FBitmap: TBitmap; 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

const 
    Alpha = $D0; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    FBitmap := TBitmap.Create; 
    FBitmap.PixelFormat := pf32bit; 
    FBitmap.SetSize(Width, Height); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    FBitmap.Free; 
end; 


procedure TForm1.WMPrintClient(var Msg: TWMPrintClient); 
var 
    exStyle: DWORD; 
    ClientOrg: TPoint; 
    X, Y: Integer; 
    Pixel: PRGBQuad; 
    BlendFunction: TBlendFunction; 
    BitmapPos: TPoint; 
    BitmapSize: TSize; 
begin 
    exStyle := GetWindowLongA(Handle, GWL_EXSTYLE); 
    if (exStyle and WS_EX_LAYERED = 0) then 
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED); 

    // for non-client araea only 
    FBitmap.Canvas.Brush.Color := clBtnShadow; 
    FBitmap.Canvas.FillRect(Rect(0,0, FBitmap.Width, FBitmap.Height)); 

    // paste the client image 
    ClientOrg.X := ClientOrigin.X - Left; 
    ClientOrg.Y := ClientOrigin.Y - Top; 
    FBitmap.Canvas.Lock; 
    PaintTo(FBitmap.Canvas.Handle, ClientOrg.X, ClientOrg.Y); 
    FBitmap.Canvas.Unlock; 

    // set alpha and have pre-multiplied color values 
    for Y := 0 to (FBitmap.Height - 1) do begin 
    Pixel := FBitmap.ScanLine[Y]; 
    for X := 0 to (FBitmap.Width - 1) do begin 
     Pixel.rgbRed := MulDiv($FF, Alpha, $FF); // red tint 
     Pixel.rgbGreen := MulDiv(Pixel.rgbGreen, Alpha, $FF); 
     Pixel.rgbBlue := MulDiv(Pixel.rgbBlue, Alpha, $FF); 
     Pixel.rgbReserved := Alpha; 
     Inc(Pixel); 
    end; 
    end; 

    BlendFunction.BlendOp := AC_SRC_OVER; 
    BlendFunction.BlendFlags := 0; 
    BlendFunction.SourceConstantAlpha := 255; 
    BlendFunction.AlphaFormat := AC_SRC_ALPHA; 

    BitmapPos := Point(0, 0); 
    BitmapSize.cx := Width; 
    BitmapSize.cy := Height; 
    UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, FBitmap.Canvas.Handle, 
     @BitmapPos, 0, @BlendFunction, ULW_ALPHA); 
end; 

Các mẫu ở trên trông như thế này:

Answer 2

Bạn luôn có thể tạo ra hình thức vào mẫu. Nó không phải là giải pháp hạnh phúc nhất, nhưng nó hoạt động.Tôi tin rằng cách tốt nhất để giải quyết vấn đề này sẽ là bằng cách sử dụng GDI + hoặc D2D, nhưng không may, tôi không thể tìm ra, vì vậy tôi đã đi với "hình thức vào mẫu" cách tiếp cận:

dạng Layered:

unit uLayeredForm; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, System.Types, 
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.PngImage; 

type 
    TfrmLayered = class(TForm) 
    procedure FormActivate(Sender: TObject); 
    private 
    FParentForm: TForm; 
    procedure SetAlphaBackground(const AResourceName: String); 
    public 
    constructor Create(AOwner: TComponent; const ABitmapResourceName: String); reintroduce; 
    procedure UpdatePosition; 
    end; 

var 
    frmLayered: TfrmLayered; 

implementation 

{$R *.dfm} 


constructor TfrmLayered.Create(AOwner: TComponent; const ABitmapResourceName: String); 
begin 
    inherited Create(AOwner); 

    FParentForm := AOwner as TForm; 
    SetAlphaBackground(ABitmapResourceName); 
end; 

procedure TfrmLayered.FormActivate(Sender: TObject); 
begin 
    if (Active) and (FParentForm.Visible) and (Assigned(FParentForm)) then 
    FParentForm.SetFocus; 
end; 

procedure TfrmLayered.UpdatePosition; 
begin 
    if Assigned(FParentForm) then 
    begin 
    Left := FParentForm.Left - (ClientWidth - FParentForm.ClientWidth) div 2 - 1; 
    Top := FParentForm.Top - (ClientHeight - FParentForm.ClientHeight) div 2 - 1; 
    end; 
end; 

procedure TfrmLayered.SetAlphaBackground(const AResourceName: String); 
var 
    blend_func: TBlendFunction; 
    imgpos : TPoint; 
    imgsize : TSize; 
    exStyle : DWORD; 
    png  : TPngImage; 
    bmp  : TBitmap; 
begin 
    // enable window layering 
    exStyle := GetWindowLongA(Handle, GWL_EXSTYLE); 
    if ((exStyle and WS_EX_LAYERED) = 0) then 
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED); 

    png := TPngImage.Create; 
    try 
    png.LoadFromResourceName(HInstance, AResourceName); 

    bmp := TBitmap.Create; 
    try 
     bmp.Assign(png); 

     // resize the form 
     ClientWidth := bmp.Width; 
     ClientHeight := bmp.Height; 

     // position image on form 
     imgpos := Point(0, 0); 
     imgsize.cx := bmp.Width; 
     imgsize.cy := bmp.Height; 

     // setup alpha blending parameters 
     blend_func.BlendOp := AC_SRC_OVER; 
     blend_func.BlendFlags := 0; 
     blend_func.SourceConstantAlpha := 255; 
     blend_func.AlphaFormat := AC_SRC_ALPHA; 

     UpdateLayeredWindow(Handle, 0, nil, @imgsize, bmp.Canvas.Handle, @imgpos, 0, @blend_func, ULW_ALPHA); 
    finally 
     bmp.Free; 
    end; 
    finally 
    png.Free; 
    end; 
end; 

end. 

hình thức chính:

unit uMainForm; 

interface 

uses 
    uLayeredForm, 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls; 

type 
    TfrmMain = class(TForm) 
    imgClose: TImage; 
    procedure FormCreate(Sender: TObject); 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
    procedure FormShow(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormHide(Sender: TObject); 
    procedure imgCloseClick(Sender: TObject); 
    private 
    FLayeredForm: TfrmLayered; 
    protected 
    procedure WMMove(var AMessage: TMessage); message WM_MOVE; 
    public 
    end; 

var 
    frmMain: TfrmMain; 

implementation 

{$R *.dfm} 

uses 
    uCommon, Vcl.Themes, Vcl.Styles.FormStyleHooks; 



procedure TfrmMain.FormCreate(Sender: TObject); 
begin 
    {$IFDEF DEBUG} ReportMemoryLeaksOnShutdown := TRUE; {$ENDIF} 

    FLayeredForm := TfrmLayered.Create(self, 'MainBackground'); 
    FLayeredForm.Visible := TRUE; 
end; 

procedure TfrmMain.FormDestroy(Sender: TObject); 
begin 
    FLayeredForm.Free; 
end; 

procedure TfrmMain.FormHide(Sender: TObject); 
begin 
    FLayeredForm.Hide; 
end; 

procedure TfrmMain.WMMove(var AMessage: TMessage); 
begin 
    if Assigned(FLayeredForm) then 
    FLayeredForm.UpdatePosition; 

    inherited; 
end; 

procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
    FormMove(self, Button, Shift, X, Y); 
end; 

procedure TfrmMain.FormShow(Sender: TObject); 
begin 
    if Assigned(FLayeredForm) then 
    begin 
    FLayeredForm.Show; 
    FLayeredForm.UpdatePosition; 
    end; 
end; 

procedure TfrmMain.imgCloseClick(Sender: TObject); 
begin 
    Close; 
end; 

initialization 
    TStyleManager.Engine.RegisterStyleHook(TfrmMain, TFormStyleHookBackground); 
    TFormStyleHookBackground.BackGroundSettings.Color := clBlack; 
    TFormStyleHookBackground.BackGroundSettings.Enabled := TRUE; 

end. 

như bạn thấy, bạn sẽ phải làm một chút công việc thủ công để thực hiện hai hình thức cư xử như một, nhưng mã này sẽ giúp bạn bắt đầu.

Vì tôi cần biểu mẫu có đường viền tròn mượt mà, ảnh chụp màn hình sau đây là những gì tôi nhận được dưới dạng kết quả cuối cùng. Tôi màu phong độ tốt nhất trong màu xám, đặc biệt cho bài này, cho phân biệt dễ dàng hơn giữa nó và hình thức đen lớp:

Bạn có thể thấy rõ sự khác biệt giữa biên giới dưới hình thức màu xám bí danh (do SetWindowRgn() và CreateRoundRectRgn() API) và đường viền biểu mẫu màu đen chống răng cưa.