Bueno Aqui Empesare a Poner Varios Codes, que he ido recopilando y sacado de una web de un amigo ( El me Autorizo) Me Gustaria Que Ustedes Tambien Postearan Sus Codes, Pero Solo Codes nada de Preguntas asi para mantener el Orden del Topic y no desvirtuar el Tema Mostrar palabra que se encuentra debajo del cursor Agregar 1 control Label y 1 RichTextBox y poner el siguiente código Insertar CODE, HTML o PHP: Option Explicit Private Const EM_CHARFROMPOS& = &HD7 Private Type POINTAPI X As Long Y As Long End Type Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long Public Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String Dim pt As POINTAPI Dim pos As Integer Dim start_pos As Integer Dim end_pos As Integer Dim ch As String Dim txt As String Dim txtlen As Integer pt.X = X \ Screen.TwipsPerPixelX pt.Y = Y \ Screen.TwipsPerPixelY pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt) If pos <= 0 Then Exit Function txt = rch.Text For start_pos = pos To 1 Step -1 ch = Mid$(rch.Text, start_pos, 1) If Not ( _ (ch >= "0" And ch <= "9") Or _ (ch >= "a" And ch <= "z") Or _ (ch >= "A" And ch <= "Z") Or _ ch = "_" _ ) Then Exit For Next start_pos start_pos = start_pos + 1 txtlen = Len(txt) For end_pos = pos To txtlen ch = Mid$(txt, end_pos, 1) If Not ( _ (ch >= "0" And ch <= "9") Or _ (ch >= "a" And ch <= "z") Or _ (ch >= "A" And ch <= "Z") Or _ ch = "_" _ ) Then Exit For Next end_pos end_pos = end_pos - 1 If start_pos <= end_pos Then _ RichWordOver = Mid$(txt, start_pos, _ end_pos - start_pos + 1) End Function Private Sub Form_Load() RichTextBox1.Text = "Que rica esta tu hermanita, que " & _ "esta en mi casita, se esta cayendo de buena " & _ vbCrLf & vbCrLf & "porque ya esta madurita.. " & _ "Jojojo" End Sub Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim txt As String txt = RichWordOver(RichTextBox1, X, Y) If Label1.Caption <> txt Then Label1.Caption = txt End If End Sub Formulario que explota e implota (animación de inicio) Agregar 1 control CommandButton y poner el siguiente código En el Formulario Insertar CODE, HTML o PHP: Private Sub Command1_Click() Call ImplodeForm(Me, 2, 500, 1) End Set Form1 = Nothing End Sub Private Sub Form_Load() Call ExplodeForm(Me, 500) Command1.Caption = "Dame un cochino clic" End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Call ImplodeForm(Me, 2, 500, 1) End Sub En el Modulo Insertar CODE, HTML o PHP: Option Explicit #If Win16 Then Type RECT Left As Integer Top As Integer Right As Integer Bottom As Integer End Type #Else Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type #End If #If Win16 Then Declare Sub GetWindowRect Lib "User" _ (ByVal hwnd As Integer, lpRect As RECT) Declare Function GetDC Lib "User" _ (ByVal hwnd As Integer) As Integer Declare Function ReleaseDC Lib "User" _ (ByVal hwnd As Integer, _ ByVal hdc As Integer) As Integer Declare Sub SetBkColor Lib "GDI" _ (ByVal hdc As Integer, ByVal crColor As Long) Declare Sub Rectangle Lib "GDI" _ (ByVal hdc As Integer, ByVal X1 As Integer, _ ByVal Y1 As Integer, ByVal X2 As Integer, _ ByVal Y2 As Integer) Declare Function CreateSolidBrush Lib "GDI" _ (ByVal crColor As Long) As Integer Declare Function SelectObject Lib "GDI" _ (ByVal hdc As Integer, _ ByVal hObject As Integer) As Integer Declare Sub DeleteObject Lib "GDI" _ (ByVal hObject As Integer) #Else Declare Function GetWindowRect Lib "user32" _ (ByVal hwnd As Long, lpRect As RECT) As Long Declare Function GetDC Lib "user32" _ (ByVal hwnd As Long) As Long Declare Function ReleaseDC Lib "user32" _ (ByVal hwnd As Long, ByVal hdc As Long) As Long Declare Function SetBkColor Lib "gdi32" _ (ByVal hdc As Long, ByVal crColor As Long) _ As Long Declare Function Rectangle Lib "gdi32" _ (ByVal hdc As Long, ByVal X1 As Long, _ ByVal Y1 As Long, ByVal X2 As Long, _ ByVal Y2 As Long) As Long Declare Function CreateSolidBrush Lib "gdi32" _ (ByVal crColor As Long) As Long Declare Function SelectObject Lib "user32" _ (ByVal hdc As Long, _ ByVal hObject As Long) As Long Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long #End If Sub ExplodeForm(f As Form, Movement As Integer) Dim myRect As RECT Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy% Dim TheScreen As Long Dim Brush As Long GetWindowRect f.hwnd, myRect formWidth = (myRect.Right - myRect.Left) formHeight = myRect.Bottom - myRect.Top TheScreen = GetDC(0) Brush = CreateSolidBrush(f.BackColor) For i = 1 To Movement Cx = formWidth * (i / Movement) Cy = formHeight * (i / Movement) X = myRect.Left + (formWidth - Cx) / 2 Y = myRect.Top + (formHeight - Cy) / 2 Rectangle TheScreen, X, Y, X + Cx, Y + Cy Next i X = ReleaseDC(0, TheScreen) DeleteObject (Brush) End Sub Public Sub ImplodeForm(f As Form, Direction As Integer, Movement As Integer, ModalState As Integer) Dim myRect As RECT Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy% Dim TheScreen As Long Dim Brush As Long GetWindowRect f.hwnd, myRect formWidth = (myRect.Right - myRect.Left) formHeight = myRect.Bottom - myRect.Top TheScreen = GetDC(0) Brush = CreateSolidBrush(f.BackColor) For i = Movement To 1 Step -1 Cx = formWidth * (i / Movement) Cy = formHeight * (i / Movement) X = myRect.Left + (formWidth - Cx) / 2 Y = myRect.Top + (formHeight - Cy) / 2 Rectangle TheScreen, X, Y, X + Cx, Y + Cy Next i X = ReleaseDC(0, TheScreen) DeleteObject (Brush) End Sub Abrir y Cerrar unidad de CD Agregar un 2 CommandButton y introducir lo siguiente: En el Formulario Insertar CODE, HTML o PHP: Private Sub Command1_Click() mciSendString "set CDAudio door open", "", 127, 0 End Sub Private Sub Command2_Click() mciSendString "set CDAudio door closed", "", 127, 0 End Sub En el Modulo Insertar CODE, HTML o PHP: Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _ (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Con este Code Podras Abrir una Unidad Predeterminada de CD Bloquear Ratón y Teclado durante 10 segundos Agregar un Timer y un CommandButton e introducir lo siguiente: En el Formulario: Insertar CODE, HTML o PHP: Private Sub Command1_Click() BlockInput True ShowCursor False End Sub Private Sub Form_Load() Timer1.Interval = 10000 End Sub Private Sub Timer1_Timer() BlockInput False ShowCursor True End Sub En el Modulo: Insertar CODE, HTML o PHP: Public Declare Function BlockInput Lib "user32" _ (ByVal fBlock As Long) As Long Declare Function ShowCursor Lib "user32" _ (ByVal bShow As Long) As Long Con esto Bloquearas el Teclado y el Mouse por 10 Seg. ideal para hacer bromas ^^ Cerrar el Explorador de Internet Agregar un CommandButton en el formulario y introducir lo siguiente: En el Formulario: Insertar CODE, HTML o PHP: Private Sub Command1_Click() Dim winHwnd As Long Dim RetVal As Long winHwnd = FindWindow("IEFrame", vbNullString) If winHwnd <> 0 Then RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&) If RetVal = 0 Then MsgBox "Error, enviando mensaje" End If Else MsgBox "El Internet Explorer no está abierto, Avispate" End If End Sub En el Modulo: Insertar CODE, HTML o PHP: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function PostMessage Lib "user32" Alias _ "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Const WM_CLOSE = &H10 Cambiar el fondo de escritorio de Windows Agregar un CommandButton y poner el siguiente código: En el Formulario: Insertar CODE, HTML o PHP: Private Declare Function SystemParametersInfo Lib "user32" _ Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _ ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long Const SPI_SETDESKWALLPAPER = 20 Const SPIF_UPDATEINIFILE = &H1 Private Sub Command1_Click() SystemParametersInfo SPI_SETDESKWALLPAPER, 0, _ "[COLOR=Red]C:\Windows\wallpaper.bpm[/COLOR]", SPIF_UPDATEINIFILE End Sub Por Supuesto que la Imagen que queremos poner como fondo de escritorio en este ejemplo este en el directorio "C:\Windows\wallpaper.bpm" puedes cambiarlo por la ruta que tu quieras Crear una conexión a una base de datos de Access 2000 en tiempo de ejecución (conexión con ADO) Agregar un TextBox llamado Text1, copiarlo y pegarlo 2 veces; deberán quedar así: Text1(0) Text2(1) Text3(2) Ya hecho eso, tendrán que crear una base de datos llamada midb con una tabla llamada Datos y con los siguientes campos: Nombre Edad Direccion Y llenar un par de registros. En Visual Basic, ir al menú Proyecto-->Referencias Y seleccionar la casilla de Microsoft ActiveX Data Objects 2.0 Library Ahora introducir el siguiente código: En el Formulario: Insertar CODE, HTML o PHP: Public BaseDatos As String Public Tabla As String Public Campo1 As String Public Campo2 As String Public Campo3 As String Public Conex As ADODB.Connection Public Rst As ADODB.Recordset Sub Conexion() BaseDatos = App.Path & "\midb.mdb" Tabla = "Datos" Campo1 = "Nombre" Campo2 = "Edad" Campo3 = "Direccion" Set Cnn = New ADODB.Connection Set Rst = New ADODB.Recordset Cnn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & BaseDatos Rst.Open "SELECT * FROM " & Tabla & " ORDER BY " & Campo1, _ Cnn, adOpenDynamic, adLockOptimistic Dim CuadrosTexto As TextBox For Each CuadrosTexto In Me.Text1 Set CuadrosTexto.DataSource = Rst Next Text1(0).DataField = Campo1 Text1(1).DataField = Campo2 Text1(2).DataField = Campo3 End Sub Private Sub Form_Load() Conexion End Sub Este Code me sirvio a mi para hacer un programa para un Doctor $$
Primero Que Todo Los Felicito Por Su Nuevo Foro...solo Cacho A Nivel Usuario De Esto..pero Me Interiorisare Mas Con Sus Aportes ..se Agradece
ta bkn los codigos yo toy estudiando visual.net 2003 si te puedo aportar algo al foro no lo voy a dudar xauc compa
Me es super util tu aporte, en especial la conexion a base de datos, muy utilizado en automatizar sistemas.
si mi memoria no me falla D: Spoiler Insertar CODE, HTML o PHP: Private Sub Command1_Click() Dim RutaArchivo as String Dim i as Integer Dim NCanal as Integer NCanal = FreeFile RutaArchivo = "C:Documento.txt" Open RutaArchivo For OutPut as NCanal For i = 1 To 50 Print #NCanal, Next Close NCanal End Sub lo que hace el codigo es crear un fichero de texto en C: y escribir en el del 1 hasta el 50 D: otro muy simple pero nunca esta demas y que salva de alguna que otra ocacion D: Spoiler Insertar CODE, HTML o PHP: Shell("ipconfig"),VBHide espero que no me falle la sintaxis... lo que hace es poder ejecutar una aplicacion, emulando un comando escrito por consola, en este caso ejecutara el comando ipconfig, la variable VBHide le ordena al programa que este lo ejecute de frma silenciosa, es decir, sin mostrar la pantalla negra de la linea de comandos.. util si deseas ejecutar algun comando en tu programa sin que el usuario se de cuenta, ej: (reg import as.reg) ojala de algo sirva y espero contribuir con alguno que otro codigo a la biblioteca saludos