delphi 异形窗体

DELPHI 透明窗体

心血来潮想用delphi做透明窗体，要知道我虽然搞了N年编程，但什么也没编写成。惭愧的很，以前VCVB之类的光搞懂它们的控件就让我很费劲，没办法不懂英文。还是学DELPHI吧，听说是聪明程序员学习的语言。在网络上搜索下透明窗体，哈文章不少，视频也有，但都太繁琐，关键看不懂，总算有个简单的，实验成功了哈哈。博下来以后用：

unit StyleForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
const
  WS_EX_LAYERED = $80000;
  AC_SRC_OVER = $0;
  AC_SRC_ALPHA = $1;
  AC_SRC_NO_PREMULT_ALPHA = $1;
  AC_SRC_NO_ALPHA = $2;
  AC_DST_NO_PREMULT_ALPHA = $10;
  AC_DST_NO_ALPHA = $20;
  LWA_COLORKEY = $1;
  LWA_ALPHA = $2;
  ULW_COLORKEY = $1;
  ULW_ALPHA = $2;
  ULW_OPAQUE = $4;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var I:longint;

begin
  Form1.Brush.Color:=rgb(0,0,0);
  I:=getWindowLong(Handle, GWL_EXSTYLE);

  I:= I Or WS_EX_LAYERED;

  SetWindowLong (handle, GWL_EXSTYLE, I);
  SetLayeredWindowAttributes (handle, 0, 123, LWA_ALPHA);
end;

end.

后来又在网络上搜索了下发现有个更简单的：

只要在窗体的创建中加入

  form1.AlphaBlend:=true;
  form1.AlphaBlendValue:=100;

就行了。真晕！

DELPHI 异形窗体

一定有很多人看到过一些奇形怪状的窗体，例如一些屏幕精灵。其实实现起来非常容易，做到三点就好啦。下面我使用Delphi做了一个VCL控件（TBmpShape），你只需要指定一幅图片就可以将窗体变成你的图片的形状。

1。准备一幅位图图片，一定要BMP格式的

2。将VCL控件放在你的窗体（FORM）上，注意不能是其他的容器，设置PICTURE属性，指定制作好的图片。

3。设置图片的背景颜色，必须是你的图片的背景颜色准确值

4。在本窗体的FormCreate事件中写一行代码

BmpShape1.Apply;

做到上面四点就可以了，编译运行你的窗体，是不是不一样啊。

下面是具体的代码，不是太长吧。

unit BmpShape;
{
2002/08/22 by ultrared
根据BMP文件创建窗口
注意：
1. BMP文件最左上的一个点颜色作为背景色
2. BmpShape控件只能用在TForm容器上
3. BMP文件可以是256色或者24位色
4。大块背景色必须和背景色绝对相等才能获得正常效果
}
interface

uses
Forms,Windows, Messages, SysUtils, Classes, Controls, ExtCtrls,Graphics;

type
TBmpShape = class(TImage)
private
{ Private declarations }
BackColor:TColor;//背景颜色
FColorDither:boolean;//是否允许背景颜色有一定的抖动
function GetRegion:HRGN;//前景图片的区域
procedure setColorDither(cd:Boolean);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
procedure Apply;//使用效果
published
{ Published declarations }
property Dither:Boolean read FColorDither write setColorDither;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', );
end;

procedure TBmpShape.setColorDither(cd:Boolean);
begin
if cd<>FColorDither then
FColorDither:=cd;
end;

constructor TBmpShape.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
BackColor:=RGB(0,0,0);
FColorDither:=FALSE;
end;

//核心子程序，获得BMP图片的前景区域
function TBmpShape.GetRegion:HRGN;
var
i,j:integer;
rgn1,rgn2:HRGN;
StartY:integer;
r,g,b,r1,g1,b1:BYTE;
cc:TColor;
begin
if Picture.Bitmap<>nil then
begin
BackColor:=Picture.Bitmap.Canvas.Pixels[0,0];
rgn1:=CreateRectRgn(0,0,0,0);
for i:=0 to Picture.Bitmap.Width-1 do
begin
StartY:=-1;
for j:=0 to Picture.Bitmap.Height-1 do
begin
cc:=Picture.Bitmap.Canvas.Pixels[i,j];
if FColorDither then
begin
//允许和背景有一定的色差
r:=(cc and $FF0000) shr 16;
g:=(cc and $FF00) shr 8;
b:=cc and $FF;
r1:=(BackColor and $FF0000) shr 16;
g1:=(BackColor and $FF00) shr 8;
b1:=BackColor and $FF;
if (abs(r-r1)<10) and (abs(g-g1)<10) and (abs(b-b1)<10) then
begin
if (StartY>=0) and (j>=StartY) then
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
StartY:=-1;
end;
end
else
begin
if Starty<0 then
StartY:=j
else if j=(Picture.Bitmap.Height-1) then //最下面一个点
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
end;
end;
end
else //不允许色差
begin
if cc=BackColor then
begin
if (StartY>=0) and (j>=StartY) then
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
StartY:=-1;
end;
end
else
begin
if Starty<0 then
StartY:=j
else if j=(Picture.Bitmap.Height-1) then //最下面一个点
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
end;
end;
end;
end;
end;
result:=rgn1;
end
else
result:=0;
end;

procedure TBmpShape.Apply;
begin
if Parent is TForm then
begin
Left:=0;
Top:=0;
Width:=Picture.Bitmap.Width;
Height:=Picture.Bitmap.Height;
with (Parent as Tform) do
begin
BorderStyle:=bsNone;
Width:=Self.Width;
Height:=Self.Height;
end;
SetWindowRgn(Parent.Handle,GetRegion,FALSE);
end;
end;

end.

Delphi磁性窗口

昨天要用到磁性窗口,就是两个窗口离得近到一个距离就吸附到一起.拖动主窗口,吸附窗体一块运动.
到网上搜了一下,基本没见到可以使用的.有个东东,还是收费的.没办法自己写了一个.
用法很简单,把你的窗口都改成从这个继承即可生效.例如
type
  TForm3 = class(TCustomMagnetForm)
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form3: TForm3;
不多说了,上代码
{ ******************************************************* }
{ }
{ 磁性吸附窗口 }
{ }
{ 版权所有 (C) 2011 wr960204武稀松 }
{ }
{ ******************************************************* }

unit MagnetForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Generics.Collections;

type
  TCustomMagnetForm = class(TForm)
  private type
    TMagnetFormList = TList<TCustomMagnetForm>;
    class var
    // 吸附距离
      FMagnetBuffer: Integer;

  var
    // 吸附子窗口容器
    FMagnetClientList: TMagnetFormList;
    // 相对主窗口的位置
    FMagnetPosOffset: TPoint;
    // 可否随主窗口移动
    FEnableMagnetMoveClient: Boolean;
    // 移除子窗口
    procedure RemoveMagnetForm(AForm: TCustomMagnetForm);
    // 添加子窗口
    procedure AddMagnetForm(AForm: TCustomMagnetForm; Value: TPoint);
    // 处理子窗口吸附
    function ProcessClient(var ServerBound, ClientBound: TRect): Boolean;
    // 处理主窗口吸附
    function ProcessServer(var ServerBound, ClientBound: TRect;
      AClient: TCustomMagnetForm): Boolean;
    // 主窗口移动
    procedure ProcessServerMove();

  protected
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging);
      message WM_WINDOWPOSCHANGING;
    procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure DoClose(var Action: TCloseAction); override;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class property MagnetBuffer: Integer read FMagnetBuffer write FMagnetBuffer;
  end;

implementation

{ TCustomMagnetForm }

constructor TCustomMagnetForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMagnetClientList := TMagnetFormList.Create;
end;

destructor TCustomMagnetForm.Destroy;
begin
  if Self <> Application.MainForm then
    RemoveMagnetForm(Self);
  FMagnetClientList.Free;
  inherited Destroy;
end;

procedure TCustomMagnetForm.DoClose(var Action: TCloseAction);
begin
  inherited DoClose(Action);
  if Self <> Application.MainForm then
    RemoveMagnetForm(Self);
end;

function TCustomMagnetForm.ProcessClient(var ServerBound,
  ClientBound: TRect): Boolean;
var
  lspace, rspace, tspace, bspace: Integer;
begin
  Result := False;
  lspace := ABS(ClientBound.Right - ServerBound.Left);
  rspace := ABS(ClientBound.Left - ServerBound.Right);
  tspace := ABS(ClientBound.Bottom - ServerBound.Top);
  bspace := ABS(ClientBound.Top - ServerBound.Bottom);

  FMagnetPosOffset := Point(ClientBound.Left - ServerBound.Left,
    ClientBound.Top - ServerBound.Top);

  if (ClientBound.Bottom > ServerBound.Top) and
    (ClientBound.Top < ServerBound.Bottom) then
  begin
    if lspace < rspace then
    begin
      if lspace < FMagnetBuffer then
      begin
        AddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ClientBound, (ServerBound.Left - ClientBound.Right), 0);
        Result := True;
      end;
    end
    else
    begin
      if rspace < FMagnetBuffer then
      begin
        AddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ClientBound, (ServerBound.Right - ClientBound.Left), 0);
        Result := True;
      end;
    end;
  end;
  if (ClientBound.Right > ServerBound.Left) and
    (ClientBound.Left < ServerBound.Right) then
  begin
    if tspace < bspace then
    begin
      if tspace < FMagnetBuffer then
      begin
        AddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ClientBound, 0, ServerBound.Top - ClientBound.Bottom);
        Result := True;
      end;
    end
    else
    begin
      if bspace < FMagnetBuffer then
      begin
        AddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ClientBound, 0, ServerBound.Bottom - ClientBound.Top);
        Result := True;
      end;
    end;
  end;
end;

function TCustomMagnetForm.ProcessServer(var ServerBound, ClientBound: TRect;
  AClient: TCustomMagnetForm): Boolean;
var
  lspace, rspace, tspace, bspace: Integer;
begin
  Result := False;
  lspace := ABS(ClientBound.Right - ServerBound.Left);
  rspace := ABS(ClientBound.Left - ServerBound.Right);
  tspace := ABS(ClientBound.Bottom - ServerBound.Top);
  bspace := ABS(ClientBound.Top - ServerBound.Bottom);

  FMagnetPosOffset := Point(ClientBound.Left - ServerBound.Left,
    ClientBound.Top - ServerBound.Top);

  if (ClientBound.Bottom > ServerBound.Top) and
    (ClientBound.Top < ServerBound.Bottom) then
  begin
    if lspace < rspace then
    begin
      if lspace < FMagnetBuffer then
      begin
        AddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ServerBound, -(ServerBound.Left - ClientBound.Right), 0);
        Result := True;
      end;
    end
    else
    begin
      if rspace < FMagnetBuffer then
      begin
        AddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ServerBound, -(ServerBound.Right - ClientBound.Left), 0);
        Result := True;
      end;
    end;
  end;
  if (ClientBound.Right > ServerBound.Left) and
    (ClientBound.Left < ServerBound.Right) then
  begin
    if tspace < bspace then
    begin
      if tspace < FMagnetBuffer then
      begin
        AddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ServerBound, 0, -(ServerBound.Top - ClientBound.Bottom));
        Result := True;
      end;
    end
    else
    begin
      if bspace < FMagnetBuffer then
      begin
        AddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,
          ClientBound.Top - ServerBound.Top));
        OffsetRect(ServerBound, 0, -(ServerBound.Bottom - ClientBound.Top));
        Result := True;
      end;
    end;
  end;
end;

procedure TCustomMagnetForm.ProcessServerMove;
var
  i: Integer;
  p: TPoint;
begin
  Inherited;
  if Self = Application.MainForm then
  begin
    if FMagnetClientList <> nil then
      for i := 0 to FMagnetClientList.Count - 1 do
      begin
        if FMagnetClientList[i].FEnableMagnetMoveClient then
        begin
          p := FMagnetClientList[i].FMagnetPosOffset;
          FMagnetClientList[i].SetBounds(Left + p.X, Top + p.Y,
            FMagnetClientList[i].Width, FMagnetClientList[i].Height);
        end;
      end;
  end;
end;

procedure TCustomMagnetForm.AddMagnetForm(AForm: TCustomMagnetForm;
  Value: TPoint);
var
  Index: Integer;
begin
  if (Application.MainForm <> nil) and
    (Application.MainForm is TCustomMagnetForm) then
    with TCustomMagnetForm(Application.MainForm) do
      if FMagnetClientList <> nil then
      begin
        AForm.FMagnetPosOffset := Value;
        Index := FMagnetClientList.IndexOf(AForm);
        if Index < 0 then
        begin
          Index := FMagnetClientList.Add(AForm);
        end;
      end;
end;

procedure TCustomMagnetForm.RemoveMagnetForm(AForm: TCustomMagnetForm);
begin
  AForm.FEnableMagnetMoveClient := False;
  if (Application.MainForm <> nil) and
    (Application.MainForm is TCustomMagnetForm) then
    with TCustomMagnetForm(Application.MainForm) do
      if FMagnetClientList <> nil then
      begin
        if FMagnetClientList.IndexOf(AForm) >= 0 then
        begin
          FMagnetClientList.Remove(AForm);
        end;
      end;
end;

procedure TCustomMagnetForm.WMMove(var Message: TWMMove);
begin
  ProcessServerMove;
end;

procedure TCustomMagnetForm.WMMoving(var Message: TWMMoving);
begin
  ProcessServerMove;
end;

procedure TCustomMagnetForm.WMSysCommand(var Message: TWMSysCommand);
  procedure SetAllClientEnableMove();
  var
    i: Integer;
  begin
    Inherited;
    if Self = Application.MainForm then
    begin
      if FMagnetClientList <> nil then
        for i := 0 to FMagnetClientList.Count - 1 do
        begin
          FMagnetClientList[i].FEnableMagnetMoveClient := True;
        end;
    end;
  end;

begin
  Inherited;
  if (Message.CmdType and SC_MOVE) = SC_MOVE then
  begin
    SetAllClientEnableMove();
  end;
end;

procedure TCustomMagnetForm.WMWindowPosChanging(var Message
  : TWMWindowPosChanging);
var
  ServerBound, ClientBound: TRect;
  lspace, rspace, tspace, bspace: Integer;
  MainForm: TCustomMagnetForm;
  oBound: TRect;
  i: Integer;
begin
  inherited;

  if (Message.WindowPos^.flags and SWP_NOMOVE) = SWP_NOMOVE then
  begin
    Exit;
  end;

  if (Application.MainForm = nil) or
    (not(Application.MainForm is TCustomMagnetForm)) then
    Exit;

  if (Application.MainForm = Self) then
  begin
    ServerBound := Rect(Message.WindowPos^.X, Message.WindowPos^.Y,
      Message.WindowPos^.X + Message.WindowPos^.cx, Message.WindowPos^.Y +
      Message.WindowPos^.cy);
    for i := 0 to Screen.FormCount - 1 do
    begin
      if (Screen.Forms[i] <> Self) and (Screen.Forms[i] is TCustomMagnetForm)
        and ((FMagnetClientList.IndexOf(TCustomMagnetForm(Screen.Forms[i])) < 0)
        or (not TCustomMagnetForm(Screen.Forms[i])
        .FEnableMagnetMoveClient)) then
      begin
        ClientBound := Screen.Forms[i].BoundsRect;
        TCustomMagnetForm(Screen.Forms[i]).FEnableMagnetMoveClient := False;
        if ProcessServer(ServerBound, ClientBound,
          TCustomMagnetForm(Screen.Forms[i])) then
        begin
          Message.WindowPos^.X := ServerBound.Left;
          Message.WindowPos^.Y := ServerBound.Top;
          Message.WindowPos^.cx := ServerBound.Right - ServerBound.Left;
          Message.WindowPos^.cy := ServerBound.Bottom - ServerBound.Top;

          break;
        end;
      end;
    end;
  end
  else
  begin

    MainForm := TCustomMagnetForm(Application.MainForm);
    MainForm.RemoveMagnetForm(Self);
    ServerBound := Application.MainForm.BoundsRect;
    ClientBound := Rect(Message.WindowPos^.X, Message.WindowPos^.Y,
      Message.WindowPos^.X + Message.WindowPos^.cx, Message.WindowPos^.Y +
      Message.WindowPos^.cy);
    ProcessClient(ServerBound, ClientBound);
    Message.WindowPos^.X := ClientBound.Left;
    Message.WindowPos^.Y := ClientBound.Top;
    Message.WindowPos^.cx := ClientBound.Right - ClientBound.Left;
    Message.WindowPos^.cy := ClientBound.Bottom - ClientBound.Top;
    FEnableMagnetMoveClient := True;
  end;
end;

initialization

TCustomMagnetForm.FMagnetBuffer := 10;

finalization

end.

绘制圆角矩形的窗体

制作圆角矩形的窗体：

procedure TPortForm.FormCreate(Sender: Tobject);
var 
hr :thandle;
begin
hr:=createroundrectrgn(0,0,width,height,20,20);
setwindowrgn(handle,hr,true); 
end;


如果不要窗体外框，则使用：

01.procedure TPortForm.FormCreate(Sender: Tobject);
02.var hr :thandle;
03.begin
04.hr:=createroundrectrgn(1,1,width-2,height-2,20,20);
05.setwindowrgn(handle,hr,true); 
06.end;


由于第一段代码做出来的窗口，圆角部份会没有边框，使用下面的代码做出边框：

01.procedure TForm1.FormPaint(Sender: TObject);
02.var
03.DC: HDC;
04.Pen: HPen;
05.OldPen: HPen;
06.OldBrush: HBrush;
07.begin
08.DC := GetWindowDC(Handle);
09.Pen := CreatePen(PS_SOLID, 1, clGray);
10.OldPen := SelectObject(DC, Pen); //载入自定义的画笔,保存原画笔
11.OldBrush := SelectObject(DC, GetStockObject(NULL_BRUSH));//载入空画刷,保存原画刷
12.RoundRect(DC, 0, 0, Width-1, Height-1,21,21); //画边框
13.SelectObject(DC,OldBrush);//载入原画刷
14.SelectObject(DC,OldPen); // 载入原画笔
15.DeleteObject(Pen);
16.ReleaseDC(Handle, DC);
17.end;

Delphi做异型窗体PNG透明

unit UnitYXForm;
interface
uses
  Windows, Forms, Classes, Graphics;
//从文件加载PNG
procedure YXForm_FromFile(AForm : TForm; AFileName : String);
//从资源加载PNG
procedure YXForm_FromResource(AForm : TForm; ResName : String; ResType : PWideChar; Instance : HINST = 0);
//从图像对象加载
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);
implementation
procedure YXForm_FromFile(AForm : TForm; AFileName : String);
var
  wic : TWICImage;
begin
  wic := TWICImage.Create;
  wic.LoadFromFile(AFileName);
  YXForm_FromGraphic(AForm, wic);
  wic.Free;
end;
procedure YXForm_FromResource(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);
  YXForm_FromGraphic(AForm, wic);
  wic.Free;
  r.Free;
end;
procedure YXForm_FromGraphic(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);
  YXForm_FromFile(ff, 'c:a.png');
  ff.Show;
实现动画也很容易.只要不停地YXForm_FromFile(ff, 'c:a.png');调用一套动作PNG就可以了.

delphi 半透明窗体类

{*******************************************************************************
  半透明窗体控件
  版本：1.0
  功能说明 :
  1.支持颜色和图片半透明
  2.暂时只能手动指定背景图片
  3.可调透明度(0..255)
  4.可控制是否可移动窗体
 
  联系方式： Email:  mdejtoz@163.com
*******************************************************************************}
unit uTranslucentForm;
 
interface
  uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ActiveX, Gdiplus,GdipUtil,StdCtrls, XPMan, ExtCtrls;
type
  TTranslucentForm = class(TComponent)
  private
    FAlpha : Byte;
    FOverlayerForm : TForm;
    FBackground : TFileName;
    FOwner : TForm;
    FFirstTime : Boolean;
    FMouseEvent : TMouseEvent;
    FOldOnActive : TNotifyEvent;
    FOldOverlayWndProc : TWndMethod;
    FMove : Boolean;
    procedure SetAlpha(const  value : Byte) ;
    procedure SetBackground(const value : TFileName);
    procedure RenderForm(TransparentValue: Byte);
    procedure OverlayWndMethod(var Msg : TMessage);
    procedure InitOverForm;
    procedure OnOwnerMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure OnOwnerActive(Sender : TObject);
    procedure SetMove(const value : Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property AlphaValue : Byte read FAlpha write SetAlpha;
    property Background : TFileName read FBackground write SetBackground;
    property Move : Boolean read FMove write SetMove;
  end;
  procedure Register;
implementation
 
procedure Register;
begin
  RegisterComponents('MyControl', [TTranslucentForm]);
end;
{ TTranslucentForm }
 
constructor TTranslucentForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwner := TForm(AOwner);
  FAlpha := 255 ;
  FMove := True;
  if (csDesigning in ComponentState) then Exit;
  InitOverForm;
  SetWindowLong(FOverlayerForm.Handle,GWL_EXSTYLE,GetWindowLong(FOverlayerForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
  RenderForm(FAlpha);
end;
 
destructor TTranslucentForm.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
    if Assigned(FOverlayerForm) then
    begin
      FOverlayerForm.WindowProc := FOldOverlayWndProc;
      FreeAndNil(FOverlayerForm);
    end;
  end; 
  inherited Destroy;
end;
 
procedure TTranslucentForm.InitOverForm;
begin
  FOverlayerForm := TForm.Create(nil);
  with FOverlayerForm do
  begin
    Left := FOwner.Left ;
    Top := FOwner.Top;
    Width := FOwner.Width ;
    Height := FOwner.Height ;
    BorderStyle := bsNone;
    color := FOwner.Color;
    Show;
    FOldOverlayWndProc := FOverlayerForm.WindowProc;
    FOverlayerForm.WindowProc := OverlayWndMethod;
  end;
  with FOwner do
  begin
    Left := FOwner.Left ;
    Top := FOwner.Top ;
    Color := clOlive;
    TransparentColorValue := clOlive;
    TransparentColor := True;
    BorderStyle := bsNone;
    FMouseEvent := OnMouseDown;
    FOldOnActive := OnActivate;
    OnActivate := OnOwnerActive;
    OnMouseDown := OnOwnerMouseDown;
    Show;
  end;
  FFirstTime := True;
  RenderForm(FAlpha);
end;
 
procedure TTranslucentForm.OnOwnerActive(Sender: TObject);
begin
  with FOverlayerForm do
  begin
    Left := FOwner.Left  ;
    Top := FOwner.Top ;
    Width := FOwner.Width ;
    Height := FOwner.Height ;
  end;
  RenderForm(FAlpha);
  if Assigned(FOldOnActive) then FOldOnActive(FOwner);
end;
 
procedure TTranslucentForm.OnOwnerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOverlayerForm) and FMove then
  begin
    ReleaseCapture;
    SendMessage(FOverlayerForm.Handle,WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
    FOwner.Show;
    if Assigned(FMouseEvent) then FMouseEvent(Sender,Button,Shift, X, Y);
  end;
end;
 
procedure TTranslucentForm.OverlayWndMethod(var Msg: TMessage);
begin
  if (Msg.Msg = WM_MOVE) and FMove then
  begin
    if Assigned(FOverlayerForm) then
    begin
      FOwner.Left := FOverlayerForm.Left  ;
      FOwner.Top := FOverlayerForm.Top ;
    end;
  end;
  if Msg.Msg = CM_ACTIVATE then
  begin
    if FFirstTime then FOwner.Show;
    FFirstTime := False;
  end;
  FOldOverlayWndProc(Msg);
end;
 
procedure TTranslucentForm.RenderForm(TransparentValue: Byte);
var
  zsize: TSize;
  zpoint: TPoint;
  zbf: TBlendFunction;
  TopLeft: TPoint;
  WR: TRect;
  GPGraph: TGPGraphics;
  m_hdcMemory: HDC;
  hdcScreen: HDC;
  hBMP: HBITMAP;
  FGpBitmap  , FBmp: TGpBitmap;
  gd : TGpGraphics;
  gBrush : TGpSolidBrush;
begin
  if (csDesigning in ComponentState) then Exit;
  if not FileExists(FBackground) then //如果背景图不存在
  begin
    FGpBitmap := TGpBitmap.Create(FOwner.Width,FOwner.Height);
    gd := TGpGraphics.Create(FGpBitmap);
    //颜色画刷
    gBrush := TGpSolidBrush.Create(ARGBFromTColor(FOverlayerForm.Color));
    //填充
    gd.FillRectangle(gBrush,GpRect(0,0,FGpBitmap.Width,FGpBitmap.Height));
    FreeAndNil(gd);
    FreeAndNil(gBrush);
  end
  else
  begin
    try
      //读取背景图
      FBmp := TGpBitmap.Create(FBackground);
      FGpBitmap := TGpBitmap.Create(FOwner.Width,FOwner.Height);
      gd := TGpGraphics.Create(FGpBitmap);
      gd.DrawImage(FBmp,GpRect(0,0,FGpBitmap.Width,FGpBitmap.Height),0,0,FBmp.Width,FBmp.Height,utPixel);
      FreeAndNil(gd);
      FreeAndNil(FBmp);
    except
      Exit;
    end;
  end;
  hdcScreen := GetDC(0);
  m_hdcMemory := CreateCompatibleDC(hdcScreen);
  hBMP := CreateCompatibleBitmap(hdcScreen, FGpBitmap.Width, FGpBitmap.Height);
  SelectObject(m_hdcMemory, hBMP);
  GPGraph := TGPGraphics.Create(m_hdcMemory);
  try
    GPGraph.DrawImage(FGpBitmap, 0, 0, FGpBitmap.Width, FGpBitmap.Height);
    zsize.cx := FGpBitmap.Width;
    zsize.cy := FGpBitmap.Height;
    zpoint := Point(0, 0);
    with zbf do
    begin
      BlendOp := AC_SRC_OVER;
      BlendFlags := 0;
      SourceConstantAlpha := TransparentValue;
      AlphaFormat := AC_SRC_ALPHA;
    end;
 
    GetWindowRect(FOverlayerForm.Handle, WR);
    TopLeft := WR.TopLeft;
    UpdateLayeredWindow(FOverlayerForm.Handle, 0, @TopLeft, @zsize, GPGraph.GetHDC, @zpoint,0, @zbf, 2);
  finally
    GPGraph.ReleaseHDC(m_hdcMemory);
    ReleaseDC(0, hdcScreen);
    DeleteObject(hBMP);
    DeleteDC(m_hdcMemory);
    GPGraph.Free;
  end;
  FreeAndNil(FGpBitmap);
end;
 
procedure TTranslucentForm.SetAlpha(const  value : Byte);
begin
  FAlpha := Value;
  RenderForm(FAlpha);
end;
 
procedure TTranslucentForm.SetBackground(const value: TFileName);
begin
  FBackground := value;
  RenderForm(FAlpha);
end;
 
procedure TTranslucentForm.SetMove(const value: Boolean);
begin
  FMove := value;
end;
 
end.

delphi 窗体全透明，但窗体上的控件不透明

//窗体全透明，但窗体上的控件不透明  
procedure TForm1.Button1Click(Sender: TObject);  
 Var  
   frmRegion, tempRegion: HRGN;  
   i: Integer;  
   Arect: TRect;  
 Begin  
   frmRegion := 0;  
   For I:= 0 To ControlCount - 1 Do Begin  
     aRect := Controls[i].BoundsRect;  
     OffsetRect( aRect, clientorigin.x - left, clientorigin.y - top );  
     tempRegion := CreateRectRgnIndirect( aRect );  
     If frmRegion = 0 Then  
       frmRegion := tempRegion  
     Else Begin  
       CombineRgn( frmRegion, frmRegion, tempRegion, RGN_OR );  
       DeleteObject( tempRegion );  
     End;  
   End;  
   tempregion :=  
     CreateRectRgn( 0, 0, Width,  
                    GetSystemMetrics( SM_CYCAPTION )+  
                    GetSystemMetrics( SM_CYSIZEFRAME )+  
                    GetSystemMetrics( SM_CYMENU ) * Ord(Menu <> Nil));  

   CombineRgn( frmRegion, frmRegion, tempRegion, RGN_OR );  
   DeleteObject( tempRegion );  
   SetWindowRgn( handle, frmRegion, true );  
 End;  

delphi 透明

procedure TForm1.FormCreate(Sender: TObject);
  var
  rgn:HRGN;
  begin
    Self.Color := clRed;
    BeginPath(Canvas.Handle);
    SetBkMode(Canvas.Handle,TRANSPARENT   );
    Canvas.Font.Name:='宋体';
    Canvas.Font.Size:=100;
    Canvas.TextOut(20,20,'My Baby?');
    EndPath(Canvas.Handle);
    rgn:=   PathToRegion(Canvas.Handle);
    SetWindowRgn(Handle,rgn,true);
  end;


<pre class="delphi" name="code">unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  const   
        {An   array   of   points   for   the   star   region}   
        RgnPoints:array[1..10]   of   TPoint=   
        ((x:203;y:22),(x:157;y:168),(x:3;y:168),(x:128;y:257),   
        (x:81;y:402),(x:203;y:334),(x:325;y:422),(x:278;y:257),   
        (x:402;y:168),(x:249;y:168));//确定顶点   
        LinePoints:array[1..11]   of   Tpoint=   
        ((x:199;y:0),(x:154;y:146),(x:2;y:146),(x:127;y:235),   
        (x:79;y:377),(x:198;y:308),(x:320;Y:396),(x:272;y:234),   
        (x:396;y:146),(x:244;y:146),(x:199;Y:0));

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var   Rgn:HRGN;
begin
    Setwindowpos(Form1.Handle,HWND_TOPMOST,Form1.Left,form1.Top,Form1.Width,Form1.Height,0);
    Rgn:=CreatepolygonRgn(Rgnpoints,High(RgnPoints),ALTERNATE);
    SetWindowRgn(Handle,rgn,True);
    Form1.color:=clgreen;
end;

end.

</pre><pre class="delphi" name="code">以下是用Api实现透明窗体的代码,最的一次第三个参数为透明的程度,范围为0~255,0为完全透明,255完全不透明.具体可参考

  SetWindowLong(self.Handle,GWL_EXSTYLE,
     GetWindowLong(Self.Handle,GWL_EXSTYLE) xor $80000);
  SetLayeredWindowAttributes(Self.Handle,0,100,LWA_ALPHA);
</pre><br>
<br>
<pre></pre>
<pre></pre>

半透明窗体

unit xDrawForm;

interface
  uses Windows, Messages, SysUtils, Classes, Controls, Forms, Menus,
  Graphics,GDIPOBJ,GDIPAPI,GDIPUTIL;


type

  TwwGDIImage = class
  public
    n_Pos_X : Integer;
    n_Pos_Y : Integer;
    n_Width : Integer;
    n_Height : Integer;
    GPImageNormal : TGPImage;

    procedure CreateImageNormal(wsFileName: WideString;nPosX,nPosY,nW,nH:Integer);
  end;

  TwwGDIButton = class(TwwGDIImage)
  public
    GPImageHot : TGPImage;
    GPImageDown : TGPImage;
  end;


  TwwCanvas = class(TObject)
  private
    m_hdcMemory: HDC;
    hdcScreen: HDC;
    hBMP: HBITMAP;
    m_Blend: BLENDFUNCTION;
    // 事件
    FGPGraph: TGPGraphics;
    FOnDrawImage: TNotifyEvent;

    procedure BeginDraw(); // 绘图前置工作
    procedure EndDraw(Handle:THandle);   // 绘图收尾工作
   public
    sizeWindow: SIZE;
    ptSrc: TPOINT;
    n_Handle : THandle;
    procedure RePaint(h:THandle);
    procedure InitCanvas(nx,ny:Integer);
    procedure wwDrawImage(wwGDIImage :TwwGDIImage);
    property GPGraph: TGPGraphics read FGPGraph write FGPGraph;
    property OnDrawImage: TNotifyEvent read FOnDrawImage write FOnDrawImage;
  end;


implementation

{ TwwCanvas }

procedure TwwCanvas.BeginDraw;
begin
  // 获取桌面屏幕设备
  hdcScreen := GetDC(0);
  // 创建一个与指定设备兼容的内存设备上下文环境（DC）
  m_hdcMemory := CreateCompatibleDC(hdcScreen);
  // 创建与指定的设备环境相关的设备兼容的位图
  hBMP := CreateCompatibleBitmap(hdcScreen, sizeWindow.cx, sizeWindow.cy );
  // 选择一对象到指定的设备上下文环境中,该新对象替换先前的相同类型的对象
  SelectObject(m_hdcMemory, hBMP);
  // 创建画布
  GPGraph := TGPGraphics.Create(m_hdcMemory);
end;

procedure TwwCanvas.wwDrawImage(wwGDIImage: TwwGDIImage);
begin
  GPGraph.DrawImage(
  wwGDIImage.GPImageNormal,
  wwGDIImage.n_Pos_X,
  wwGDIImage.n_Pos_Y,
  wwGDIImage.n_Width,
  wwGDIImage.n_Height)
end;

procedure TwwCanvas.EndDraw(Handle:THandle);
begin
  //  设置窗体风格
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
  //  执行透明混合
  UpdateLayeredWindow(Handle, hdcScreen, nil,@sizeWindow, m_hdcMemory, @ptSrc, 0, @m_Blend, ULW_ALPHA);
  //  设置窗体位置
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

  // 各种释放就对了.. 不然画起来会糊
  GPGraph.ReleaseHDC(m_hdcMemory);
  ReleaseDC(0, hdcScreen);
  hdcScreen := 0;
  DeleteObject(hBMP);
  DeleteDC(m_hdcMemory);
  m_hdcMemory := 0;
  GPGraph.Free;
end;

procedure TwwCanvas.RePaint(h:THandle);
begin
  if Assigned(FOnDrawImage) then
  begin
    BeginDraw();
    FOnDrawImage(Self);
    EndDraw(h);
  end;
end;

procedure TwwCanvas.InitCanvas(nx, ny: Integer);
begin
  m_Blend.BlendOp := AC_SRC_OVER; //   the   only   BlendOp   defined   in   Windows   2000
  m_Blend.BlendFlags := 0; //   Must   be   zero
  m_Blend.AlphaFormat := AC_SRC_ALPHA; //This   flag   is   set   when   the   bitmap   has   an   Alpha   channel
  m_Blend.SourceConstantAlpha := 255;

  sizeWindow.cx := nx;
  sizeWindow.cy := ny;
  ptSrc := Point(0,0);
end;

{ TwwGDIImage }

procedure TwwGDIImage.CreateImageNormal(wsFileName: WideString;nPosX,nPosY,nW,nH:Integer);
begin
  Self.GPImageNormal := TGPImage.Create(wsFileName);
  Self.n_Pos_X := nPosX;
  Self.n_Pos_Y := nPosY;
  Self.n_Width := nW;
  Self.n_Height:= nH;
end;

end.





unit uMainForm;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPOBJ,GDIPAPI,GDIPUTIL;


type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);


  private
    { Private declarations }
  public
    procedure DrawImage(Sender: TObject);
    { Public declarations }
  end;


var
  Form1: TForm1;


implementation
uses xDrawForm;
var
  wwCanvas : TwwCanvas = nil;
  img_BackGround:   TwwGDIImage= nil;       // 背景图
//  img_ProgressBar1:  TwwGDIImage= nil;      // 上滚动条
//  img_ProgressBar2:  TwwGDIImage= nil;      // 下滚动条
//  img_Lighting:     TwwGDIImage= nil;       // 闪光点


{$R *.dfm}


procedure TForm1.DrawImage(Sender: TObject);
begin
   TwwCanvas(Sender).wwDrawImage(img_BackGround);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  BorderStyle := bsNone;
  wwCanvas := TwwCanvas.Create();
  wwCanvas.InitCanvas(872,690);
  wwCanvas.OnDrawImage := Self.DrawImage;




  img_BackGround := TwwGDIImage.Create();
  img_BackGround.CreateImageNormal('BackGround.png',0,0,872,690);


end;


procedure TForm1.FormShow(Sender: TObject);
begin
  wwCanvas.RePaint(Self.Handle);
end;


end.

窗体嵌入桌面

窗体最前面的显示方式:
procedure Createparams(var params: TCreateParams);override;
procedure Createparams(var params: TCreateParams);
begin
  inherited CreateParams(Params);
  with params do
  begin
    Style:=WS_POPUP;
     //ExStyle := WS_EX_TOPMOST OR WS_EX_ACCEPTFILES or WS_DLGFRAME;
    ExStyle :=  WS_EX_TOOLWINDOW or WS_EX_TOPMOST or WS_EX_NOACTIVATE or WS_EX_WINDOWEDGE;
    WndParent :=GetDesktopwindow;  //确实可以使用之为最前面
  end;
end;
 
窗体贴在桌面的方法:
procedure WndProc(var Message: TMessage); override;
procedure FormCreate(Sender: TObject);
begin
windows.SetParent(Self.Handle,FindWindowEx(FindWindow('Progman',nil),0,'shelldll_defview',nil));//将窗口设置为屏幕的子窗口 
//以下显示桌面 
keybd_event(91,0,0,0); 
keybd_event(77,0,0,0); 
keybd_event(77,0,KEYEVENTF_KEYUP,0); 
keybd_event(91,0,KEYEVENTF_KEYUP,0);
end;
procedure WndProc(var Message: TMessage);
begin
  if not ( (Message.Msg=WM_SYSCOMMAND) AND (Message.WParam=SC_MINIMIZE) )then
  inherited WndProc(Message);//最小化无效
end;

使用PNG实现半透明的窗体

Delphi中标准控件是不支持png图片的，据说从Window2000后增加gdiplus.dll库处理更多的gdi图像，其中包括png。
  关键的几个api
  GdipCreateBitmapFromFile()，从文件载入图像（不单只Bitmap）
  GdipCreateBitmapFromStreamICM()，从流中入图像
  GdipCreateHBITMAPFromBitmap()，获取图像的位图
  GdipDisposeImage()，释放图像资源
 
  开始直接调用GdipCreateBitmapFromFile没有成功，返回18的错误
  查一下资料这个错误是：“GdiplusNotInitialized”
  看来必须的初始化gdiplus。
  网上找到一套“TGPBitmap”相关的组件，封装了gdiplus的调用。可以参考其中的代码。
 
  png载入后，再取出其位图。特别注意，这个位图是32位的。包括了R、G、B、Alpha四个色值，其中Alpha就是透明度。UpdateLayeredWindow()API函数可以支持Alpha风格。
 
  如何从流中载入？如何将VCL的流处理成IStream？看看代码吧。
 
效果图：

cj7.JPG 
准备一张Png图片，编写rc文件，然后加入到工程中。
代码：
CJ7.rc
Png_Cj7 PNG "CJ7.png"
 
CJ7Unit.pas
unit CJ7Unit;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
type
  TFormCJ7 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FormCJ7: TFormCJ7;
implementation
{$R *.dfm}
uses ActiveX;
type
  DebugEventLevel = (
    DebugEventLevelFatal,
    DebugEventLevelWarning
  );
  TDebugEventLevel = DebugEventLevel;
  DebugEventProc = procedure(level: DebugEventLevel; message: PChar); stdcall;
  GdiplusStartupInput = packed record
    GdiplusVersion: Cardinal;
    DebugEventCallback: DebugEventProc;
    SuppressBackgroundThread: BOOL;
    SuppressExternalCodecs: BOOL;
  end;                          
  TGdiplusStartupInput = GdiplusStartupInput;
  PGdiplusStartupInput = ^TGdiplusStartupInput;
  NotificationHookProc = function(out token: ULONG): Integer; stdcall;
  NotificationUnhookProc = procedure(token: ULONG); stdcall;
  GdiplusStartupOutput = packed record
    NotificationHook  : NotificationHookProc;
    NotificationUnhook: NotificationUnhookProc;
  end;
  TGdiplusStartupOutput = GdiplusStartupOutput;
  PGdiplusStartupOutput = ^TGdiplusStartupOutput;
function GdipCreateHBITMAPFromBitmap(bitmap: THandle; out hbmReturn: HBITMAP;
  background: Longword): Integer; stdcall; external 'gdiplus.dll';
function GdipCreateBitmapFromFile(filename: PWChar; out bitmap: THandle): Integer;
  stdcall; external 'gdiplus.dll';
function GdipCreateBitmapFromStreamICM(stream: ISTREAM;
  out bitmap: THandle): Integer; stdcall; external 'gdiplus.dll';
function GdipDisposeImage(image: THandle): Integer; stdcall;
  stdcall; external 'gdiplus.dll';
function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput;
  output: PGdiplusStartupOutput): Integer; stdcall; external 'gdiplus.dll';
procedure GdiplusShutdown(token: ULONG); stdcall; external 'gdiplus.dll';
procedure TFormCJ7.FormCreate(Sender: TObject);
var
  vGdip: THandle;
  vBitmap: HBITMAP;
  vOldBitmap: HBITMAP;
  vPoint1, vPoint2: TPoint;
  vSize: TSize;
  vBlendFunction: TBlendFunction;
  vDC: HDC;
  vBitmapInfo: TBitmapInfoHeader;
  vDIBSection: TDIBSection;
  vBuffer: PChar;
  vStream: IStream;
  vGlobal: THandle;
begin
  SetWindowLong(Handle, GWL_EXSTYLE,
    GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
   
  ///////Begin 从资源中载入 
  with TResourceStream.Create(HInstance, 'Png_Cj7', 'PNG') do try
    vGlobal := GlobalAlloc(GHND, Size);
    if vGlobal = 0 then Exit;
    vBuffer := GlobalLock(vGlobal);
    if not Assigned(vBuffer) then Exit;
    try
      Read(vBuffer^, Size);
    finally
      GlobalUnlock(vGdip);
    end;
    if CreateStreamOnHGlobal(vGlobal, False, vStream) <> S_OK then Exit;
    if GdipCreateBitmapFromStreamICM(vStream, vGdip) <> S_OK then Exit;
    GlobalFree(vGlobal);
  finally
    Free;
  end;
  ///////End 从资源中载入 
  if GdipCreateHBITMAPFromBitmap(vGdip, vBitmap, 0) <> S_OK then Exit;
 
  vBitmapInfo.biSize := SizeOf(vBitmapInfo);
  GetObject(vBitmap, SizeOf(vDIBSection), @vDIBSection);
  vPoint1 := Point(Left, Top);
  vPoint2 := Point(0, 0);
  vSize.cx := vDIBSection.dsBm.bmWidth;
  vSize.cy := vDIBSection.dsBm.bmHeight;
  vBlendFunction.BlendOp := AC_SRC_OVER;
  vBlendFunction.BlendFlags := 0;
  vBlendFunction.SourceConstantAlpha := $FF; // 透明度
  vBlendFunction.AlphaFormat := AC_SRC_ALPHA; //同上
  vDC := CreateCompatibleDC(Canvas.Handle);
  vOldBitmap := SelectObject(vDC, vBitmap);
  UpdateLayeredWindow(Handle, Canvas.Handle,
    @vPoint1, @vSize, vDC, @vPoint2, 0, @vBlendFunction, ULW_ALPHA);
  SelectObject(vDC, vOldBitmap);
  DeleteDC(vDC);
  DeleteObject(vBitmap);
  GdipDisposeImage(vGdip);
end;
procedure TFormCJ7.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, SC_MOVE or HTCLIENT, 0); // 拖动
end;
var
  vStartupInput: TGDIPlusStartupInput;
  vToken: ULONG;
initialization
  vStartupInput.DebugEventCallback := nil;
  vStartupInput.SuppressBackgroundThread := False;
  vStartupInput.SuppressExternalCodecs   := False;
  vStartupInput.GdiplusVersion := 1;
  GdiplusStartup(vToken, @vStartupInput, nil);
finalization
  GdiplusShutdown(vToken);
end.
想了解gdi+的资料可以参考：
http://msdn2.microsoft.com/en-us/library/ms533798.aspx

异形窗体

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Btn360Style1: TBtn360Style;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
  uses GDIPAPI, GDIPOBJ;
{$R *.dfm}
{$R '.SkinRes.RES'}
procedure TForm1.FormCreate(Sender: TObject);
var
  vGdip: THandle;
  vBitmap: HBITMAP;
  vOldBitmap: HBITMAP;
  vPoint1, vPoint2: TPoint;
  vSize: TSize;
  vBlendFunction: TBlendFunction;
  vDC: HDC;
  vBitmapInfo: TBitmapInfoHeader;
  vDIBSection: TDIBSection;
  vBuffer: PChar;
  vStream: IStream;
  vGlobal: HGLOBAL;
begin

   {SetWindowLong(Handle,GWL_EXSTYLE,
      getwindowlong(handle,GWL_EXSTYLE)
        and (not WS_EX_APPWINDOW)
        or WS_EX_TOOLWINDOW
        or WS_EX_LAYERED
        );


  //从资源中载入
  with TResourceStream.Create(HInstance, 'Module_briangle_png', 'skin') do try
    vGlobal := GlobalAlloc(GHND, Size);
    if vGlobal = 0 then Exit;
    vBuffer := GlobalLock(vGlobal);
    if not Assigned(vBuffer) then Exit;
    try
      Read(vBuffer^, Size);
    finally
      GlobalUnlock(vGdip);
    end;
    if   CreateStreamOnHGlobal(vGlobal, False, vStream) <> S_OK then
       Exit;
    if GdipCreateBitmapFromStreamICM(vStream,pointer( vGdip)) <> OK then Exit;
    GlobalFree(vGlobal);
  finally
    Free;
  end;




  if GdipCreateHBITMAPFromBitmap(pointer(vGdip), vBitmap, 0) <> OK then
    Exit;

  vBitmapInfo.biSize := SizeOf(vBitmapInfo);
  GetObject(vBitmap, SizeOf(vDIBSection), @vDIBSection);
  vPoint1 := Point(Left, Top);
  vPoint2 := Point(0, 0);
  vSize.cx := vDIBSection.dsBm.bmWidth;
  vSize.cy := vDIBSection.dsBm.bmHeight;
  vBlendFunction.BlendOp := AC_SRC_OVER;
  vBlendFunction.BlendFlags := 0;
  vBlendFunction.SourceConstantAlpha := $FF; // 透明度
  vBlendFunction.AlphaFormat := AC_SRC_ALPHA; //同上
  vDC := CreateCompatibleDC(Canvas.Handle);
  vOldBitmap := SelectObject(vDC, vBitmap);
  UpdateLayeredWindow(Handle, Canvas.Handle,
    @vPoint1, @vSize, vDC, @vPoint2, 0, @vBlendFunction, ULW_ALPHA);
  SelectObject(vDC, vOldBitmap);
  DeleteDC(vDC);
  DeleteObject(vBitmap);
  GdipDisposeImage(Pointer(vGdip));}
end;

end.

异形窗口 png

{*******************************************************}
{                                                       }
{       异形窗口                                        }
{                                                       }
{       2009.12.4 王  锐                                }
{                                                       }
{*******************************************************}


unit UnitYXForm;

interface
uses
  Windows, Forms, Classes, Graphics;

//从文件加载PNG
procedure YXForm_FromFile(AForm : TForm; AFileName : String);
//从资源加载PNG
procedure YXForm_FromResource(AForm : TForm; ResName : String; ResType : PWideChar; Instance : HINST = 0);
//从图像对象加载
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);

implementation

procedure YXForm_FromFile(AForm : TForm; AFileName : String);
var
  wic : TWICImage;
begin
  wic := TWICImage.Create;
  wic.LoadFromFile(AFileName);
  YXForm_FromGraphic(AForm, wic);
  wic.Free;
end;

procedure YXForm_FromResource(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);

  YXForm_FromGraphic(AForm, wic);
  wic.Free;
  r.Free;
end;

procedure YXForm_FromGraphic(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.