关于创建不规则窗口的问题，请一定帮忙。谢谢！我只有100分了~~~~~~~~~~~~~~!

Question

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. 不是我写的！！

Answer 1

例子我就没有，不过我可以告诉你我知道的方法：
一般来说是这样的,在windows的gdi编程中有一种东西叫区域，也可以理解为
形状吧，这一个形状可以conbine，也就是连接起来，而且这两个连接的区域
可以是不连接在一起的，比如：可以把一个正方形和一个圆形conbine起来。
然后通过api函数，可以把某一个window的可视区域设变这一个区域，就可以了，这一个api函数是setwindowsrgn

Answer 2

去下面地址看看，有很多控件可用
http://zqwin.myrice.com/delphivcl.htm

Answer 3

delphi的没有,但vb的有,用的都是API,一样的,看一下就明白了,关键是那个reface的过程,我这个程序的功能是用一组相似的图标实现的一个猫咪盯着鼠标的程序:
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Type POINTAPI
  X As Long
  Y As Long
End Type
Dim MousePoint As POINTAPI, MouseSize As POINTAPI
Private Sub Form_Load()
  ReFace (4)
  SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 2 Or 1
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
    SetCapture (hwnd)
    m.Tag = "1"
    MouseSize.X = X
    MouseSize.Y = Y
  Else
    PopupMenu m
  End If
End Sub
Private Sub ReFace(Index As Integer)
Dim hw As Long, hm As Long, iw As Long, ih As Long, lCol As Long, lNul As Long
Dim pPo As POINTAPI, pPi As POINTAPI, bDraw As Boolean
  Picture = LoadResPicture("I" & Index, 1)
  hw = CreateRectRgn(0, 0, 0, 0)
  lNul = Point(32, 32)
  For ih = 0 To Me.ScaleHeight - 1
    bDraw = False
    For iw = 0 To ScaleWidth - 1
      lCol = Point(iw, ih)
      If lCol = lNul Then
        If bDraw Then
          hm = CreateRectRgn(pPo.X, pPo.Y, pPi.X, pPi.Y)
          Call CombineRgn(hw, hw, hm, 2)
          DeleteObject (hm)
        End If
        bDraw = False
      Else
        pPi.X = iw
        pPi.Y = ih + 1
        If bDraw = False Then
          pPo.X = iw
          pPo.Y = ih
        End If
        bDraw = True
      End If
    Next
  Next
  Call SetWindowRgn(hwnd, hw, True)
  DeleteObject (hw)
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If m.Tag = "1" Then
    Call GetCursorPos(MousePoint)
    Left = Screen.TwipsPerPixelX * (MousePoint.X - MouseSize.X)
    Top = Screen.TwipsPerPixelY * (MousePoint.Y - MouseSize.Y)
  End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  m.Tag = ""
  ReleaseCapture
End SubPrivate Sub md_Click(Index As Integer)
  Call ExitWindowsEx(Index, 0)
End SubPrivate Sub mq_Click()
  End
End SubPrivate Sub Timer1_Timer()
Dim MousePoint As POINTAPI, stmp As String, itmp As Integer
Static OldPoint As POINTAPI, iRun As Integer
  Call GetCursorPos(MousePoint)
  If MousePoint.X = OldPoint.X And MousePoint.Y = OldPoint.Y Then
    iRun = iRun + 1
    Select Case iRun
    Case Is < 10
      Randomize
      If (Rnd(9) + 1) Mod iRun = 0 Then
        For itmp = 0 To 3
          ReFace (4 - itmp)
          DoEvents
        Next
        For itmp = 1 To 4
          DoEvents
          ReFace (itmp)
        Next
        ReFace (Tag)
      End If
    Case 10 To 20
      itmp = 4
    Case 21 To 25
      itmp = 3
    Case 26 To 30
      itmp = 2
    Case 31 To 35
      itmp = 1
    Case Is > 35
      itmp = 0
    End Select
  Else
    iRun = 0
  End If
  If iRun < 10 Then
    itmp = Screen.TwipsPerPixelY * MousePoint.Y
    Select Case Screen.TwipsPerPixelX * MousePoint.X
    Case Is < Left
      Select Case itmp
      Case Is < Top
        itmp = 7
      Case Is > Top + Height
        itmp = 5
      Case Else
        itmp = 6
      End Select
    Case Is > Left + Width
      Select Case itmp
      Case Is < Top
        itmp = 9
      Case Is > Top + Height
        itmp = 11
      Case Else
        itmp = 10
      End Select
    Case Else
      Select Case itmp
      Case Is < Top
        itmp = 8
      Case Is > Top + Height
        itmp = 12
      Case Else
        itmp = 13
      End Select
    End Select
  End If
  If Tag <> itmp Then
    ReFace (itmp)
    Tag = itmp
  End If
  OldPoint = MousePoint
End Sub