Form - Com Figura

[Guest Airton]

Boa Noite Pessoal, venho aki pedir uma ajudinha, tenho um sistema e estou querendo um codigo que deixe o formulario com o formato da figura que eu colocar nele, já vi este codigo antes, porem agora não consigo encontra-lo, c alguém puder me ajudar ficarei gato !!!

Valewwwww

[William Rodrigues]

Salve...

Seja bem vindo ao fórum!

Em um módulo coloque:

Public Declare Function SetWindowRgn Lib "user32" _
       (ByVal hwnd As Long, ByVal hRgn As Long, _
       ByVal bRedraw As Boolean) As Long
Public Declare Function DeleteObject Lib "gdi32" _
       (ByVal hObject As Long) As Long
Public Declare Function ReleaseCapture Lib _
       "user32" () As Long
Public Declare Function SendMessage Lib "user32" _
       Alias "SendMessageA" (ByVal hwnd As Long, _
       ByVal wMsg As Long, ByVal wParam As Long, _
       lParam As Any) As Long
Private Declare Function CreateCompatibleDC Lib _
       "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib _
       "gdi32" (ByVal hdc As Long, ByVal hObject _
       As Long) As Long
Private Declare Function GetObject Lib "gdi32" _
       Alias "GetObjectA" (ByVal hObject As _
       Long, ByVal nCount As Long, lpObject As _
       Any) 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 DeleteDC Lib "gdi32" _
       (ByVal hdc As Long) As Long
Private Declare Function GetPixel Lib "gdi32" _
       (ByVal hdc As Long, ByVal X As Long, _
       ByVal Y As Long) As Long

Public Const WM_NCLBUTTONDOWN As Long = &HA1
Public Const HTCAPTION As Long = 2

Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Public Function GetBitmapRegion(cPicture As _
       StdPicture, cTransparent As Long)
  Dim hRgn As Long, tRgn As Long
  Dim X As Integer, Y As Integer, X0 As Integer
  Dim hdc As Long, BM As BITMAP
  'Cria um novo DC, então procuramos a imagem
  hdc = CreateCompatibleDC(0)
  If hdc Then
    'Coloca o novo DC na Imagem
    SelectObject hdc, cPicture
    'Pega as dimensões e cria uma nova região
    'de retangulo
    GetObject cPicture, Len(BM), BM
    hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM._
           bmHeight)
    'Inicia procurando a imagem de cima para
    'baixo
    For Y = 0 To BM.bmHeight
      For X = 0 To BM.bmWidth
        'Procura uma linha de píxeis não
        'transparentes
        While X <= BM.bmWidth And GetPixel(hdc, _
              X, Y) <> cTransparent
          X = X + 1
        Wend
        'Marca o Início da linha de píxeis não
        'transparentes
        X0 = X
        'Procura uma linha com Píxeis
        'transparentes
        While X <= BM.bmWidth And GetPixel(hdc, _
              X, Y) = cTransparent
          X = X + 1
        Wend
        'Cria uma nova região que corresponda à
        'linha dos píxeis transparentes e então
        'remove ele da região principal
        If X0 < X Then
          tRgn = CreateRectRgn(X0, Y, X, Y + 1)
          CombineRgn hRgn, hRgn, tRgn, 4
          'Libera a memória usada para a nova
          'região temporária
          DeleteObject tRgn
        End If
      Next X
    Next Y
    'Volta ao endereço de memória da imagem pronta
    GetBitmapRegion = hRgn
    'Libera memória apagando a imagem
    DeleteObject SelectObject(hdc, cPicture)
  End If
  'Libera memória apagando o DC criado
  DeleteDC hdc
End Function

Agora, coloque a imagem no Picture do Form e adicione esse código no Form_Load:

Private Sub Form_Load()
  Dim hRgn As Long
  If hRgn Then DeleteObject hRgn
  hRgn = GetBitmapRegion(Me.Picture, vbBlack)
  SetWindowRgn Me.hwnd, hRgn, True
End Sub

Abraços,

William Rodrigues