de Grenville Tryon Pera

de Grenville Tryon Pera

Aplicaciones	Controles	Trucos	Preguntas	Teoria
Internet	Enlaces	Casos	Surf

Las paginas de Visual Basic

Pagina 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

121	Chat con VB	Crear dos programas en VB que puedan hacer 'chat' entre si
122	Cadena a fecha	Crear una fecha de una cadena, sin importar el valor regional
123	Ejecutar una funcion por su nombre	Poder ejecutar una funcion invocandola por su nombre (VB6)
124	Detener programa mientras se ejecuta otro	Detener la ejecucion de tu sistema mientras ejecutas otra rutina
125	Texto pasando sobre una imagen	El texto pasara sobre una imagen en VB
126	Activar/dsactivar barras de tareas en VB	Como activar y desactivar la barra de tareas
127	Enviar archivo a la papelera	Enviar un archivo a la papelera de reciclaje
128	Usar cursores animados en un programa VB	Como activar en un sistema sus propios cursores animados
129	Vincular dos BD Access desde VB	Como vincular dos MDB desde Access
130	Poner una forma normal como MDI Hija	Como poner una forma normal como una MD Hija

CHAT CON VB
'Crear dos sesiones de VB. En c/u: Añadir un winsock y tres textbox. (El Winsock con protocol=1) El primer textbox contendra al nombre/numero de IP remoto (desde DOS winipcfg me da el IP local. Decirselo al destinatario) .
Private Sub Text1_LostFocus()
Winsock1.Close
With Winsock1
.RemoteHost = Text1.Text
.RemotePort = 1001 'En el otro caso, 1002
.Bind 1002 'En el otro caso, 1001
End With
End Sub
Private Sub Text3_Change()
On Error GoTo Hell
Winsock1.SendData Text3.Text
Exit Sub
Hell:
Label1.Caption = Time
On Error GoTo 0
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Winsock1.GetData strData
Text2.Text = strData
End Sub

CADENA A FECHA
? dateserial(1999,10,11) 11/10/99

EJECUTAR UNA FUNCION POR SU NOMBRE
? El siguiente ejemplo crea dos funciones (Divide y Multiplica). Si en Text2 y Text3 colocamos los argumentos, al pulsar el botón se ejecuta la operación que hallamos escrito en Text1 (Multiplica o Divide).
Public Function Divide(arg1 As Long, arg2 As Long)
Divide = arg1 / arg2
End Function
Public Function Multiplica(arg1 As Long, arg2 As Long)
Multiplica = arg1 * arg2
End Function
Private Sub Command1_Click()
MsgBox CallByName(Me, Text1.Text, VbMethod, Text2.Text, Text3.Text)
End Sub

DETENER PROGRAMA MIENTRAS SE EJECUTE OTRO
'Con este código funciona:
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
'Codigo que ejecuta el Shell, puede estar dentro de un boton o un procedimiento
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell("command.com /C jj.bat", vbMinimizedNoFocus))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents
Sleep 100 'Solo una espera
Fx = Fx + 1 ' Un contador para indicar que trabaja
Label4.Caption = Fx ' Una label para mostrar el contador
Label4.Refresh
Loop While RetVal = STILL_ACTIVE

TEXTO PASANDO SOBRE IMAGEN
Dim OldY As Integer
Private Sub Timer1_Timer()
OldY = Picture1.CurrentY
If OldY < 1 Then OldY = Picture1.Height \ Screen.TwipsPerPixelY
Picture1.Cls
Picture1.PSet (0, (OldY - Picture1.TextHeight(Text1.Text & Chr(13) & Text2.Text) - 1)), Picture1.Point(0, (OldY - Picture1.TextHeight(Text1.Text & Chr(13) & Text2.Text) - 1))
Picture1.Print Text1.Text & Chr(13) & Text2.Text
End Sub

ACTIVAR/DESACTIVAR BARRA DE TAREAS DESDE VB
El siguiente código sirve para Ocultar la barra de tareas, y desactivar las teclas de windows (ctrl+Esc, Alt+Tab,etc)
Ventana = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
FastTaskSwitching False
y este otro muestra la barra de tareas y activa las teclas de nuevo.
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
FastTaskSwitching True

ENVIAR ARCHIVO A PAPELERA
Borrar un archivo, dejándolo en la papelera
Declarar en un formulario :
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Veremos ahora la función que permite borrar y enviar a la papelera :
Sub EnviaPapelera(ByVal Fichero As String)
Dim SHFileOp As SHFILEOPSTRUCT
Dim Res As Long
With SHFileOp
.wFunc = FO_DELETE
.pFrom = Fichero
.fFlags = FOF_ALLOWUNDO
End With
Res = SHFileOperation(SHFileOp)
End Sub

USAR CURSORES ANI EN UN SISTEMA
' Default form pointer index constant
Private Const GLC_HCURSOR = (-12)
' Store index of swapped cursor
Private hSwapCursor As Long
Public Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Public Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Sub Form_Load()
Dim hAniCursor As Long
hAniCursor = LoadCursorFromFile(App.Path & "\dgr.ani")
hSwapCursor = SetClassLong(frmSplash.hWnd, GLC_HCURSOR, hAniCursor)
End Sub
Private Sub Form_Unload(Cancel As Integer)
hSwapCursor = ModUtiles.SetClassLong(frmSplash.hWnd, GLC_HCURSOR,hSwapCursor)
End Sub

VINCULAR BD'S DE ACCESS DESDE VB
Dim db As Database
Dim ts As TableDefs
Dim t As TableDef
Set ts = db.TableDefs
On Error Resume Next
ts.Delete "Temp"
On Error GoTo 0
Set t = db.CreateTableDef("Temp")
t.Connect = "DATABASE=LaOtraMDB.MDB;"
t.SourceTableName = "LaOtraTabla"
t.Attributes = dbAttachExclusive
ts.Append t

PONER UNA FORMA NORMAL COMO MDI HIJA

Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Dim res as long
res = SetParent(Form2.hWnd, Form1.hWnd)

Hosted by www.Geocities.ws