由图片和透明颜色形成异形窗口

function GraphicToRGN ( mGraphic : TGraphic ; mTransColor : TColor ): HRGN ;

var

  I , J : Integer ;

  vStart : Integer ;

  vHandle : HRGN ;

begin

  Result := 0 ;

  if not Assigned ( mGraphic ) then Exit ;

  Result := CreateRectRgn ( 0 , 0 , 0 , 0 );

  with TBitmap . Create do

  try

    Width := mGraphic . Width ;

    Height := mGraphic . Height ;

    Canvas . Draw ( 0 , 0 , mGraphic );

    for I := 0 to Height - 1 do

    begin

      vStart := 0 ;

      for J := 0 to Width do

      begin

        if ( Canvas . Pixels [ J , I ] <> mTransColor ) and ( J < Width ) then

          if vStart < 0 then

            vStart := J

          else

        else if vStart >= 0 then

        begin

          vHandle := CreateRectRgn ( vStart , I , J , I + 1 );

          try

            CombineRgn ( Result , Result , vHandle , RGN_OR );

          finally

            DeleteObject ( vHandle );

          end ;

          vStart := - 1 ;

        end ;

      end ;

    end ;

  finally

    Free ;

  end ;

end ; { GraphicToRGN }

function ColorFormCursorPoint : TColor ;

var

  dc : HDC ;

begin

  dc := GetDC ( 0 );

  Result := GetPixel ( dc , Mouse . CursorPos . X , Mouse . CursorPos . Y );

  DeleteDC ( dc );

end ;

procedure TForm1 . Button1Click ( Sender : TObject );

var

  vRGN : HRGN ;

  c : TColor ;

begin

  c := ColorFormCursorPoint ;

  BorderStyle := bsNone ;

  Image1 . Left := 0 ;

  Image1 . Top := 0 ;

  vRGN := GraphicToRGN ( Image1 . Picture . Graphic , c );

  try

    SetWindowRgn ( Handle , vRGN , True );

  finally

    DeleteObject ( vRGN );

  end ;

end ;