创建异形窗口

Posted 2023-05-13 每天进步一点点……

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

$R *.dfm

var
  bit: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bit := TBitmap.Create;
  bit.LoadFromFile(\'c:\\temp\\test.bmp\');
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, bit);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  rgn1,rgn2: HRGN;
  x,y,w,h: Integer;
begin
  w := bit.Width;
  h := bit.Height;

  rgn1 := CreateRectRgn(0, 0, w, h);

  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      if bit.Canvas.Pixels[x,y] = clBlack then
      begin
        rgn2 := CreateRectRgn(x, y, x+1, y+1);
        CombineRgn(rgn1, rgn1, rgn2, RGN_XOR);
        DeleteObject(rgn2);
      end;
  SetWindowRgn(Handle, rgn1, True);

  Self.BorderStyle := bsNone;
  Self.Width := w;
  Self.Height := h;
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bit.Free;
end;

end.

Png异形窗口

同事演示了一个.NET的的PNG异形窗口.挺漂亮.于是也想用Delphi显摆一个.

关于Delphi用PNG做异形窗口的资料有不少.都是用GDIPlus或者TPNGImage组件加载PNG图像做的.

好在Delphi包装了微软的IWICImagingFactory接口,这样处理PNG的工作就交给操作系统去做了.

函数很简单一共就几行,关键就是UpdateLayeredWindow.

用Delphi2010提供的IWICImagingFactory接口的包装了,这次PNG的处理交给微软的操作系统了,一点问题也没有.其他版本的Delphi只要能对IWICImagingFactory进行包装,也一样能处理.但还是Delphi2010最方便.什么控件也不用,多余的东西都不要.

 

代码如下,很简单吧:)

unit YXForm;

 

interface

 

uses

  Windows, Forms, Classes, Graphics;

 

//从文件加载PNG

procedure YXFromFile(AForm : TForm; AFileName : String);

//从资源加载PNG

procedure YXFromResource(AForm : TForm; ResName : String; ResType : PWideChar; Instance : HINST = 0);

//从图像对象加载

procedure YXFromGraphic(AForm : TForm; AGraphic : TGraphic);

 

implementation

 

procedure YXFromFile(AForm : TForm; AFileName : String);

var

  wic : TWICImage;

begin

  wic := TWICImage.Create;

  wic.LoadFromFile(AFileName);

  YXFromGraphic(AForm, wic);

  wic.Free;

end;

 

procedure YXFromResource(AForm : TForm; ResName : String;ResType : PWideChar; Instance : HINST);

var

  wic : TWICImage;

  r : TResourceStream;

begin

  if Instance = 0 then

    Instance := HInstance;

  r := TResourceStream.Create(Instance, ResName, ResType);

  wic := TWICImage.Create;

  wic.LoadFromStream(r);

 

  YXFromGraphic(AForm, wic);

  wic.Free;

  r.Free;

end;

 

procedure YXFromGraphic(AForm : TForm; AGraphic : TGraphic);

var

  ptDst, ptSrc: TPoint;

  Size: TSize;

  BlendFunction: TBlendFunction;

  bmp : TBitmap;

begin

  bmp := TBitmap.Create;

  bmp.Assign(AGraphic);

  ptDst := Point(AForm.Left, AForm.Top);

  ptSrc := Point(0, 0);

  Size.cx := AGraphic.Width;

  Size.cy := AGraphic.Height;

 

  BlendFunction.BlendOp := AC_SRC_OVER;

  BlendFunction.BlendFlags := 0;

  BlendFunction.SourceConstantAlpha := $FF; // 透明度

  BlendFunction.AlphaFormat := AC_SRC_ALPHA;

 

  SetWindowLong(AForm.Handle, GWL_EXSTYLE, GetWindowLong(AForm.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);

  UpdateLayeredWindow(AForm.Handle,

     AForm.Canvas.Handle,

     @ptDst,

     @Size,

     bmp.Canvas.Handle,

     @ptSrc,

     0,

     @BlendFunction,

     ULW_ALPHA);

  bmp.Free();

end;

 

end.

 

 

想要用的时候很简单,举个例子:

  ff:=TForm2.Create(Self);//这里的form2指新建的窗口，请酌情修改。
  YXFromFile(ff, ‘c:/a.png‘);

  ff.Show;

实现动画也很容易.只要不停地YXFromFile(ff, ‘c:/a.png‘);调用一套动作PNG就可以了.

效果如下: