USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (ActiveX/Controles/DLL)

Título da Dica:  Form Aspectro Diferente
Postada em 13/3/2007 por Edinei      Clique aqui para enviar email para o autor  neisjb@hotmail.com
'Coloque o seguinte código no form:
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function BeginPath Lib "gdi32" _
        (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" _
        Alias "TextOutA" (ByVal hdc As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal _
        lpString As String, ByVal nCount As _
        Long) As Long
Private Declare Function EndPath Lib "gdi32" _
        (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib _
        "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" _
        (ByVal hRgn As Long, lpRect As RECT) _
        As Long
Private Declare Function CreateRectRgnIndirect _
        Lib "gdi32" (lpRect As RECT) 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 DeleteObject Lib "gdi32" _
        (ByVal hObject 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 ReleaseCapture Lib _
        "user32" () As Long
Private 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 Const RGN_AND As Long = 1
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const HTCAPTION As Long = 2


Private Sub Form_Load()
  Dim hRgn As Long
  Me.Font.Name = "Wingdings"
  Me.Font.Size = 200
  hRgn = GetTextRgn()
  SetWindowRgn hwnd, hRgn, 1
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift _
            As Integer, X As Single, Y As Single)
  ReleaseCapture
  SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, _
              ByVal 0&
End Sub



Private Function GetTextRgn() As Long
Dim hRgn1 As Long, hRgn2 As Long
  Dim rct As RECT
  BeginPath hdc
  TextOut hdc, 10, 10, Chr$(255), 1
  EndPath hdc
  hRgn1 = PathToRegion(hdc)
  GetRgnBox hRgn1, rct
  hRgn2 = CreateRectRgnIndirect(rct)
  CombineRgn hRgn2, hRgn2, hRgn1, GN_AND
  DeleteObject hRgn1
  GetTextRgn = hRgn2
End Function

 


CyberWEB Network Ltda.    © Copyright 2000-2021   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página