6

我正在使用此代码绘制纯色的透明形式。

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.

但是没有任何控件出现在表单中，我已经阅读了这个问题UpdateLayeredWindow with normal canvas/textout但使用SetLayeredWindowAttributes（如接受的答案建议）与 LWA_COLORKEY 或 LWA_ALPHA 不起作用。

可以使用该UpdateLayeredWindow功能以分层形式绘制控件（TButton，TEdit）吗？

4

2 回答 2

4

我在对该问题的评论中提到的文档有点晦涩。下面来自Using Layered Windows (msdn) 的引用更加明确，如果你要使用UpdateLayeredWindows，你将无法使用 VCL 提供的内置绘画框架。这意味着，您只会看到您在位图上绘制的内容。

要使用UpdateLayeredWindow，必须将分层窗口的可视位呈现为兼容的位图。然后，通过兼容的 GDI 设备上下文，将位图 连同所需的颜色键和 alpha 混合信息一起提供给UpdateLayeredWindow API。位图还可以包含每个像素的 Alpha 信息。

请注意，当使用UpdateLayeredWindow时，应用程序不需要响应 WM_PAINT 或其他绘画消息，因为它已经为窗口提供了可视化表示，并且系统将负责存储该图像、合成它并在屏幕。 UpdateLayeredWindow非常强大，但它通常需要修改现有 Win32 应用程序的绘制方式。


以下代码试图演示如何PaintTo在应用视觉效果之前使用表单的方法使 VCL 为您预渲染位图（（不是我建议使用此方法，只是试图展示它会采取什么..）。另外请注意，如果您要做的只是“制作纯色半透明形式”，TLama 在问题评论中的建议是去。

我已将代码放入WM_PRINTCLIENT一个实时表单中。不过这有点毫无意义，因为并非所有需要视觉指示的操作都会触发“WM_PRINTCLIENT”。例如在下面的项目中，单击按钮或复选框将反映在表单外观上，但在备忘录中写入则不会。

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;


上面的表格如下所示：
半透明形式

于 2012-04-18T14:57:43.793 回答
0

您始终可以在表单上创建表单。这不是最快乐的解决方案，但它有效。我相信解决这个问题的最好方法是使用 GDI+ 或 D2D，但不幸的是，我无法弄清楚，所以我采用了“form on form”的方法：

分层形式：

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.

主要形式：

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.

如您所见，您必须做一些手动工作才能使两个表单表现得像一个，但是这段代码应该可以帮助您入门。

由于我需要具有平滑圆形边框的表格，因此我得到了以下屏幕截图。我将顶部表格涂成灰色，特别是为了这篇文章，以便更容易区分它和分层黑色表格：

示例 WS_EX_LAYERED 表单

您可以清楚地看到带锯​​齿的灰色表单边框（由SetWindowRgn()和 CreateRoundRectRgn() API 制作）和抗锯齿黑色表单边框之间的区别。

于 2013-03-28T04:42:04.423 回答