viernes, 20 de enero de 2012

Selección y eliminación de todos los elementos de un ListBox:

Insertar un ListBox y dos Botón en un nuevo proyecto. Poner la propiedad MultiSelect del ListBox
a "1 - Simple" y escriba el siguiente código:

Private Declare Function SendMessageLong Lib "user32" Alias
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Sub Form_Load()
List1.AddItem "Texto 1"
List1.AddItem "Texto 2"
List1.AddItem "Texto 3"
List1.AddItem "Texto 4"
List1.AddItem "Texto 5"
List1.AddItem "Texto 6"
List1.AddItem "Texto 7"
End Sub

Private Sub Command1_Click()
'Seleccion de todo el contenido
Dim Resp As Long
Resp = SendMessageLong(List1.hwnd, &H185&, True, -1)
End Sub

Private Sub Command2_Click()
'Eliminacion de todos los elementos seleccionados
Dim Resp As Long
Resp = SendMessageLong(List1.hwnd, &H185&, False, -1)
End Sub

Como desplegar la lista de un ComboBox automáticamente:


Insertar un ComboBox y un Botón en un nuevo proyecto y escribir el siguiente código:

Private Declare Function SendMessageLong Lib "user32" Alias
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "Objeto 1"
Combo1.AddItem "Objeto 2"
Combo1.AddItem "Objeto 3"
Combo1.AddItem "Objeto 4"
Combo1.AddItem "Objeto 5"
Combo1.AddItem "Objeto 6"
Combo1.AddItem "Objeto 7"
Combo1.Text = "Objeto 1"
End Sub

Private Sub Command1_Click()
'ComboBox desplegado
Dim Resp As Long
Resp = SendMessageLong(Combo1.hwnd, &H14F, True, 0)
End Sub
Nota: Resp = SendMessageLong(Combo1.hwnd, &H14F, False, 0) oculta la lista desplegada
de un ComboBox, aunque esto sucede también cuando cambiamos el focus a otro control o al formulario.

Salvar el contenido de un TextBox a un fichero en disco:


Añada el siguiente código:
Private Sub Command1_Click()
Dim canalLibre As Integer
'Obtenemos un canal libre que nos dará
'el sistema oparativo para poder operar
canalLibre = FreeFile
'Abrimos el fichero en el canal dado
Open "C:\fichero.txt" For Output As #canalLibre
'Escribimos el contenido del TextBox al fichero
Print #canalLibre, Text1
Close #canalLibre
End Sub

Nuevo

Para abrir:
Código:
Dim foo As Integer

foo = FreeFile
Open "C:\Archivo.txt" For Input As #foo
Text1.Text = Input(LOF(foo), #foo)
Close #foo
Para guardar:
Código:
Dim foo As Integer

foo = FreeFile
Open "C:\Archivo.txt" For Output As #foo
Print #foo, Text1.Text
Close #foo
dialogos:
Ese es para Abrir
Código:
Dim strOpen As String
CommonDialog1.ShowOpen
strOpen = CommonDialog1.FileName
Text1.LoadFile strOpen
Text1.LoadFile strClose
Ese para guardar
Código:
Dim strNewFile As String
CommonDialog1.ShowSave
strNewFile = CommonDialog1.FileName
Text1.SaveFile strNewFile

Capturar la pantalla entera o la ventana activa:


Añadir dos botones y escribir el siguiente código:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte,
ByVal bScan As Byte, ByVal dwFlags As Long,
ByVal dwExtraInfo As Long)

Private Sub Command1_Click()
'Captura la ventana activa
keybd_event 44, 0, 0&, 0&
End Sub

Private Sub Command2_Click()
'Captura toda la pantalla
keybd_event 44, 1, 0&, 0&
End Sub

Determinar si un fichero existe o no:

Escriba el siguiente código: (una de tanta maneras aparte de Dir$())

Private Sub Form_Load()
On Error GoTo Fallo
x = GetAttr("C:\Autoexec.bat")
MsgBox "El fichero existe."
Exit Sub
Fallo:
MsgBox "El fichero no existe."
End Sub

Como obtener el directorio desde donde estamos ejecutando nuestro programa:

Escribir el siguiente código:

Private Sub Form_Load()
Dim Directorio as String
ChDir App.Path
ChDrive App.Path
Directorio = App.Path
If Len(Directorio) > 3 Then
Directorio = Directorio & "\"
End If
End Sub

Calcular la etiqueta o label de un disco duro:


Hallar la etiqueta o label del mismo disco duro:

Escribir el siguiente código:
Private Declare Function GetVolumeInformation& Lib "kernel32" Alias 
"GetVolumeInformationA" (ByVal lpRootPathName As String, 
ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, 
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, 
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, 
ByVal nFileSystemNameSize As Long)

Private Sub Form_Load()
  Dim cad1 As String * 256
  Dim cad2 As String * 256
  Dim numSerie As Long
  Dim longitud As Long
  Dim flag As Long
  unidad = "D:\"
  Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, 
  flag, cad2, 256)
  MsgBox "Label de la unidad " & unidad & " = " & cad1
End Sub

Uso de Random:


La función Rnd o Random posee la virtud de obtener números aleatorios entre 0 y 1:

El único inconveniente a la hora de usar Rnd, es que hay que inicializarlo, en otro caso,
el resultado de la función Rnd, será siempre el mismo dentro de un determinado ordenador.
Por ejemplo, el código:

Private Sub Form_Load()
  Dim Num As Double
  Num = Rnd
  MsgBox Num
End Sub
Nos daría como resultado siempre el mismo número.

Para solucionar este problema, debemos escribir la sentencia Randomize antes de llamar
a la función Rnd. De esta manera, la función Rnd actuará correctamente.

El código quedaría así:

Private Sub Form_Load()
  Dim Num As Double
  Randomize
  Num = Rnd
  MsgBox Num
End Sub

Abrir la ventana de Propiedades de agregar o quitar aplicaciones:

Añada el siguiente código:

Private Sub Command1_Click()
X = Shell("Rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl @0")
End Sub

Vaciar la carpeta de Documentos de Windows


Inicie un nuevo proyecto y añada el siguiente código:
Private Declare Function SHAddToRecentDocs Lib "Shell32" 
(ByVal lFlags As Long, ByVal lPv As Long) As Long

Private Sub Form_Load()
    SHAddToRecentDocs 0, 0
End Sub

Como crear un grupo de programas:

Muy útil para crear instalaciones por ejemplo:

Añadir un textbox y hacerlo oculto.
Una vez oculto, escribir estas líneas sustituyendo "Nombre del Grupo" por que que se desea crear,
y que lo colocamos en Inicio -> Programas.

Private Sub Command1_Click()
    Text1.LinkTopic = "Progman|Progman"
    Text1.LinkMode = 2
    Text1.LinkExecute "[CreateGroup(" + "Nombre del Grupo" + ")]"
End Sub

VB.Net] Mover un form o PictureBox con el ratón

Haz lo siguiente:
Abre un nuevo proyecto
Pega un PictureBox



El código



Public Class Form1 
    Private Const WM_NCLBUTTONDOWN = &HA1 
    Private Const HTCAPTION = 2 

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ 
                 (ByVal hwnd As Integer, ByVal wMsg As Integer, _ 
                  ByVal wParam As Integer, ByVal lParam As String) As Integer 
    Private Declare Sub ReleaseCapture Lib "user32" () 

'Desplazamiento de la PictureBox 
    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove 
        Dim lHwnd As Int32 
        lHwnd = PictureBox1.Handle 
        If lHwnd = 0 Then Exit Sub 
        ReleaseCapture() 
        SendMessage(lHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) 
    End Sub 

'Desplazamiento del form 
    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove 
        Dim lHwnd As Int32 
        lHwnd = Me.Handle 
        If lHwnd = 0 Then Exit Sub 
        ReleaseCapture() 
        SendMessage(lHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) 
    End Sub 
End Class