• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

programadorvb6

[VB6] Sombras em Janelas

5 mensagens neste tópico

Boa Noite!

Venho por este meio ( embora ainda se ouça alguns ecos no fundo do poço....) disponibilizar um exemplo de sombras em janelas +- parecidas ao Win Vista.

Cumps.

Programadorvb6

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá + 1 Vez

Venho então disponibilizar o Código.

No Form ponham isto.

Nota : caso tenham o S.O. Vista , não aparecerá a sombra ,pois as jánelas já têm a sombra incorporada

'-------------------------------------------------------------------------------------------
' Empresa     : VSoft, Lda.
' Formulário  : Form1
' Data / Hora : 29-04-2009 15:19
' Autor       : ProgramadorVB6
' Descrição   : Sombras em formulários estilo vista;
' Foram efectuados comentários adicionais feitos por mim, para que seja de rápida compreenção.
'---------------------------------------------------------------------------------------------
Option Explicit 'Define que tudo seja declarado, para reduzir o minimo de erros em um formulário.
'============================================================
'Apis para ver qual o windows instalado na máquina
'============================================================
'Opcional este código , eu uso para que o sistema reconheça
'qual o S.O. instalado na máquina , a fim de decidir se efectua
'o efeito sombra em um formulário; derivado ao Vista e outros
'Sistemas superiores, já dispôrem deste efeito.
'=============================================================
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'///////////////////////////////////////////////////////////////////////////////
'
'================== Apis para fazer o efeito de sombra =========================
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const CS_DROPSHADOW As Long = &H20000
Private Const GCL_STYLE     As Long = -26
'
'
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'///////////////////////////////////////////////////////////////////////////////

'========================================================================================================
'Capta o hwnd de cada formulário, para que se possa idêntificar em quais se deve aplicar o efeito sombra
'========================================================================================================
Private Sub ApplyDropShadow(ByVal hWnd As Long)
    Call SetClassLong(hWnd, GCL_STYLE, GetClassLong(hWnd, GCL_STYLE) Or CS_DROPSHADOW)
End Sub
'
'=================================================================================
Private Sub Form_Load()
    '------------------------------------------------------------
    '----- Define variaveis para saber qual o S.O. corrente -----
    '------------------------------------------------------------
    Dim SOInfo As OSVERSIONINFO
    Dim VersaoWin As Long
    SOInfo.dwOSVersionInfoSize = 148
    GetVersionEx SOInfo
    VersaoWin = GetVersion() ' obtém o nº da versão
    '-------------------------------------------------------------------
    '===========================================================
    ' Evita que o seu formulário seja carregado + do que uma vez.
    '===========================================================
    If App.PrevInstance Then
        End
    End If
    '===========================================================
    If VersaoWin & &H8000000 Then ' força com que seja efectuada a verificação a quando do carregamento do formulário.
    If SOInfo.dwMajorVersion = 5 Then ' caso seja esta; será efectuada as funçõs contidas no ciclo para XP
    'Chama a rotina para efectuar o efeito sombra ao formulário.
    Call ApplyDropShadow(Me.hWnd)
End If
If SOInfo.dwMajorVersion > 5 Then 'Caso seja esta, será efectuada as funções contidas no ciclo para versões superiores, (neste caso : Vista; Seven etc..)
'==== Sem função a efectuar;  derivado ás versões superiores a 5 ,já disporem de sombras em seus formulários.
End If
End If
End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora