如何在透明表单上创建背景清晰的位图?
我正在尝试创建一个完全透明的表单,在其上我绘制了一个带有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,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, 0, nil, @BitmapSize, Bitmap.Canvas.Handle,
@BitmapPos, 0, @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, 0, 0, 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, 0, ControlTop);
DragCanvas := TGPGraphics.Create(Bitmap.Canvas.Handle);
DragBrush := TGPSolidBrush.Create(MakeGDIPColor(clBlue, 255));
try
// Do the painting...
DragCanvas.FillRectangle(DragBrush, 0, 0, TabWidth, TabHeight);
finally
FreeAndNil(DragCanvas);
FreeAndNil(DragBrush);
end;
Result := CreateAlphaBlendForm(Self, Bitmap, 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通常应该认为这应该导致未定义的行为,除非您完全理解它是如何/为什么会起作用。
在当前的状态下,这个问题要求使用颜色键而不是每像素阿尔法,或者切割窗体的一个区域( SetWindowRgn
)。 如果要使用每个像素的alpha,则它应该以不同方式应用于位图的各个部分。 在对这个问题的评论中,你提到位图将在某个时刻被缩放。 如果使用缩放代码,则还必须确保缩放代码能够保留Alpha通道。
上一篇: How do I create a bitmap that has a clear background on a transparent form?
下一篇: How to handle nested structure when traversing with state monad