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

Tyagus

[VB6] Lista de API's

3 mensagens neste tópico

Aqui vai uma lista de API's

Este código pode ser muito útil em diversas situações.


'**************************************

'P: Como e que eu posso mudar o tempo de DoubleClick no rato?

'R: O tempo de DoubleClick e o tempo que existe entre dois clicks CONSECUTIVOS
'   do rato que vao provocar o evento DoubleClick.
'   Pode mudar-se o tempo da aplicacao de VB chamando a API SetDoubleClickTime.
'   So tem um parametro. E o novo tempo de DoubleClick vem em milisegundos.

'##########################################
'##                  NOTA                ##
'##--------------------------------------##
'##                                      ##
'## Estas mudancas afetam o sistema todo ##
'##                                      ##
'##########################################

Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long) As Long
    
'##############################################################
'##############################################################

'P: Como e que eu posso esconder o cursor?

'R: A API Showcursor, permite o controlo da visibilidade do cursor.

'############################################
'##                  NOTA                  ##
'##----------------------------------------##
'##                                        ##
'## O parametro bShow esta True (diferente ##
'## de zero) para mostrar o cursor, Falso  ##
'## para o esconder                        ##
'##                                        ##
'############################################

Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long)
    
'##############################################################
'##############################################################

'P: Como e que eu posso trocar os botoes do rato?

'R: A API SwapMouseButton, permite controlar as funcoes dos botoes
'   direito e esquerdo do rato.

Declare Function SwapMouseButton& Lib "user32" (ByVal bSwap As Long)
    
'##############################################################
'##############################################################

'P: Como e que eu posso mover o cursor do rato?

'R: A API SetCursorPosition&, aceita dois parametros.
'   O valor das posicoes de X e de Y em pixel.

Declare Function SetCursorPosition& Lib "user32" _
    (ByVal X As Long, ByVal Y As Long)
    
'##############################################################
'##############################################################

'P: Como e que eu posso saber quanto espaco do disco esta ocupado?

'R: A API GetDiskFreeSpace, permite o controlo da visibilidade do cursor.

Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
    "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
    lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
    lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters _
    As Long) As Long
    
'############################################
'##               EXEMPLO                  ##
'##----------------------------------------##
'##                                        ##
'## O Long FreeBytes contem o numero de    ##
'## bytes livres na drive                  ##
'##                                        ##
'############################################

    Dim SectorsPerCluster&
    Dim BytesPerSector&
    Dim NumberOfFreeClusters&
    Dim TotalNumberOfClusters&
    Dim FreeBytes&
    dummy& = GetDiskFreeSpace("c:\", SectorsPerCluster, _
    BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters)
    FreeBytes = NumberOfFreeClusters * SectorsPerCluster * _
    BytesPerSector
    
'##############################################################
'##############################################################

'P: Mudar a resolucao do ecra?

'R: Um "grande problema" para os programadores de VB e como mudar a resolucao do
'   ecra, isto porque no visualizador de API's as variaveis EnumDisplaySettings e
'   ChangeDisplaySettings nao estao la!
'
'   1. Criar um Modulo com:
'
Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
    (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
    lpDevMode As Any) As Boolean

Declare Function ChangeDisplaySettings Lib "user32" _
    Alias "ChangeDisplaySettingsA" _
    (lpDevMode As Any, ByVal dwFlags As Long) As Long

Declare Function ExitWindowsEx Lib "user32" _
    (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    
    Public Const EWX_LOGOFF = 0
    Public Const EWX_SHUTDOWN = 1
    Public Const EWX_REBOOT = 2
    Public Const EWX_FORCE = 4
    Public Const CCDEVICENAME = 32
    Public Const CCFORMNAME = 32
    Public Const DM_BITSPERPEL = &H40000
    Public Const DM_PELSWIDTH = &H80000
    Public Const DM_PELSHEIGHT = &H100000
    Public Const CDS_UPDATEREGISTRY = &H1
    Public Const CDS_TEST = &H4
    Public Const DISP_CHANGE_SUCCESSFUL = 0
    Public Const DISP_CHANGE_RESTART = 1
    
    Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    End Type

'############################################
'##               EXEMPLO                  ##
'##----------------------------------------##
'##                                        ##
'## Mudar a resolucao para 640x480 com a   ##
'## Colordepth actual                      ##
'##                                        ##
'############################################

    Dim DevM As DEVMODE
    'Sacar a info para DevM
    erg& = EnumDisplaySettings(0&, 0&, DevM)
    'Nao mudamos a colordepth, porque vai ser necessario
    'fazer um Rebot
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL
    DevM.dmPelsWidth = 640 'ScreenWidth
    DevM.dmPelsHeight = 480 'ScreenHeight
    'DevM.dmBitsPerPel = 32 (podia ser 8, 16, 32 ou mesmo 4)
    'Agora muda a vista e verifica a pos
    '     sibleerg& = ChangeDisplaySettings(DevM,
    '     CDS_TEST)
    Case DISP_CHANGE_RESTART
    an = MsgBox("Tem de reeniciar", vbYesNo + vbSystemModal, "Info")


    If an = vbYes Then
        erg& = ExitWindowsEx(EWX_REBOOT, 0&)
    End If

    Case DISP_CHANGE_SUCCESSFUL
    erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
    MsgBox "Correu tudo bem", vbOKOnly + vbSystemModal, "Funcionou!!!"
    Case Else
    MsgBox "Modo nao suportado", vbOKOnly + vbSystemModal, "Erro!!!"
    End Select
    End Sub
    
'##############################################################
'##############################################################

'P: Como mostrar o item sobre o qual o rato esta numa List Box?

'R: A API SendMessage e a solucao.

'############################################
'##               EXEMPLO                  ##
'##----------------------------------------##
'##  Correr o prog e passem com o cursor   ##
'##  por cima de diferentes itens na List  ##
'##  Box e eles iram aparecer numa ToolTip ##
'##  e na Text Box                         ##
'##                                        ##
'############################################

'   1. Criar um novo projecto:
'   Adicionar uma List Box e uma Text Box na Form1
'

Option Explicit


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 LB_ITEMFROMPOINT = &H1A9

Private Sub Form_Load()


    With List1
        .AddItem "Visitem"
        .AddItem "http://www.princeofdarkness666.com/forum"
    End With

End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As _
    Single, Y As Single)
    Dim lXPoint As Long
    Dim lYPoint As Long
    Dim lIndex As Long

    If Button = 0 Then ' caso a escolha seja No
        lXPoint = CLng(X / Screen.TwipsPerPixelX)
        lYPoint = CLng(Y / Screen.TwipsPerPixelY)


        With List1
            ' Sacar o item seleccionado da lista
            lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal _
            ((lYPoint * 65536) + lXPoint))
            ' mostrar dica ou apagar o ultimo
            If (lIndex >= 0) And (lIndex <= .ListCount) Then
            .ToolTipText = .List(lIndex)
            Text1.Text = .List(lIndex)
        Else
            .ToolTipText = ""
        End If

    End With

End If

End Sub
    
'##############################################################
'##############################################################

'P: Como e que eu posso saber a memória ocupada?

'R: A API GlobalMemoryStatus, facilita muito essa tarefa.

'####################################
'##               NOTA             ##
'##--------------------------------##
'##                                ##
'## Inserir este codigo num modulo ##
'##                                ##
'####################################


Public Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
    End Type
    
    Public Declare Sub GlobalMemoryStatus _
    Lib "kernel32" (lpBuffer As MEMORYSTATUS)
    
    ' Agora e so adicionar este codigo para sacar os valores:
    
    Dim MS As MEMORYSTATUS
    MS.dwLength = Len(MS)
    GlobalMemoryStatus MS
    
    ' MS.dwMemoryLoad - contem a percentagem de memoria usada
    
    ' MS.dwTotalPhys - contem a quantidade total de memoria fisica em bytes
    
    ' MS.dwAvailPhys - contem a memoria fisica disponivel
    
    ' MS.dwTotalPageFile - contem a quantidade total de memoria no page file
    
    ' MS.dwAvailPageFile - contem a quantidade total de memoria disponivel no
    '                      page file
    
    ' MS.dwTotalVirtual - contem a quantidade total de memoria virtual
    
    ' MS.dwAvailVirtual - contem a quantidade total de memoria virtual disponivel

'**************************************

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

O ultimo não tem haver com espaço no disco mas sim com memória (RAM, Page File, etc)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

O ultimo não tem haver com espaço no disco mas sim com memória (RAM, Page File, etc)

Corrigido!

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