我正在尝试创建一个完全透明的表单,我在其上绘制具有Alpha透明度的位图.问题是我无法弄清楚如何将位图的背景设置为Alpha 0(完全透视).
这是表单现在的样子(注意右上角不透明).
这就是我想要的样子(右上角完全透明):
这是我的来源:
unit frmMain; interface uses Winapi.Windows,Winapi.Messages,System.SysUtils,System.Variants,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,ActiveX,GDIPObj,GDIPAPI,Vcl.StdCtrls,Vcl.ExtCtrls; type TForm7 = class(TForm) Panel1: TPanel; Edit1: TEdit; Button1: TButton; Button2: TButton; procedure Button2Click(Sender: TObject); private function CreateTranparentForm: TForm; end; var Form7: TForm7; implementation {$R *.dfm} // Thanks to Anders Melander for the transparent form tutorial // (http://melander.dk/articles/alphasplash2/2/) function CreateAlphaBlendForm(AOwner: TComponent; Bitmap: TBitmap; Alpha: Byte): TForm; procedure PremultiplyBitmap(Bitmap: TBitmap); var Row,Col: integer; p: PRGBQuad; PreMult: array[byte,byte] of byte; begin // precalculate all possible values of a*b for Row := 0 to 255 do for Col := Row to 255 do begin PreMult[Row,Col] := Row*Col div 255; if (Row <> Col) then PreMult[Col,Row] := PreMult[Row,Col]; // a*b = b*a end; for Row := 0 to Bitmap.Height-1 do begin Col := Bitmap.Width; p := Bitmap.ScanLine[Row]; while (Col > 0) do begin p.rgbBlue := PreMult[p.rgbReserved,p.rgbBlue]; p.rgbGreen := PreMult[p.rgbReserved,p.rgbGreen]; p.rgbRed := PreMult[p.rgbReserved,p.rgbRed]; inc(p); dec(Col); end; end; end; var BlendFunction: TBlendFunction; BitmapPos: TPoint; BitmapSize: TSize; exStyle: DWORD; PNGBitmap: TGPBitmap; BitmapHandle: HBITMAP; Stream: TMemoryStream; StreamAdapter: IStream; begin Result := TForm.Create(AOwner); // Enable window layering exStyle := GetWindowLongA(Result.Handle,GWL_EXSTYLE); if (exStyle and WS_EX_LAYERED = 0) then SetWindowLong(Result.Handle,GWL_EXSTYLE,exStyle or WS_EX_LAYERED); // Load the PNG from a resource Stream := TMemoryStream.Create; try Bitmap.SaveToStream(Stream); // Wrap the VCL stream in a COM IStream StreamAdapter := TStreamAdapter.Create(Stream); try // Create and load a GDI+ bitmap from the stream PNGBitmap := TGPBitmap.Create(StreamAdapter); try // Convert the PNG to a 32 bit bitmap PNGBitmap.GetHBITMAP(MakeColor(0,0),BitmapHandle); // Wrap the bitmap in a VCL TBitmap Bitmap.Handle := BitmapHandle; finally FreeAndNil(PNGBitmap); end; finally StreamAdapter := nil; end; finally FreeAndNil(Stream); end; // Perform run-time premultiplication PremultiplyBitmap(Bitmap); // Resize form to fit bitmap Result.ClientWidth := Bitmap.Width; Result.ClientHeight := Bitmap.Height; // Position bitmap on form BitmapPos := Point(0,0); BitmapSize.cx := Bitmap.Width; BitmapSize.cy := Bitmap.Height; // Setup alpha blending parameters BlendFunction.BlendOp := AC_SRC_OVER; BlendFunction.BlendFlags := 0; BlendFunction.SourceConstantAlpha := Alpha; BlendFunction.AlphaFormat := AC_SRC_ALPHA; UpdateLayeredWindow(Result.Handle,nil,@BitmapSize,Bitmap.Canvas.Handle,@BitmapPos,@BlendFunction,ULW_ALPHA); end; procedure CopyControlToBitmap(AWinControl: TWinControl; Bitmap: TBitmap; X,Y: Integer); var SrcDC: HDC; begin SrcDC := GetDC(AWinControl.Handle); try BitBlt(Bitmap.Canvas.Handle,X,Y,AWinControl.ClientWidth,AWinControl.ClientHeight,SrcDC,SRCCOPY); finally ReleaseDC(AWinControl.Handle,SrcDC); end; end; function MakeGDIPColor(C: TColor; Alpha: Byte): Cardinal; var tmpRGB : TColorRef; begin tmpRGB := ColorToRGB(C); result := ((DWORD(GetBValue(tmpRGB)) shl BlueShift) or (DWORD(GetGValue(tmpRGB)) shl GreenShift) or (DWORD(GetRValue(tmpRGB)) shl RedShift) or (DWORD(Alpha) shl AlphaShift)); end; procedure TForm7.Button2Click(Sender: TObject); begin CreateTranparentForm.Show; end; function TForm7.CreateTranparentForm: TForm; const TabHeight = 50; TabWidth = 150; var DragControl: TWinControl; DragCanvas: TGPGraphics; Bitmap: TBitmap; ControlTop: Integer; DragBrush: TGPSolidBrush; begin DragControl := Panel1; Bitmap := TBitmap.Create; try Bitmap.PixelFormat := pf32bit; Bitmap.Height := TabHeight + DragControl.Height; Bitmap.Width := DragControl.Width; ControlTop := TabHeight; // <<<< I need to clear the bitmap background here!!! CopyControlToBitmap(DragControl,Bitmap,ControlTop); DragCanvas := TGPGraphics.Create(Bitmap.Canvas.Handle); DragBrush := TGPSolidBrush.Create(MakeGDIPColor(clBlue,255)); try // Do the painting... DragCanvas.FillRectangle(DragBrush,TabWidth,TabHeight); finally FreeAndNil(DragCanvas); FreeAndNil(DragBrush); end; Result := CreateAlphaBlendForm(Self,210); Result.BorderStyle := bsNone; finally FreeAndNil(Bitmap); end; end; end.
……和DFM:
object Form7: TForm7 Left = 0 Top = 0 Caption = 'frmMain' ClientHeight = 300 ClientWidth = 635 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 256 Top = 128 Width = 321 Height = 145 Caption = 'Panel1' TabOrder = 0 object Edit1: TEdit Left = 40 Top = 24 Width = 121 Height = 21 TabOrder = 0 Text = 'Edit1' end object Button1: TButton Left = 40 Top = 64 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 1 end end object Button2: TButton Left = 16 Top = 16 Width = 75 Height = 25 Caption = 'Go' TabOrder = 1 OnClick = Button2Click end end
谢谢.
解决方法
您似乎对UpdateLayeredWindow / BLENDFUNCTION的工作方式存在误解.使用UpdateLayeredWindow,您可以使用每像素alpha或颜色键.您使用ULW_ALPHA将其称为’dwFlags’,这意味着您打算使用每像素alpha,并将完全不透明的位图传递给预乘程序(所有像素的alpha值都为255).您的预乘程序不会修改Alpha通道,它所做的只是根据传递的位图的Alpha通道计算红绿色和蓝色值.最后,你得到的是一个完全不透明的位图,正确计算r,g,b(也是未经修改的,因为255/255 = 1).您将获得的所有透明度来自您分配给BlendFunction的SourceConstantAlpha的’210′. UpdateLayeredWindow给出的是一个半透明窗口,每个像素具有相同的透明度.
填充位图的区域(在问题的注释中提到)似乎有效,因为FillRect调用会覆盖alpha通道. alpha为255的像素现在的alpha值为0. IMO,通常这应该被视为导致未定义的行为,除非您完全理解它的工作方式/原因.
在当前状态下,问题需要使用颜色键而不是每像素alpha的答案,或者切割表单区域(SetWindowRgn).如果要使用每像素alpha,则应以不同方式应用于位图的某些部分.在对问题的评论中,您提到位图将在某个时刻进行缩放.您还必须确保缩放代码保留alpha通道(如果使用).