delphi – 如何在透明表单上创建具有清晰背景的位图?

前端之家收集整理的这篇文章主要介绍了delphi – 如何在透明表单上创建具有清晰背景的位图?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我正在尝试创建一个完全透明的表单,我在其上绘制具有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通道(如果使用).

猜你在找的Delphi相关文章