api

Ventana Reiniciar Sistema

Para probar, incluye el siguiente código en un proyecto nuevo.

Private Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" (ByVal hOwner As Long, _
                    ByVal sPrompt As String, ByVal uFlags As Long) As Long
Private Sub Form_Load()
    Dim AddTexto As String
    AddText = "": 'If WinNT Then AddText = StrConv(AddText, vbUnicode)
    ExitType = 1  'Texto=Salir
    ExitType = 2  'Texto=Reiniciar
    If SHRestartSystemMB(hWnd, AddTexto, ExitType) = vbYes Then MsgBox "Adios"
End Sub

Anuncios

Ventana de selección de Icono

Para probar, incluye el siguiente código en un proyecto nuevo.

Private Declare Function SHChangeIconDialog Lib "shell32" Alias "#62" (ByVal hOwner As Long, _
        ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long
Private Sub Form_Load()
    Dim Fichero As String, Valor As Long

    Fichero = InputBox("Teclea un nombre de fichero para obtener sus iconos")
    Valor = 0
    If SHChangeIconDialog(hWnd, Fichero, 0, Valor) Then MsgBox "Elegido: " & Valor
End Sub

Duplicar el tamaño de un TextBox

Incluye en un formulario 3 botones (no cambies el nombre) y un TextBox y copia el siguiente código…

'--------------------------------------------------------------------
'Usando SendMessage del Api de Windows, poder tener text-box con 64 KB
'en lugar de los 32 que admite Visual Basic.
'--------------------------------------------------------------------
'Declaración de la función API
'Para 16 bits usar:
Declare Function sendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, _
                    ByVal wParam As Integer, lParam As Any) As Long


'Para 32 bits usar:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
            ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

'Declaración de las constantes
Global Const WM_USER = &H400
Global Const EM_LIMITTEXT = WM_USER + 21

'En el Form_Load:
Dim LTmp as long
LTmp=SendMessage(Text1.hWnd,EM_LIMITTEXT,0,byval 0&)

Mover un Form sin caption

Listado a insertar en un módulo (.bas)

'Constantes para SendMessage
Global Const WM_LBUTTONUP = &H202
Global Const WM_SYSCOMMAND = &H112
Global Const SC_MOVE = &HF010
Global Const MOUSE_MOVE = &HF012

#If Win32 Then
    Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
                        ByVal wParam As Long, lParam As Long) As Long
#Else
    Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, _
                        ByVal wParam As Integer, lParam As Any) As Long
#End If

Listado a insertar en el formulario (.frm)

'
'Este código se pondrá en el Control_MouseDown...
'
Dim lngRet As Long

'Simular que se mueve la ventana, pulsando en el Control
If Button = 1 Then
    'Envía un MouseUp al Control
    lngRet = SendMessage(Control.hWnd, WM_LBUTTONUP, 0, 0)
    'Envía la orden de mover el form
    lngRet = SendMessage(FormX.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0)
End If

Conocer el nombre de la ventana activa actual

Con esta función puedes obtener el nombre de la ventana que tiene el foco actualmente.

Este ejemplo para un uso más apropiado deberías crear un Timer y mostrar el valor cada segundo (por ejemplo).

Tienes que crear un CommandButton llamado ‘Command1’:

Option Explicit
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _
             ByVal lpString As String, ByVal cch As Long) As Long
Private Sub Form_Click()
    Dim LongitudNomVentana As Long, NomVentana As String, Manejador As String
    NomVentana = Space$(255)
    Manejador = GetActiveWindow()
    LongitudNomVentana = GetWindowText(GetActiveWindow(), NomVentana, 255)
    MsgBox Left(NomVentana, LongitudNomVentana)
End Sub

Conocer si nuestro programa tiene el foco del sistema.

En muchas ocasiones tenemos aparte de nuestra aplicación otras aplicaciones abiertas (Excel, Word, etc), si deseamos saber si la nuestra está activa deberemos chequear el estado de la función.

La declaración del API.

Declare Function GetActiveWindow Lib "user32" () As Long

Código a colocar en una función, rutina o Timer donde chequear este estado.

If GetActiveWindow() = 0 Then
    MsgBox("Nuestra aplicación no tiene el Foco")
Else
    Msgbox("Nuestra aplicación tiene el Foco")
End If

Crear un formulario con forma Elíptica.

Este ejemplo crea un formulario de forma Elíptica, pero cambiando la función CreateEllipticRgn por cualquier otra que pueda devolver un Rango, la puedes hacer de múltiples formas.

Copia este código en un formulario, ejecuta y pulsa sobre el formulario.

Option Explicit
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
                ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _
                 ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Sub Form_Click()
    Dim Xs As Long, Ys As Long
    Xs = Me.Width / Screen.TwipsPerPixelX
    Ys = Me.Height / Screen.TwipsPerPixelY
    SetWindowRgn hWnd, CreateEllipticRgn(0, 0, Xs, Ys), True
End Sub

Conocer el nombre del usuario (leyendo el registro de Windows).

Windows almacena el nombre del usuario grabado en el registro del sistema.

Un ejemplo para obtener dicho nombre:

'nivel al cual se quiere acceder en el registro
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1
'función api para obtener el valor de una llave
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, _
                         ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, _
                         lpcbData As Long) As Long
'abrir una llave para su uso
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, _
                         ByVal lpSubKey As String, phkResult As Long) As Long
'cerrar una llave
Private Declare Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKeyA" (ByVal hKey As Long) As Long

Public Function UsuarioRegistrado() As String
    Dim hLlave As Long
    Dim strLlave As String
    Dim lngSize As Long
    Dim lngType As Long
    Dim x As Long
    
    If RegOpenKey(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersion", hLlave) Then Exit Function
    strLlave = Space$(255)
    lngSize = Len(strLlave)
    x = RegQueryValueEx(hLlave, "RegisteredOwner", 0, lngType, ByVal strLlave, lngSize)
    If x = 0 Then
    If lngType = REG_SZ And lngSize <= Len(strLlave) Then
        UsuarioRegistrado = Left$(strLlave, lngSize)
    End If
    End If
    RegCloseKey hLlave
End Function

Cambiar Fondo Escritorio Windows.

Cambia el fondo del escritorio por el fichero indicado.

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, _
             ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETDESKWALLPAPER = 20

Private Sub Form_Load()
    Dim Res As Long
    Res = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "C:WindowsMiFondo.bmp", 0)
End Sub

El código de ejemplo para cambiar el fondo del escritorio de Windows.

api34

El proyecto es muy extenso… así que no pongo el código, bajaros el ejemplo directamente.

http://descarga.e-mision.net/API34.Zip