Codigos Fuente

|


Preguntar

|


Comunicaciones

|


Tutoriales

|


Contactenos

 


  Buscador del Site  

 

 Se Recomienda Resolución de 800x600 pixels


 

11.- Cómo usar el marcador telefónico de Windows 95  

Aquí lo que se muestra es sólo la forma de usarlo.

Private Declare Function tapiRequestMakeCall& Lib "TAPI32.DLL" (ByVal DestAddress&, ByVal AppName$, ByVal CalledParty$, ByVal Comment$)

Private Sub Command1_Click() 

    Dim ValDev&, Numero$, NombreProg$, Quien$

    Numero = "123-4567"

    NombreProg = "Mi Programa"

    Quien = "Pepe"

    ValDev = tapiRequestMakeCall(Numero, NombreProg,Quien,"")

End Sub

12.- Sleep parece que no sirve para sustituir a DoEvents

He probado a usar Sleep en lugar de DoEvents, según se explica en el truco 7, y no funciona.
Al menos como yo espero que lo haga. Es decir, sustituir DoEvents por Sleep 0& no hace que el proceso continue, al menos en la misma aplicación.
He intentado hacer una prueba, para comprobar la función GetTickCount, y no salía del bucle; incluso cambiando Sleep 0& por Sleep 1&. ¿Alguien sabe por qué?

13.- Usar GetTickCount() en lugar de Timer

Esta función si la he probado. El efecto es similar a usar Timer, para saber los segundos transcurridos desde la medianoche. La diferencia principal, es que Timer devuelve un valor en segundos y GetTickCount() lo devuelve en milésimas de segundos. Por tanto para algunos cálculos, es más precisa la función del API.
Como nota adicional, decir que en el API de 16 bits, GetTickCount() es igual que GetCurrentTime()

'La declaración de esta función para 16 y 32 bits:

#If Win32 Then

    Declare Function GetTickCount Lib "kernel32" () As Long

#Else

    Declare Function GetTickCount Lib "User" () As Long

#End If

Por ejemplo, podemos usarla para saber la diferencia en el tiempo de ejecución de una serie de instrucciones, un bucle, etc.

Dim T1 As Long

Dim T2 As Long

Dim L As Long

 

T1 = GetTickCount()

For L = 1 to 320000

    DoEvents

Next

T2 = GetTickCount()

Print "Duración: "; T2 - T1 ; " milisegundos."

14.- Ejemplo de GetTickCount()

He hecho este ejemplo, para ver si había más exactitud en la función del API que en con el TimerControl. Para usarlo, hay que crear un Form con el siguiente codigo y sus respectivos controles:

 'Prueba de Timer,              

Option Explicit

 

'Declaración del API

#If Win32 Then

    Private Declare Function GetTickCount Lib "Kernel32" () As Long

#Else

    Private Declare Function GetTickCount Lib "User" () As Long

#End If

 

 

'Para saber que acción debe tomar el botón

Dim Contando As Boolean

'Variables para el GetTickCount

Dim g1 As Long

Dim g2 As Long

Dim g3 As Long

'Variables para el Timer1

Dim t1 As Long

Dim t2 As Long

'valor para el timer

Dim vTimer As Long

'Flag para cancelar el bucle

Dim Cancelar As Boolean

'valor máximo de items a mostrar

Dim MaxBucle As Long

 

Private Sub cmdIniciar_Click()

    Contar

End Sub

 

Private Sub cmdSalir_Click()

    Cancelar = True

    DoEvents

    Contando = True

    Contar

    Unload Me

End Sub

 

Private Sub Form_Load()

    '

    Timer1.Interval = 1000

    Timer1.Enabled = False

    Text1 = "1000"

    MaxBucle = 20000

End Sub

 

Private Sub Text1_Change()

    '

    Dim vTmp

    Static YaEstoy As Boolean

   

    'No entrar mientras se procesa...

    If YaEstoy Then Exit Sub

   

    YaEstoy = True

   

    vTmp = Val(Text1) \ 10

    If vTmp > VScroll1.Min Then

        vTmp = VScroll1.Min

    End If

    If vTmp < VScroll1.Max Then

        vTmp = VScroll1.Max

    End If

    Text1 = CStr(vTmp * 10)

    VScroll1.Value = vTmp

   

    YaEstoy = False

   

End Sub

 

Private Sub Timer1_Timer()

    'número de segundos transcurridos

    t2 = Timer - t1

    Mostrar

    DoEvents

End Sub

 

Private Sub VScroll1_Change()

    Static YaEstoy As Boolean

    Dim vTmp As Variant

   

    If YaEstoy Then Exit Sub

   

    YaEstoy = True

    vTmp = VScroll1.Value * 10

    Text1 = CStr(vTmp)

   

    YaEstoy = False

End Sub

 

Private Sub Contar()

    'Si ya está contando, dejar de contar...

    If Contando Then

        Cancelar = True

        DoEvents

        Timer1.Enabled = False

        cmdIniciar.Caption = "Iniciar"

        Contando = False

        Text1.Enabled = True

    Else

    'Empezar la cuenta...

        Label2(0) = ""

        Label2(1) = ""

        cmdIniciar.Caption = "Detener"

        Cancelar = False

        Contando = True

        Text1.Enabled = False

        DoEvents

        t1 = Timer

        Timer1.Enabled = True

        Timer1.Interval = Val(Text1)

        OtraCosa

    End If

End Sub

 

Private Sub OtraCosa()

    'Este procedimiento es para hacer algo...

    'aunque no valga para nada

    Dim i As Long

   

    List1.Clear

    'Inicializar el temporizador "manual"

    g1 = GetTickCount()

    g3 = 0

    Do

        i = i + 1

        List1.AddItem CStr(i)

        List1.ListIndex = List1.ListCount - 1

        gTimer

        If Cancelar Then Exit Do

        If i = MaxBucle Then

            Exit Do

        End If

    Loop

    'Detener la acción...

    Contando = True

    Contar

    'Actualizar los resultados

    Mostrar

End Sub

 

Private Sub gTimer()

    g2 = GetTickCount() - g1

    'Este if, es para que se muestre cada segundo

    If g2 > (g3 + 1) * 1000 Then

        g3 = g3 + 1

        Mostrar

    End If

    DoEvents

End Sub

 

Private Sub Mostrar()

    Label2(0) = t2

    Label2(1) = g3

End Sub

15.- Leer la etiqueta y el número de serie de un disco. (Sólo 32 bits)

La función que se usa para esto, es GetVolumeInformation, que está en el punto 4, pero lo que ahora pongo, es un ejemplo de cómo usarla.
El ejemplo es un form con una caja de texto en la que se introduce la unidad (directorio raíz, realmente), de la que queremos mostrar la información.
Como no es un listado muy grande, lo pongo al completo.

---------------------------------------------------------------------------

'Form de prueba para leer la etiqueta y el número de serie de un disco.

---------------------------------------------------------------------------

Option Explicit

 

'Declaración de la función, sólo está en el API de 32 bits

'

Private Declare Function GetVolumeInformation Lib "Kernel32" _

    Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _

                                    ByVal lpVolumeNameBuffer As String, _

                                    ByVal nVolumeNameSize As Long, _

                                    lpVolumeSerialNumber As Long, _

                                    lpMaximumComponentLength As Long, _

                                    lpFileSystemFlags As Long, _

                                    ByVal lpFileSystemNameBuffer As String, _

                                    ByVal nFileSystemNameSize As Long) As Long

  

Private Sub Command1_Click()

    'Acción

    Dim lVSN As Long, n As Long, s1 As String, s2 As String

    Dim unidad As String

    Dim sTmp As String

   

    On Local Error Resume Next

   

    'Se debe especificar el directorio raiz

    unidad = Trim$(Text1)

   

    'Reservar espacio para las cadenas que se pasarán al API

    s1 = String$(255, Chr$(0))

    s2 = String$(255, Chr$(0))

    n = GetVolumeInformation(unidad, s1, Len(s1), lVSN, 0, 0, s2, Len(s2))

    's1 será la etiqueta del volumen

    'lVSN tendrá el valor del Volume Serial Number (número de serie del volumen)

    's2 el tipo de archivos: FAT, etc.

 

    'Convertirlo a hexadecimal para mostrarlo como en el Dir.

    sTmp = Hex$(lVSN)

   

    Label3(0) = s1

    Label3(1) = Left$(sTmp, 4) & "-" & Right$(sTmp, 4)

    Label3(2) = s2

End Sub

  

Private Sub Command2_Click()

    Unload Me

    End

End Sub

 Private Sub Form_Unload(Cancel As Integer)

    'Asegurarnos de "liberar" la memoria.

    Set Form1 = Nothing

End Sub

  16.- La línea actual y el número de líneas de un text-box

Otras cosas más que se pueden hacer con SendMessage.


Const WM_USER = 1024

Const EM_GETLINECOUNT = WM_USER + 10

Const EM_LINEFROMCHAR = WM_USER + 25

TotalLineas = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)

LineaActual = SendMessage(Text1.hWnd, EM_LINEFROMCHAR, -1, 0&) + 1

17.- Uso de PostMessage en lugar de SendMessage

En la lista de distribución VB-ES, leí una respuesta sobre que es preferible, en 32 bits, usar PostMessage en lugar de SendMessage.
Quiero aclarar que el valor devuelto por la función PostMessage, es si ha podido poner el mensaje en la cola o no.
Por tanto, si usas SendMessage para recibir un valor, el ejemplo anterior es un caso, no se te ocurra cambiarla por PostMessage.
En los demás casos, en los que simplemente queremos enviar un mensaje a la cola de Windows y no necesitamos esperar a que la operación termine, si podemos usar PostMessage, ya que esta función trabaja de forma "asíncrona" y devolverá el control a VB antes que SendMessage, que trabaja de forma "síncrona" y hasta que no acabe "su tarea" no vuelve a casa.

La declaración de PostMessage para el API de 16 y 32 bits:

'Declaración del API de 32 bits

Declare Function PostMessage Lib "User32" Alias "PostMessageA" _

                                (ByVal hwnd As Long, ByVal wMsg As Long, _

                                 ByVal wParam As Long, ByVal lParam As Long) As Long

 

'Declaración del API de 16 bits

Declare Function PostMessage Lib "User" _

                                (ByVal hWnd As Integer, ByVal wMsg As Integer, _

                         ByVal wParam As Integer, lParam As Any) As Integer

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


©1998-2001 FMC Webs® Todos los derechos Reservados. Ferraro Mauro - San Nicolás - Argentina

El Codigo del Mes

Aqui le mostraremos el Codigo Fuente del Mes, Votalo Ya!!!

Preguntar

Dudas

Trucos

API de windows

Tutoriales

Trucos

Api de Windows

Bajate el manual de VB

Contactenos

Enviar Codigos Fuente

Links y Banners

Publicite en nuestro Site

Pone Tu link Gratis!!!

Crea tu Web

Redirecciona tu Pagina Gratis!!!

Votanos en La web del Programador

Sugerencias