|
|
|
|
|
|
| |
| |
| |
| |
|
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. 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. '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. --------------------------------------------------------------------------- '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 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. 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 Tutoriales Contactenos Redirecciona tu Pagina Gratis!!! Votanos en La web del Programador
|