根据位图做出漂亮的不规则FORM

unit Unit1;  

interface  

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

type  
  TForm1 = class(TForm)  
    Image1: TImage;  
    Button1: TButton;  
    procedure FormCreate(Sender: TObject);  
    procedure Button1Click(Sender: TObject);  
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;  
      Shift: TShiftState; X, Y: Integer);  
  private  
    function CreateRegion(wMask: TBitmap; wColor: TColor;  
      hControl: THandle): HRGN;  
    { Private declarations }  
  public  
    { Public declarations }  
  end;  

var  
  Form1: TForm1;  

implementation  

{$R *.DFM}  

function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;  
var  
  dc, dc_c: HDC;  
  rgn: HRGN;  
  x, y: integer;  
  coord: TPoint;  
  line: boolean;  
  color: TColor;  
begin  
  dc := GetWindowDC(hControl);  
  dc_c := CreateCompatibleDC(dc);  
  SelectObject(dc_c, wMask.Handle);  
  BeginPath(dc);  
  for x:=0 to wMask.Width-1 do  
  begin  
    line := false;  
    for y:=0 to wMask.Height-1 do  
    begin  
      color := GetPixel(dc_c, x, y);  
      if not (color = wColor) then  
      begin  
        if not line then  
        begin  
          line := true;  
          coord.x := x;  
          coord.y := y;  
        end;  
      end;  
      if (color = wColor) or (y=wMask.Height-1) then  
      begin  
        if line then  
        begin  
          line := false;  
          MoveToEx(dc, coord.x, coord.y, nil);  
          LineTo(dc, coord.x, y);  
          LineTo(dc, coord.x + 1, y);  
          LineTo(dc, coord.x + 1, coord.y);  
          CloseFigure(dc);  
        end;  
      end;  
    end;  
  end;  
  EndPath(dc);  
  rgn := PathToRegion(dc);  
  ReleaseDC(hControl, dc);  
  Result := rgn;  
end;  

procedure TForm1.FormCreate(Sender: TObject);  
var  
  w1:TBitmap;  
  w2:TColor;  
  rgn: HRGN;  
begin  
  w1:=TBitmap.Create;  
  w1.Assign(image1.Picture.Bitmap);  
  w2:=w1.Canvas.Pixels[0,0];  
  rgn := CreateRegion(w1,w2,Handle);  
  if rgn<>0 then  
  begin  
     SetWindowRgn(Handle, rgn, true);  
  end;  
  w1.Free;  
end;  

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

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;  
  Shift: TShiftState; X, Y: Integer);  
begin  
  ReleaseCapture;  
  SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);  
end;  

end.