How do I create a bitmap that has a clear background on a transparent form?
I am trying to create a form that is completely transparent on top of which I draw a bitmap with alpha transparency. The problem is that I can't figure out how to set the background of the bitmap to Alpha 0 (totally see through).
Here's how the form looks now (note top right not transparent).
Here's how I want it to look (top right totally transparent):
Here's my source:
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.
...and the 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
Thanks.
You seem to have a misconception of how UpdateLayeredWindow
/ BLENDFUNCTION
works. With UpdateLayeredWindow
, you either use per-pixel alpha or a color-key. You're calling it with ULW_ALPHA
as 'dwFlags' which means you intend to use per-pixel alpha, and you pass a fully opaque bitmap to your premultiplication routine (all pixels have alpha value of 255). Your premultiplication routine does not modify alpha channel, all it does is to calculate the red green and blue values according to the alpha channel of the passed bitmap. In the end, what you've got is a fully opaque bitmap with properly calculated r, g, b (also unmodified, since 255/255 = 1). All the transparency you will get is from the '210' that you assign to SourceConstantAlpha
of BlendFunction
. What UpdateLayeredWindow
gives with these is a semi-transparent window, every pixel having the same transparency.
Filling a region of the bitmap, mentioned in the comments to the question, seems to work because the FillRect
call overwrites the alpha channel. Pixels having an alpha of 255 now have an alpha of 0. IMO, normally this should be considered to cause undefined behavior unless you fully understand how/why it works.
The question, in its current state, calls for an answer of using a color-key rather than per-pixel alpha, or cutting a region of the form ( SetWindowRgn
). If per-pixel alpha is to be used, it should be applied differently to parts of the bitmap. In the comments to the question, you mention the bitmap is to be scaled at some point. You've also got to be sure the scaling code preserves alpha channel, if it is used.
上一篇: requirejs与谷歌javascript关闭依赖管理
下一篇: 如何在透明表单上创建背景清晰的位图?