|
|
|
|
|
|
| |
| |
| |
| |
|
Se Recomienda Resolución de 800x600 pixels |
|
1.- SendMessage: la que siempre hay que tener a mano 'Declaración del API de 16 bits Declare Function SendMessage Lib
"User" _
(ByVal hWnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Long 'Declaración del API de 32 bits. Declare Function SendMessage Lib
"User32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Long) As Long 'Utilidades para un menú de edición: 'Declaración de las constantes Global Const WM_USER = &H400 Global Const EM_GETSEL = WM_USER + 0 Global Const EM_SETSEL = WM_USER + 1 Global Const EM_REPLACESEL = WM_USER +
18 Global Const EM_UNDO = WM_USER + 23 Const EM_LINEFROMCHAR = WM_USER + 25 Const EM_GETLINECOUNT = WM_USER + 10 ' Global Const WM_CUT = &H300 Global Const WM_COPY = &H301 Global Const WM_PASTE = &H302 Global Const WM_CLEAR = &H303 ' 'Deshacer:
'Nota: si se hace de esta forma,
'no es necesario usar una variable para asignar el
valor devuelto.
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&) Then
End If
'también: x =
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&) 'Copiar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_COPY, 0, ByVal 0&) Then
End If 'Cortar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CUT, 0, ByVal 0&) Then
End If 'Borrar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CLEAR, 0, ByVal 0&)
Then
End If 'Pegar:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_PASTE, 0, ByVal 0&)
Then
End If 'Seleccionar Todo:
If
SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_SETSEL, 0, ByVal
&HFFFF0000) Then
End If 'Crear un TextBox con 64 KB en lugar de
32 Global Const WM_USER = &H400 Global Const EM_LIMITTEXT = WM_USER + 21 Dim LTmp As long LTmp = SendMessage(Text1.hWnd,
EM_LIMITTEXT, 0, ByVal 0&) Declare Function SetWindowWord Lib
"User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal wNewWord
As Integer) As Integer Declare Function SetWindowWord Lib
"User32" Alias "SetWindowWord" (ByVal hwnd As Long, ByVal
nIndex As Long, ByVal wNewWord As Long) As Long 'Crear una ventana flotante al estilo de
los tool-bar 'Cuando se minimiza la ventana padre,
también lo hace ésta. Const SWW_hParent = -8 'En Form_Load (suponiendo que la ventana
padre es Form1) If SetWindowWord(hWnd, SWW_hParent,
form1.hWnd) Then End If 3.- Manejo de ventanas... 'Declaración de Funciones para tomar
las listas de tareas Declare Function GetWindow Lib
"user" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer Declare Function GetWindowText Lib
"user" (ByVal hWnd As Integer, ByVal lpString As String, ByVal
nMaxCount As Integer) As Integer Declare Function GetWindowTextLength Lib
"user" (ByVal hWnd As Integer) As Integer Declare Function IsWindowVisible Lib
"User" (ByVal hWnd As Integer) As Integer 'Declaraciones para 32 bits Declare Function GetWindow Lib
"user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd
As Long) As Long Declare Function GetWindowText Lib
"user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal
lpString As String, ByVal cch As Long) As Long Declare Function GetWindowTextLength Lib
"user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long)
As Long Declare Function IsWindowVisible Lib
"user32" (ByVal hwnd As Long) As Long 'Constantes para GetWindow Const GW_HWNDFIRST = 0 Const GW_HWNDLAST = 1 Const GW_HWNDNEXT = 2 Const GW_HWNDPREV = 3 Const GW_OWNER = 4 Const GW_CHILD = 5 4.-
GetVolumeInformation: volumen de un disco (sólo 32 bits) 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 Ejemplo
para leer el volumen de un disco, esta función se puede usar para ¡catalogar
los CD's musicales! Dim
lVSN As Long, n As Long, s1 As String, s2 As String
5.-
GetDriveType: comprobar el tipo de unidad Para
comprobar si es un CD-ROM (o CD-musical): 'Valores
de retorno de GetDriveType Public
Const DRIVE_REMOVABLE = 2 Public
Const DRIVE_FIXED = 3 Public
Const DRIVE_REMOTE = 4 'Estos
tipos no están en el fichero de las declaraciones del API de 16 bits Public
Const DRIVE_CDROM = 5 Public
Const DRIVE_RAMDISK = 6 ' Declare
Function GetDriveType Lib "Kernel" (ByVal nDrive As Integer) As
Integer Declare
Function GetDriveType Lib "Kernel32" Alias "GetDriveTypeA"
(ByVal nDrive As String) As Long Dim
lDrive As Long Dim
szRoot As String szRoot="D:\"
'Poner aquí la unidad del CD-ROM o la que queramos comprobar lDrive=
GetDriveType(szRoot) If
lDrive = DRIVE_CDROM Then
'Es un CD-ROM/Compact-Disc End If 6.- Dejar una ventana siempre visible De nuevo
usaremos el API de Windows: SetWindowPos 'Declaración para usar ventanas siempre visibles 'Versión para 16 bits Declare Function SetWindowPos Lib "User" (ByVal hWnd As
Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As
Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As
Integer 'Versión para 32 bits Declare Function SetWindowPos Lib "User32" Alias
"SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long,
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal
wFlags As Long) As Long ' SetWindowPos Flags Const SWP_NOSIZE = &H1 Const SWP_NOMOVE = &H2 'Const SWP_NOZORDER = &H4 'Const SWP_NOREDRAW = &H8 Const SWP_NOACTIVATE = &H10 'Const SWP_DRAWFRAME = &H20 Const SWP_SHOWWINDOW = &H40 'Const SWP_HIDEWINDOW = &H80 'Const SWP_NOCOPYBITS = &H100 'Const SWP_NOREPOSITION = &H200 Const SWP_FLAGS = SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or
SWP_NOACTIVATE 'Código para poner en Form_Load 'De esta forma no es necesario usar una variable para asignar el valor
devuelto: If SetWindowPos(hWnd, -1, 0, 0, 0, 0, SWP_FLAGS) Then End if 7.- Usar Sleep en lugar de DoEvents
Este
truco está sacado de Tips & Tricks, from Visual Basic Web Magazine. Según
el autor la función DoEvents hace lo siguiente:
while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) {
TranslateMessage(&msg);
DispatchMessage(&msg); }
Con lo
cual gasta tiempo comprobandos otros mensajes en el mismo proceso. Este
comportamiento no tiene valor en un sistema operativo multitarea. Sleep lo hace
de forma más eficiente. Public Declare Sub Sleep Lib "kernel32" Alias "Sleep"
(ByVal dwMilliseconds As Long) Y se
puede llamar de la siguiente forma: Sleep 0& 8.-
Manejo del Registro del Sistema Aquí os
pongo algunos ejemplos para usar el Registro con el API de 32 bits. Normalmente,
para obtener los programas asociados a una extensión, sólo es necesario usar
la función: RegQueryValue. La siguiente función de ejemplo, es la que uso para
obtener información de una clave del registro: Public Const HKEY_CLASSES_ROOT = &H80000000 Declare Function RegQueryValue Lib "advapi32.dll" Alias
"RegQueryValueA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, _
lpcbValue As Long) As Long 'Busca una entrada en el registro Private Function QueryRegBase(ByVal Entry As String, Optional vKey) As
String
Dim buf As
String
Dim buflen As
Long
Dim hKey As
Long
'Si no se
especifica la clave del Registro, usar HKEY_CLASSES_ROOT
If
IsMissing(vKey) Then
hKey = HKEY_CLASSES_ROOT
Else
hKey = CLng(vKey)
End If
On Local Error
Resume Next
buf =
Space$(300)
buflen =
Len(buf)
'Buscar la
entrada especificada y devolver el valor asignado
If
RegQueryValue(hKey, Entry, buf, buflen) = 0 Then
If buflen > 1 Then
'El formato devuelto es ASCIIZ, así que quitar el último caracter
QueryRegBase = Left$(buf, buflen - 1)
Else
QueryRegBase = ""
End If
Else
QueryRegBase = ""
End If
'Desactivar la
detección de errores
On Local Error
GoTo 0 End Function
Para
usarla, por ejemplo para saber el programa asociado para abrir una determinada extensión, de que programa se obtiene el
icono y que número de icono es:
Private Sub BuscarExtensionID(sExt As
String)
Dim lRet As Long
Dim sKey As String
Dim sValue As String
Dim hKey As Long
Dim sExe As String
Dim sIcon As String
Dim lIcon As Long
Dim sProgId As String
Dim i As Integer
Caption = "Mostrar asociaciones de la clave: " & sExt
List2.Visible = True
List2.Clear
List2.AddItem "Valores del Registro para
" & sExt
'
'Buscar en el registro la extensión...
sProgId = QueryRegBase(sExt)
If Len(sProgId) Then
List2.AddItem "Clave: " & sProgId
sKey = sProgId & "\DefaultIcon"
List2.AddItem sKey
sValue =
QueryRegBase(sKey)
If Len(sValue) Then
i = InStr(sValue, ",")
If i Then
sIcon = Left$(sValue, i - 1)
lIcon = Val(Mid$(sValue, i + 1))
Else 'No tiene programa para Defaulticon
sIcon = sValue
lIcon = 0
sValue = ""
End If
End If
List2.AddItem " Icono de: " & sIcon
List2.AddItem " Icono nº: " & lIcon
'
'Obtener el programa asociado por defecto para
Abrir
'no quiere decir que este sea el que se ejecute
cuando se haga doble-click
sKey = sProgId &
"\Shell\Open\Command"
sValue = QueryRegBase(sKey)
If Len(sValue) Then
i = InStr(sValue, ".")
If i Then
i = InStr(i, sValue, " ")
If i Then
sExe = Trim$(Left$(sValue, i - 1))
Else
sExe = Trim$(sValue)
End If
Else
sExe = Trim$(sValue)
End If
End If
List2.AddItem sKey
List2.AddItem " Programa asociado: " & sExe
End If End Sub Ejemplo
para crear claves en el Registro: Public Const HKEY_CLASSES_ROOT =
&H80000000 Public Const HKEY_CURRENT_USER =
&H80000001 Public Const HKEY_LOCAL_MACHINE =
&H80000002 Public Const HKEY_USERS = &H80000003 ' 'Para los valores devueltos por las
funciones de manejo del Registro Public Const ERROR_SUCCESS = 0& Public Const ERROR_NO_MORE_ITEMS =
259& ' ' Tipos de datos Reg... Public Const REG_SZ = 1 ' 'Declaraciones del API de Windows para
32 bits Declare Function RegQueryValue Lib
"advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long,
ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long Declare Function RegEnumKey Lib
"advapi32" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal
iSubKey As Long, ByVal lpszName As String, ByVal cchName As Long) As Long Declare Function RegOpenKey Lib
"advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal
lpszSubKey As String, phkResult As Long) As Long Declare Function RegCloseKey Lib
"advapi32" (ByVal hKey As Long) As Long Declare Function RegCreateKey Lib
"advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long,
ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegSetValue Lib
"advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long,
ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal
cbData As Long) As Long Declare Function RegDeleteKey Lib
"advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long,
ByVal lpSubKey As String) As Long 'Declaraciones para el API de 16 bits Declare Function RegQueryValue Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
lpValue As String, lpcbValue As Long) As Long Declare Function RegEnumKey Lib
"shell.dll" (ByVal hKey As Long, ByVal iSubKey As Long, ByVal lpszName
As String, ByVal cchName As Long) As Long Declare Function RegOpenKey Lib
"shell.dll" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult
As Long) As Long Declare Function RegCloseKey Lib
"shell.dll" (ByVal hKey As Long) As Long Declare Function RegCreateKey Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult
As Long) As Long Declare Function RegSetValue Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long Declare Function RegDeleteKey Lib
"shell.dll" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Una nota de precaución: 9.-
Diálogos comunes usando el API de Windows (16 y 32 bits) Las
funciones para manejar los diálogos comunes del API de Windows, son las
siguientes: 'Declaraciones para el API de 16
bits 'Abrir y guardar Declare Function GetOpenFileName Lib "commdlg.dll" (lpofn As
tagOpenFileName) As Integer Declare Function GetSaveFileName Lib "commdlg.dll" (lpofn As
tagOpenFileName) As Integer 'Buscar y reemplazar (aún no he podido ponerlas en marcha???) Declare Function FindText Lib "commdlg.dll" (lpFR As
tagFindReplace) As Integer Declare Function ReplaceText Lib "commdlg.dll" (lpFR As
tagFindReplace) As Integer 'Para la impresora Declare Function PrintDlg Lib "commdlg.dll" (tagPD As
tagPrintDlg) As Integer ' 'Declaraciones para 32 bits 'Abrir y guardar Declare Function GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function GetFileTitle Lib "comdlg32.dll" Alias
"GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String,
ByVal cbBuf As Integer) As Integer 'Buscar y reemplazar Declare Function FindText Lib "comdlg32.dll" Alias
"FindTextA " (pFindreplace As FINDREPLACE) As Long Declare Function ReplaceText Lib "comdlg32.dll" Alias
"ReplaceTextA" (pFindreplace As FINDREPLACE) As Long 'Para la impresora Declare Function PrintDlg Lib "comdlg32.dll" Alias
"PrintDlgA" (pPrintdlg As PRINTDLG) As Long Declare Function PageSetupDlg Lib "comdlg32.dll" Alias
"PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long 'Para los colores Declare Function ChooseColor Lib "comdlg32.dll" Alias
"ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long 'Las fuentes Declare Function ChooseFont Lib "comdlg32.dll" Alias
"ChooseFontA" (pChoosefont As CHOOSEFONT) As Long No
incluyo ejemplos ni las declaraciones de los tipos, por ser demasiado
"grandes". Pero las incluyo en un listado con ejemplos para abrir,
etc., aunque con las funciones para 16 bits, ya que desde que uso el VB para 32
bits, suelo hacerlo con el control que trae. 10.-
Mostrar un icono en la barra de tareas Aquí
pongo parte del código, para los que sólo quieren echar un vistazo: --------------- Private Type TIPONOTIFICARICONO
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage
As Long
hIcon As Long
szTip As String
* 64 End Type '------------------ Private Const NIM_ADD = &H0 Private Const NIM_MODIFY = &H1 Private Const NIM_DELETE = &H2 Private Const WM_MOUSEMOVE = &H200 Private Const NIF_MESSAGE = &H1 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 '-------------------- Private Declare Function Shell_NotifyIcon Lib "shell32" _
Alias
"Shell_NotifyIconA" (ByVal dwMessage As Long, _
pnid As
TIPONOTIFICARICONO) As Boolean '-------------------- Private Declare Function WinExec& Lib "kernel32" _
(ByVal
lpCmdLine As String, ByVal nCmdShow As Long) '-------------------- Dim t As TIPONOTIFICARICONO Private Sub Form_Load()
If
App.PrevInstance Then
mnuAcerca_Click
Unload Me
End
End If '---------------------------------
t.cbSize =
Len(t)
t.hwnd =
picGancho.hwnd
t.uId = 1&
t.uFlags =
NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.ucallbackMessage
= WM_MOUSEMOVE
t.hIcon =
Me.Icon '---------------------------------
t.szTip =
"Ejemplo de barra de tareas..." & Chr$(0) ' Es un string de
"C" ( \0 )
Shell_NotifyIcon
NIM_ADD, t
Me.Hide
App.TaskVisible
= False End Sub
©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
|