如何在没有边框的情况下使表单透明?

时间:2015-03-21 10:54:01

标签: delphi delphi-xe2

我想知道是否可以使表格透明(AlphaBlend)没有边框(最小化按钮的位置和所有那些)也是透明的?如果是,我该怎么办?

Screen shot

1 个答案:

答案 0 :(得分:1)

这是可能的,但您在此类表单上放置的任何控件都不可见。

这里有一些基本代码可以帮助您入门,但我从未在带边框的表单上使用它,因此边框功能可能存在问题。最有可能的是,您必须创建包含窗口边框的位图,并将该部分的alpha设置为255;

procedure PremultiplyBitmap(Bitmap: TBitmap);
var
  Row, Col: Integer;
  p: PRGBQuad;
begin
  Bitmap.AlphaFormat := afPremultiplied;
  for Row := 0 to Bitmap.Height - 1 do
    begin
      Col := Bitmap.Width;
      p := Bitmap.ScanLine[Row];
      while (Col > 0) do
        begin
          p.rgbBlue := p.rgbReserved * p.rgbBlue div 255;
          p.rgbGreen := p.rgbReserved * p.rgbGreen div 255;
          p.rgbRed := p.rgbReserved * p.rgbRed div 255;
          inc(p);
          dec(Col);
        end;
    end;
end;

procedure PremultiplyBitmapAlpha(Bitmap: TBitmap; Alpha: byte);
var
  Row, Col: Integer;
  p: PRGBQuad;
begin
  Bitmap.AlphaFormat := afPremultiplied;
  for Row := 0 to Bitmap.Height - 1 do
    begin
      Col := Bitmap.Width;
      p := Bitmap.ScanLine[Row];
      while (Col > 0) do
        begin
          p.rgbReserved := Alpha;
          p.rgbBlue := p.rgbReserved * p.rgbBlue div 255;
          p.rgbGreen := p.rgbReserved * p.rgbGreen div 255;
          p.rgbRed := p.rgbReserved * p.rgbRed div 255;
          inc(p);
          dec(Col);
        end;
    end;
end;

procedure BlendForm(Form: TCustomForm; Bmp: TBitmap);
var
  BitmapPos: TPoint;
  BitmapSize: TSize;
  BlendFunction: TBlendFunction;
begin
   BitmapPos := Point(0, 0);
   BitmapSize.cx := Bmp.Width;
   BitmapSize.cy := Bmp.Height;

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

   UpdateLayeredWindow(Form.Handle, 0, nil, @BitmapSize, Bmp.Canvas.Handle, @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
end;

procedure TForm1.CreateWnd;
var
  ExStyle: DWORD;
begin
  inherited;
  ExStyle := GetWindowLong(Handle, GWL_EXSTYLE);
  if (ExStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf32bit;
    Bmp.Width := ClientWidth;
    Bmp.Height := ClientHeight;
    PremultiplyBitmapAlpha(Bmp, 200);
    BlendForm(Form1, Bmp);
  finally
    Bmp.Free;
  end;
end;

您使用的位图必须是32位位图。如果要将整个位图与某个Alpha值混合,可以使用PremultiplyBitmapAlpha过程,如果您的位图具有Alpha通道,则可以使用PremultiplyBitmap过程。

为了提高速度,您可以使用预乘字节表,如下所示:

var
  PreMult: array[byte, byte] of byte;

procedure InitializePreMult;
var
  Row, Col: Integer;
begin
  // precalculate all possible values of a*b
  for Row := 0 to 255 do
    for Col := Row to 255 do
      PreMult[Row, Col] := Row*Col div 255;
end;

然后PremultiplyBitmap过程将使用该查找表:

procedure PremultiplyBitmap(Bitmap: TBitmap);
var
  Row, Col: integer;
  p: PRGBQuad;
begin
  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;