FAQ's de VB6

[Dark Wolf]

Hola!
Aqui vengo de nuevo yo con otro manual, el segundo para ser exactos.
En este desarollaremos una aplicacion que bien puede ser de utilidad propia, pero es una buena oportunidad tambien para tratar el tema de las declaraciones, ya que esta vez habra una.

Veamos:
Abre el Visual Basic y crea un nuevo Form con tres botones, que les pondras en la propiedad Caption: "Apagar, Reiniciar Windows, Reiniciar Sistema"



Listo, la interfaz ya esta lista¿sencillo no?, bien, ahora toca escribir el código que hara que esos botones sirvan para algo.
Lo primero es hacer una declaración,¿cómo se hace?, sencillo, debajo de Option Explicit, pon el siguiente código:

Código:

Private Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal dwReserved&)

Explicemos: Ningun lenjuage de programacion es cuestion de hacer la interfaz y listo, Visual Basic no es la excepcion, aunque, en realidad Visual Basic es el lenjuage mas sencillo(al menos para mi).
Una declaracion es algo que debes mostrarle al programa para que te deje hacer algo, viene a ser algo como explicarle a Visual Basic que quieres desarrollar.
Es muy comun tender que hacer una declaracion, por eso elegi hacer este manual, para dejar un poco mas claras las cosas.

Sigamos
Bien, ahora que ya escribiste la declaración hay que asignarle los eventos a los 3 Commands.

En el código del Command 1 va esto:

Private Sub Command1_Click()
* *Dim i As Integer
* *i = ExitWindowsEx(1, 0&) 'Apaga el equipo
End Sub

En Command 2:

Private Sub Command2_Click()
* Dim i As Integer
* *i = ExitWindowsEx(0, 0&) 'Reinicia Windows
End Sub

Y en Command 3:

Private Sub Command3_Click()
Dim i As Integer
* *i = ExitWindowsEx(2, 0&) 'Reinicia el Sistema
End Sub

Como notaras, los 3 códigos tienen escritas despues de un ' la funcion que van a realizar, te preguntaras ¿que es eso, les puedes dar asi ordenes?, no, son Comentarios.
Los comentarios son una utilidad que solo brinda VB y te permite escribir cualquier cosa al lado del codigo para acordarte luego para que sirve lo que escribiste.
Los comentarios no afectan en absoluto la aplicacion, pueden estar ahi en el código ayúdandonte, pero no te generan ningun problema en cuanto al desarrollo.
Si te fijas cuando lo escribas, estan de Verde, ese es el color que identifica los comentarios.




Bien, ya he explicado todo, la aplicacion ya esta lista para usar.
Descarga el código fuente de este manual clickando aquí


Hasta el próximo manual!

DW



Manual creado por: Darkwolf

[Dark Wolf]

Hola, ¿que tal?, les traigo mi tercer manual, esta vez veremos como desarrollar nuestra propia calculadora en Visual Basic.

Veamos:

Vamos a necesitar un solo form con: 16 Commands Buttons de 375x375.
Dos label sin texto escondidas y un TextBox.



Luego viene el código, que esta vez será bastante largo, es exactamente asi:

Option Explicit

Private Sub Command1_Click()
On Error Resume Next
If Label1.Caption = "+" Then
Text1.Text = Val(Label2.Caption) + Text1.Text
End If

If Label1.Caption = "-" Then
Text1.Text = Val(Label2.Caption) - Text1.Text
End If

If Label1.Caption = "*" Then
Text1.Text = Val(Label2.Caption) * Text1.Text
End If

If Label1.Caption = "/" Then
Text1.Text = Val(Label2.Caption) / Text1.Text
End If

End Sub

Private Sub Command10_Click()
Text1.Text = Text1.Text + "9"
End Sub

Private Sub Command11_Click()
Text1.Text = Text1.Text + "8"
End Sub

Private Sub Command12_Click()
Text1.Text = Text1.Text + "7"
End Sub

Private Sub Command13_Click()
Text1.Text = Text1.Text + "6"
End Sub

Private Sub Command14_Click()
Text1.Text = Text1.Text + "5"
End Sub

Private Sub Command15_Click()
Text1.Text = Text1.Text + "0"
End Sub

Private Sub Command16_Click()
Text1.Text = ""
Label2.Caption = ""
End Sub

Private Sub Command2_Click()
Text1.Text = Text1.Text + "4"
End Sub

Private Sub Command3_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "+"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command4_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "-"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command5_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "*"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command6_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "/"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command7_Click()
Text1.Text = Text1.Text + "3"
End Sub

Private Sub Command8_Click()
Text1.Text = Text1.Text + "2"
End Sub

Private Sub Command9_Click()
Text1.Text = Text1.Text + "1"
End Sub

Private Sub Form_Load()

End Sub

Bien, la explicacion del codigo es sencilla, es muy larga porque debemos asignarle un evento a los 16 botones, los eventos son insertar texto segun el boton que apretemos, llamar a el ordenador para que realice el calculo y rellenar nuevamente el text box con el resultado mediante las labels que tendremos sin texto y vacias, aunque es largo no es complejo ni dificil de entender.

Con eso la aplicacion ya estara lista, es bastante sencilla, hice el manual para tocar un poco el tema de aplicaciones con muchos objetos y largos trozos de código.
Descargen el codigo fuente de este manual aquí


Saludos

[Dark Wolf]

Hola, ¿que tal?, les traigo mi tercer manual, esta vez veremos como desarrollar nuestra propia calculadora en Visual Basic.

Veamos:

Vamos a necesitar un solo form con: 16 Commands Buttons de 375x375.
Dos label sin texto escondidas y un TextBox.



Luego viene el código, que esta vez será bastante largo, es exactamente asi:

Option Explicit

Private Sub Command1_Click()
On Error Resume Next
If Label1.Caption = "+" Then
Text1.Text = Val(Label2.Caption) + Text1.Text
End If

If Label1.Caption = "-" Then
Text1.Text = Val(Label2.Caption) - Text1.Text
End If

If Label1.Caption = "*" Then
Text1.Text = Val(Label2.Caption) * Text1.Text
End If

If Label1.Caption = "/" Then
Text1.Text = Val(Label2.Caption) / Text1.Text
End If

End Sub

Private Sub Command10_Click()
Text1.Text = Text1.Text + "9"
End Sub

Private Sub Command11_Click()
Text1.Text = Text1.Text + "8"
End Sub

Private Sub Command12_Click()
Text1.Text = Text1.Text + "7"
End Sub

Private Sub Command13_Click()
Text1.Text = Text1.Text + "6"
End Sub

Private Sub Command14_Click()
Text1.Text = Text1.Text + "5"
End Sub

Private Sub Command15_Click()
Text1.Text = Text1.Text + "0"
End Sub

Private Sub Command16_Click()
Text1.Text = ""
Label2.Caption = ""
End Sub

Private Sub Command2_Click()
Text1.Text = Text1.Text + "4"
End Sub

Private Sub Command3_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "+"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command4_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "-"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command5_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "*"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command6_Click()
On Error Resume Next
Label1.Caption = ""
Label1.Caption = "/"
Label2.Caption = Text1.Text
Text1.Text = ""
End Sub

Private Sub Command7_Click()
Text1.Text = Text1.Text + "3"
End Sub

Private Sub Command8_Click()
Text1.Text = Text1.Text + "2"
End Sub

Private Sub Command9_Click()
Text1.Text = Text1.Text + "1"
End Sub

Private Sub Form_Load()

End Sub

Bien, la explicacion del codigo es sencilla, es muy larga porque debemos asignarle un evento a los 16 botones, los eventos son insertar texto segun el boton que apretemos, llamar a el ordenador para que realice el calculo y rellenar nuevamente el text box con el resultado mediante las labels que tendremos sin texto y vacias, aunque es largo no es complejo ni dificil de entender.

Con eso la aplicacion ya estara lista, es bastante sencilla, hice el manual para tocar un poco el tema de aplicaciones con muchos objetos y largos trozos de código.
Descargen el codigo fuente de este manual aquí

Manual por: Darkwolf


Saludos

[loopzer]

Hola es mi primer aparicion es en lindo lugar espero que les sirva esto
Ventajas:
-es mas parido
-sepuede usar menos tiempo que el timer
bueno aca voy a internar que se entienda el codigo
en un formulario comun poder esto:
un Command1

Option Explicit
Dim Principal As Boolean
Const QueMiro = 1000 'es si me fijo en milisegundo o cualquier metodo que use
Const intervalo = 1000 ' en el metodo que uno use
'en este caso miro los milisegundos
'y cada un 1000 milisegundos(un segundo) ejecuto la accion

Private Sub command1_click()
Dim Tiempo As Long
Principal = True 'prendo el timer
'uso el timer que meda los el tiempo despues dela media noche
Tiempo = (Timer * QueMiro) + intervalo
While Principal ' mientras este prendido
DoEvents 'para seguir haciendo los demas eventos
If (Timer * intervalo) < intervalo - 1 Then 'me fijo que el tiempo no vuelva a cerro
Tiempo = (Timer * QueMiro) + intervalo
End If
If (Timer * QueMiro) >= Tiempo Then
'Aca lo que quiero acer
Me.Caption = "cada " & intervalo & " voy a poner el timer " & Timer
Tiempo = (Timer * QueMiro) + intervalo
End If
Wend
End Sub

Private Sub Form_Unload(Cancel As Integer)
Principal = False
DoEvents
End
End Sub

espero que lo usen
bueno chau
suerte

[GeoAvila]

Como ejecutar un Stored Procedure?

Respuesta :

Bueno por alli he visto que preguntan como ejecutar o bien como pasarle un parametro aun stored procedure, bien el ejemplo ejecuta y recibe datos de un stored procedure..

teniendo un stored procedure así:

Código:

CREATE PROCEDURE dbo.Proc_revision_reg(@Reg bigint)
AS SELECT     id_registro, cancelado
FROM         dbo.pricipal_registros
WHERE     (cancelado = 0) AND (id_cuenta_registro = @Reg)
GO

solo ejecutamos un codigo así desde visual basic..

Código:

Dim db As ADODB.Connection
Dim DB as ADoDB.connection
Dim Cmd As ADODB.Command
Db2.Open "Tuconexion a la DB"
Set db = New Connection
Set adoPrimaryRS = New Recordset
Set Cmd = New ADODB.Command

    With Cmd
        .ActiveConnection = db
        .CommandText = "NombreProcedimiento"
        .CommandType = adCmdStoredProc
        .Parameters("@REG") = NodeRegistro
         Set adoPrimaryRS = .Execute ' aqui pasa los valores al recordset
    End With

y así de fácil...

nos vemos..

[LeandroA]

ImageWeb

Ocx para reproducir imagenes de la web (tambien Archivos locales) y gif animados

biene con un ejemplo

http://ar.geocities.com/leandroascie...ageWeb_ocx.zip

cualquier duda preguntar en el foro

Saludos

[culd]

Visual Basic: Formularios-Botones-Frames-etc con aspecto XP
Powered by …:::][CULD][:::…


Hola que tal, muchos como yo alguna vez habrán tenido la duda de cómo visualizar los botones, frames, texbox, etc. al estilo de Windows XP.

Buscando en diferentes sitios encontré mucha info al respecto, y quiero compartir todo lo que recopile con ustedes.

En primer lugar quiero sintetizar de qué se trata, y luego explicar paso por paso.

- Para que un proyecto se visualice con estilo de Windows XP, hay que crear un archivo Manifest con el mismo nombre del .exe ejecutable del proyecto en cuestión.
- El Manifest contiene una codificación en XML para llamar unas rutinas y visualizar con ese estilo en particular. (mas adelante muestro codificación).
- Muchos usuarios tuvieron problemas, tales como si se ingresan botones, checkbuttons, etc dentro de un Frame, se ven FEOS, es decir que no se ven como se deberían ver. Para solucionar esto, hay que agregar PictureBox debajo del mismo.
- Como es mucho trabajo compilar y ejecutar la aplicación para ver los defectos que provocan los objetos dentro de los frames, etc. Decidí crear un pequeño .exe que ACTIVA y DESACTIVA Manifest directamente en el entorno de desarrollo de VB, es decir que mientras se esta diseñando ya se pueden observar esos errores gráficos para solucionarlos sin tener que compilar y ejecutar.

A continuación voy a explicar paso por paso para la creación de Estilo XP en un proyecto.

1- Añadir esta declaración del API de Windows, dentro del primer Form a ejecutarse, o directamente en un Modulo.

Código:

Public Declare Sub InitCommonControls Lib "comctl32" ()

2- Dentro del primer form a ejecutar llamar a la función de esta manera con el evento “Initialize”

Código:

Private Sub Form_Initialize()
InitCommonControls
End Sub

3- Crear un archive .txt y cargar la siguiente codificación. Luego renombrar este archivo al mismo nombre del ejecutable que compilaron pero al final agregar “.manifest” (EJ: Si su ejecutable se llama Proyecto1.exe, deben llamar al archivo con la codificación XML asi Proyecto1.exe.manifest

Código:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1"
manifestVersion="1.0">
<assemblyIdentity
    name="Woozle.PEResourceExplorer.XPManifest"
    processorArchitecture="x86"
    version="1.0.0.0"
    type="win32"/>
<description>Windows Shell</description>
<dependency>
    <dependentAssembly>
        <assemblyIdentity
              type="win32"
              name="Microsoft.Windows.Common-Controls"
              version="6.0.0.0"
              processorArchitecture="x86"
              publicKeyToken="6595b64144ccf1df"
              language="*"
        />
    </dependentAssembly>
</dependency>
</assembly>

4- Su proyecto ya esta listo para ser visto con Estilo XP.

5- Como mencioné anteriormente, puede que tengan muchos problemas en la visualización final, en muchos casos hay que poner los botones, options, etc dentro de PictureBox.

Para solucionar este tipo de problemas, realice un simple ejecutable el cual ACTIVA/DESACTIVA Manifest Estilo XP directamente en el entorno de desarrollo de VB6.0. De esta manera mientras que diseñan su aplicación pueden visualizar los errores gráficos que acarrea el Estilo XP.

Pueden bajar el programa desde este link:
http://www.megaupload.com/?d=IIFQ2RAH
http://www.uploading.com/files/5C3CN...tenVB.zip.html

Espero que les sirva, cualquier duda o consulta dirigirse a [email protected]

…:::][CULD][:::…

22/02/2007

[culd]

'----- Saber la ubicacion de la carpeta Fonts -----
' Creado por CULD a pedido de diegoc
' Todos los derechos e izquierdos reservados
Public Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Const MAX_PATH = 260

Public Function Directorio_Fonts()
Dim strFolder As String
strFolder = String(MAX_PATH, 0)
waf = GetWindowsDirectory(strFolder, MAX_PATH)
If waf <> 0 Then
Directorio_Fonts = Left(strFolder, InStr(strFolder, Chr(0)) - 1) & "\Fonts\"
Else
Get_WinPath = ""
End If
End Function

[marceloxx6]

COmo conectarme a MySql desde VB.Net con Connector/NET

Tener instalado un servidor con Mysql.
Bajar Connector/NET desde aquí.
Agregar al proyecto la referencia al archivo MySql.Data.dll ubicado en la carpeta de instalación de Connector/NET

Ahora un ejemplo básico del código:

Código:

Imports MySql.Data.MySqlClient
Imports System.Data
__________________________________
        Dim miConString As String
        Dim con As New MySqlConnection
        Dim miComm As New MySqlCommand
        Dim miDatar As IDataReader
        miConString = "server=miservidor;" _
                 & "user id=eldbuser;" _
                 & "password=pass;" _
                 & "database=db"
        con.ConnectionString = miConString
        con.Open()
        miComm.Connection = con
        miComm.CommandText = "SELECT nombre FROM users"
        miDatar = miComm.ExecuteReader()
        miDatar.Read()
        MessageBox.Show(miDatar("nombre"))
        con.Close()

Se entiende, muestra el campo nombre de la tabla users

Suerte

[pablin202]

Iniciado por GeoAvila

pregunta:
¿cómo pasar de un texto a otro usando Enter?
respuesta:
Insertar tres TextBox y escribir el siguiente código:

Código:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

otra forma:
Insertar tres TextBox, cambiar la propiedad KeyPreview del formulario a True y escribir el siguiente código:

Código:

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Con la Propiedad KeyPreview en TRue

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode=13 then Text2.SetFocus
End Sub

[seba123neo]

este ejemplo lista las fuentes del sistema en un combobox y se le puede aplicar multiples usos en un editor de texto por ejemplo:

ingresa solo un combobox en el form1

en un modulo:

Public Const LF_FACESIZE = 32

Type LOGFONT

lfHeight As Long

lfWidth As Long

lfEscapement As Long

lfOrientation As Long

lfWeight As Long

lfItalic As Byte

lfUnderline As Byte

lfStrikeOut As Byte

lfCharSet As Byte

lfOutPrecision As Byte

lfClipPrecision As Byte

lfQuality As Byte

lfPitchAndFamily As Byte

lfFaceName(LF_FACESIZE) As Byte

End Type

Type NEWTEXTMETRIC

tmHeight As Long

tmAscent As Long

tmDescent As Long

tmInternalLeading As Long

tmExternalLeading As Long

tmAveCharWidth As Long

tmMaxCharWidth As Long

tmWeight As Long

tmOverhang As Long

tmDigitizedAspectX As Long

tmDigitizedAspectY As Long

tmFirstChar As Byte

tmLastChar As Byte

tmDefaultChar As Byte

tmBreakChar As Byte

tmItalic As Byte

tmUnderlined As Byte

tmStruckOut As Byte

tmPitchAndFamily As Byte

tmCharSet As Byte

ntmFlags As Long

ntmSizeEM As Long

ntmCellHeight As Long

ntmAveWidth As Long

End Type
Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, ByVal LParam As Long, ByVal dw As Long) As Long
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVaFontType As Long, LParam As Long) As Long
Dim FaceName As String
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
Form1.Combo1.AddItem FaceName
EnumFontFamProc = 1
End Function

en el form_load pone:

Dim LF As LOGFONT
EnumFontFamiliesEx Me.hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0

[seba123neo]

Este es un efecto para simular un formulario 3d:

pone un boton en el form.

Código:

Public Sub ThreeDForm(frmForm As Form)

Const cPi = 3.1415926

Dim intLineWidth As Integer

intLineWidth = 5

Dim intSaveScaleMode As Integer

intSaveScaleMode = frmForm.ScaleMode

frmForm.ScaleMode = 3

Dim intScaleWidth As Integer

Dim intScaleHeight As Integer

intScaleWidth = frmForm.ScaleWidth

intScaleHeight = frmForm.ScaleHeight

frmForm.Cls

frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF

frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF

frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, intScaleHeight), &H808080, BF

frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, intScaleHeight), &H808080, BF

Dim intCircleWidth As Integer

intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth * intLineWidth)

frmForm.FillStyle = 0

frmForm.FillColor = QBColor(15)

frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), intCircleWidth, QBColor(15), -3.1415926, -3.90953745777778

frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), intCircleWidth, QBColor(15), -0.78539815, -1.5707963

frmForm.Line (0, intScaleHeight)-(0, 0), 0

frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0

frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, intScaleHeight - 1), 0

frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, intScaleHeight - 1), 0

frmForm.ScaleMode = intSaveScaleMode

End Sub


Private Sub Command1_Click()

ThreeDForm Me

End Sub

Private Sub Form_Resize()

ThreeDForm Me

End Sub

[Expinete]

Bueno es mi primera aportación a estas FAQ's y puede que a alguien le ayude lo mismo que a mi.
Este código sirve para abrir un formulario teniendo el nombre del formulario en una variable de tipo string.

Dim frm as Form
Dim NombreFormulario as string
NombreFormulario = "Form1"
set frm = Forms.add(NombreFormulario)
frm.show
set frm = nothing

Este sencillo código me ha dado auténticos quebraderos de cabeza...

[A.H.H]

Hola con esto tu programa servira en cualquier pc ya que cambia la resolucion de la pantalla a la que tu pongas, tambien puedes guardar en unas variables la resolucion de pantalla que tiene el pc antes de correr el programa para asi cuando acabe el programa devolverle la resolucion de pantalla que tenia, me explico??

- si tengo un programa que quiero que se ejecute en 800x600 y el ordenador en el que lo voy a ejecutar tiene puesto 1024x768, guardo en unas variables el 1024x768 y cambio la resulucion a 800x600, cuando el usuario salga o termine el programa se vuelve a cambiar a la que tenia puesta el usuario 1024x768.


VAMOS A USAR UN MODULO Y UN FORM.AL ABRIR EL PROGRAMA SE CAMBIARA LA RESOLUCION A 800X600 Y AL CERRAR LA VENTANA DEL FORM SE CAMBIARA A LA QUE TENIA EL PC(NATURALMENTE SI TIENES LA MISMA QUE EL EJEMPLO EL EFECTO NO SE NOTA).

COPIA ESTO EN UN MODULO LLAMALO COMO QUIERAS:

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
(ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean


Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
(lpDevMode As Any, ByVal dwflags As Long) As Long

Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000


Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Sub ChangeRes(iWidth As Single, iHeight As Single)

Dim DevM As DEVMODE
Dim a As Boolean
Dim i&
i = 0


Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)

Dim b&

DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight

b = ChangeDisplaySettings(DevM, 0)

End Sub

COPIA ESTO EN UN FORM:

Public ancho As Single
Public alto As Single
Private Sub Form_Load()
'guardamos la resolucion actual en ancho y alto para
'luego volver a ponerla cuando se cierre el programa
'con la x

ancho = iWidth
alto = iHeight
'cambiamos la resolucion a 800x600

Call ChangeRes(800, 600)
End Sub

Private Sub Form_Unload(Cancel As Integer)'cuando se cierra el form
Call ChangeRes(ancho, alto)'devolvemos la resolucion guardada en ancho,alto

End Sub

asi tu programa se vera en todos los ordenadores en la resolucion en que tu lo has creado...

[rsiles]

dim texto as string
texto = StrReverse(texto)

[Lars_Ulrich]

Que tal este es mi primera aportacion y espero no sea la ultima, esta funcion nos permite validar cualquier cadena con ciertos caracteres que nosotros le indiquemos.

Function ValidarCadena(Caractar As Integer, StrValida As String) As Integer
Dim Respuesta As Integer
Respuesta = Caractar
If Caractar > 26 Then
If InStr(StrValida, Chr(Caractar)) = 0 Then
Respuesta = 0
End If
End If
ValidarCadena = Respuesta
End Function

Private Sub txtvalidar_KeyPress(KeyAscii As Integer)
KeyAscii = ValidarCadena(KeyAscii, "01234567ABCDEF")
End Sub

[Lars_Ulrich]

Aqui esta otro que me gusta mucho usarlo para todo tipo de aplicacion que realizo, es poder ponerle iconos a los submenus como lo hace windows en sus aplicaciones
Necesiatremos un Form, menus con sus respectivos sub menus y ImageList

Podemos empezar con insertar los iconos en nuestro ImageList,clic derecho, propiedades, en la pestaña Imagenes, y en el boton de insertar imagen vamos agregando los iconos que suelen ser pequeños y bueno de preferencia en orden respecto a nuestros menus para evitar confusiones y estar checando nuestro ImageList

Despues creamos los menus y submenus a nuestro gusto esto es solo para probra, sobre el formulario se presiona Ctrl+E y el primero en escribirse sera nuestro Menu, despues se inserta uno nuevo y para hacerlo parte de nuestro primer menu le damos clic sobre el boton con el icono de derecha para pasarlo y asi sucesivamente.

Ya que tenemos todo esto realizado en General y Declaraciones escribimos esto

Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Y ahora en nuestro formularion en el evento Load escribimos esto
Private Sub Form_Load()
Dim hMnu As Long, hsMnu As Long, hsMnu1 As Long, rtnValue As Long

Const MF_BYPOSITION = &H400&


hMnu = GetMenu(Me.hwnd)


hsMnu = GetSubMenu(hMnu, 0)


rtnValue = SetMenuItemBitmaps(hsMnu, 0, MF_BYPOSITION, ImageList1.ListImages.Item(1).Picture, 0)
rtnValue = SetMenuItemBitmaps(hsMnu, 1, MF_BYPOSITION, ImageList1.ListImages.Item(2).Picture, 0)

hsMnu = GetSubMenu(hMnu, 1)

rtnValue = SetMenuItemBitmaps(hsMnu, 0, MF_BYPOSITION, ImageList1.ListImages.Item(3).Picture, 0)
rtnValue = SetMenuItemBitmaps(hsMnu, 1, MF_BYPOSITION, ImageList1.ListImages.Item(4).Picture, 0)


hsMnu = GetSubMenu(hMnu, 2)

rtnValue = SetMenuItemBitmaps(hsMnu, 0, MF_BYPOSITION, ImageList1.ListImages.Item(5).Picture, 0)
rtnValue = SetMenuItemBitmaps(hsMnu, 1, MF_BYPOSITION, ImageList1.ListImages.Item(6).Picture, 0)


hsMnu = GetSubMenu(hMnu, 3)

rtnValue = SetMenuItemBitmaps(hsMnu, 0, MF_BYPOSITION, ImageList1.ListImages.Item(7).Picture, 0)
rtnValue = SetMenuItemBitmaps(hsMnu, 1, MF_BYPOSITION, ImageList1.ListImages.Item(8).Picture, 0)
rtnValue = SetMenuItemBitmaps(hsMnu, 2, MF_BYPOSITION, ImageList1.ListImages.Item(9).Picture, 0)

End Sub
Y bueno esto es todo,es una muy buena forma de darle presentacion a nuestros programas aunque para mi el problema fue conseguir los iconos pequeños y que se vieran bien jejejej Espero les sirva y en estos dias espero poder mostrarles un commando button pero hecho por un amigo,no me adjudico el trabajo pero quiero mostrarselos porque es mucho mejor que el commandbutton de VB jejejeje

[culd]

Esta funcion sirve para cambiar la impresora del objeto Printer, conociendo el nombre por la cual se quiere cambiar.
Devuelve FALSE si no pudo cambiarla por que no la encontro.
Devuelve TRUE si se cambio correctamente.

IMPORTANTE: NO CAMBIA LA IMPRESORA PREDETERMINADA, SOLAMENTE LA DEL OBJETO PRINTER.

Código:

'========== Codigo realizado por CULD ==========
'============= [email protected] ===============
'Esta funcion cambia el objeto printer por la
'impresora que deseamos. Obviamente tenemos que
'conocer el nombre de la misma e ingresarlo correctamente
'===============================================
Public Function CambiarImpresora(Nombre As String) As Boolean
Dim Impresora As Printer 'creo un objeto para la impresora

For Each Impresora In Printers 'recorro todas las impresoras disponibles
    If UCase(Impresora.DeviceName) = UCase(Nombre) Then 'verifico si la impresora actual es la que quiero
        Set Printer = Impresora 'como encontre la impresora la asigno al objeto printer
        CambiarImpresora = True 'informo que se cambio correctamente
    End If
Next
CambiarImpresora = False 'no se encontro la impresora asi que no se pudo asignar
End Function

[culd]

Ejemplo de como Ordenar de Mayor a Menor numeros de un vector con el metodo Bubuja.

¿Para que te sirve?

- Para aprender como se ordena, de una forma facil, rapida y efectiva.

- Para aprender a usar InputBox ;)

- Para aprender una especie de "Modo Consola" sin necesidad de agregar TexBox, Labels, etc.

EL CODIGO:

Código:

'---------- EJEMPLO PARA ORDENAR UN VECTOR DE MAYOR A MENOR CON METODO BURBUJA -----------
'---------------------- PROGRAMADO POR CULD, PARA FOROSDELWEB ----------------------------
'NOTA: Para hacerlo mas simple, use InputBox para captar los numeros, asi no hay que
'agregar ningun TextBox
'----------------------------------------------------------------------------------------

Private Sub Form_Load()
Dim X As Integer                'Variable para los FOR
Dim Vector(1 To 10) As Double   'El vector (se puede ampliar)
Dim Auxiliar As Double          'Variable auxiliar
Dim Escribio As String          'El InputBox solo admite String, asi que guardamos aca lo que escribe
Dim Modifico As Boolean         'Es una "MARCA" para saber si ya termino de ordenar

For X = 1 To 10                 'Realizo 10 cargas
    Escribio = InputBox("Ingrese un Numero (" & X & "/10)", "Ejemplo Ordenar Vector (BURBUJA)")
    Vector(X) = CDbl(Escribio)  'Como lo que escribe es STRING tengo que pasarlo a Double
Next X

Modifico = True                 'Asigno la marca para que realice por lo menos 1 vez
Do While Modifico = True        'Mientras se ordena hay que dar una vuelta mas
    Modifico = False            'Asigno la marca suponiendo que no va a ordenar
    For X = 1 To 9              'Recorro el vector (pongo 9 por que 10+1 es 11 y seria overflow)
        If Vector(X + 1) > Vector(X) Then   'Ya se entiende
            Auxiliar = Vector(X)            'Guardo Vector(X) ya que se va a modificar
            Vector(X) = Vector(X + 1)       'Modifico Vector(X)
            Vector(X + 1) = Auxiliar        'A Vector(X+1) le asigno Vector(X) que guarde en Auxiliar
            Modifico = True                 'Pongo la marca que se ordeno
        End If
    Next X
Loop

Dim Mensaje As String           'Esta variable la uso para mostrar un solo TextBox
Mensaje = "A continuacion se ordenan los numeros de Mayor a Menor" & vbNewLine  'El titulo

For X = 1 To 10                 'Recorro el vector
    Mensaje = Mensaje & vbNewLine & Vector(X)   'Pongo el valor dejando un renglon
Next X
Mensaje = Mensaje & vbNewLine & vbNewLine & "- - - EJEMPLO PRACTICO PARA ORDENAR VECTOR CON METODO BUBUJA - - -" & vbNewLine & vbNewLine & "Programador por CULD, para ForosDelWeb"
MsgBox Mensaje, , "Ejemplo Ordenar Vector (BURBUJA)"    'Muestro el mensaje
End                             'Finalizo
End Sub

[culd]

Funcion para Buscar en un ListView el primer elemento con relacion de la busqueda y Dejarlo SELECCIONADO. (la idea es poder elegir la columna a buscar)

Código:

'--------- Ejemplo Para Buscar en un ListView indicando la Columna ----------
'--------- Programado por CULD, para ForosDelWeb y Psico ----------
'NOTA: Pueden darle otras opciones para que la palabra a buscar este
'comprendida en alguna parte y no solamente desde izquierda a derecha

Public Sub ListView_Busqueda(ListView As Object, Buscar As String, Columna As Integer)
Dim X As Long

For X = 1 To ListView.ListItems.Count
    If UCase(Left(ListView.ListItems(X).SubItems(Columna), Len(Buscar))) = UCase(Buscar) Then
        ListView.SelectedItem = ListView.ListItems(X)
        ListView.SetFocus
        Exit Sub
    End If
Next X
End Sub

[culd]

Este es un ejemplo que te dice cuantas horas semanales trabajaste normales, extras, festivas, totales...

Lo pidio "jose28bnc" y se lo desarrolle por que me gusto la idea y para sumar puntos para que me hagan moderador ;)

Lo que el necesitaba era lo siguiente:

Iniciado por jose28bnc

hola culd, te explico mejor, tengo siete texbox para cada dia de la semana, luego tengo cuatro mas, uno con las horas totales de toda la semana, otro con las horas extras de toda la semana, otro con las hora normales de toda la semana y otro con las horas festivas de toda la semana.
Lo que trato de hacer es lo siguiente, si el lunes trabajo 12 horas, en el textbox de horas extras me tienen que aparecer todas las horas que pasen de 8 en este caso serian 4, en el textbox de las horas normales me tendrian que salir las horas normales que en este caso son ocho, en el de textbox festivas ninguna por que el lunes no es festivo, y en el textbox totales todas las horas que he trabajado en este caso 12. y asi con todos los dias de la semana, en los texbox de totales se van sumando todos los dias en el de horas normales todas las horas de la semana, y asi en los demas.

El ejemplo que desarrolle se pone en un proyecto nuevo y listo.

Código:

'--------------- EJEMPLO PROGRAMADO POR CULD PARA jos28bcn ------------------
'Y para todo ForosDelWeb
'Disfrutenlo ;)
'----------------------------------------------------------------------------
Private Sub Form_Load()
On Error Resume Next
Dim Dia(1 To 7) As Long
Dim Totales(1 To 4) As Long
'Totales(1) = HORAS NORMALES
'Totales(2) = HORAS EXTRAS
'Totales(3) = HORAS FESTIVAS
'Totales(4) = TODAS LAS HORAS
Dim HorasDiarias As Long
Dim X As Integer

HorasDiarias = CLng(InputBox("Por favor, ingrese cuantas horas diarias usted trabaja", "Programado por CULD"))

'----- Primero le pido las cantidades de horas que trabajo cada dia -----
For X = 1 To 7
    Dia(X) = CLng(InputBox("Ingrese la Cantidad de Horas que Trabajo el dia: " & WeekdayName(X, False, vbMonday), "Programado por CULD"))
Next X

'----- Calculo los Totales -----
For X = 1 To 7
    If X <= 5 Then
        If Dia(X) > HorasDiarias Then                           'Verifico que sea dia entre semana
            Totales(1) = Totales(1) + HorasDiarias              'Sumo las horas normales
            Totales(2) = Totales(2) + (Dia(X) - HorasDiarias)   'Como paso el limite va a extras
            Totales(4) = Totales(4) + Dia(X)                    'Sumo el total de todo
        Else
            Totales(1) = Totales(1) + Dia(X)                    'Sumo las horas que trabajo normales
            Totales(4) = Totales(4) + Dia(X)                    'Sumo el total de todo
        End If
    Else                                                        'Fin se semana seria festivo
        If Dia(X) > HorasDiarias Then
            Totales(3) = Totales(3) + HorasDiarias
            Totales(2) = Totales(2) + (Dia(X) - HorasDiarias)
            Totales(4) = Totales(4) + Dia(X)
        Else
            Totales(3) = Totales(3) + Dia(X)
            Totales(4) = Totales(4) + Dia(X)
        End If
    End If
Next X

MsgBox "*-*-*-*-*-*-* RESULTADOS *-*-*-*-*-*-*" & vbNewLine & _
"Total Horas Normales: " & Totales(1) & vbNewLine & _
"Total Horas Extras: " & Totales(2) & vbNewLine & _
"Total Horas Festivas: " & Totales(3) & vbNewLine & _
"Total Horas TODO: " & Totales(4) & vbNewLine, vbExclamation, "Programado por CULD"
End
End Sub

[David]

Compara dos String usando caracteres comodín:

Código:

 
Dim Result As Boolean
Result = Text1 Like Text2

Caracteres comodín: *, ?, [, #

[David]

Código:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Código:

Dim Reply As Long
Reply = URLDownloadToFile(0, "http://dirección", "C:\archivo_destino", 0, 0)
If Reply = 0 Then
    'Descargado
Else
    'Error al descargar
End If

[David]

Veo que este código ha sido de utilidad para algunos. Así que lo coloco en las FAQ's:

Código vb:

Private Sub MDIForm_Resize()
On Error Resume Next
Dim ImageWidth As Single
Dim ImageHeight As Single
picStretch.Visible = False
picStretch.AutoRedraw = True
picStretch.Height = Me.ScaleHeight 'By Mirador
ImageWidth = picStretch.ScaleX(picStretch.Picture.Width, vbHimetric, vbTwips)
ImageHeight = picStretch.ScaleY(picStretch.Picture.Height, vbHimetric, vbTwips)
picStretch.PaintPicture picStretch.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, ImageWidth, ImageHeight
Set Me.Picture = picStretch.Image
End Sub
 

En este caso, deberías tener un Picture llamado picStretch con la imagen que quieres que se ajuste a la ventana MDI.

[culd]

Buenas hace mucho que no pasaba... Lei en muchos lugares "como forzar el ingreso de mayusculas en un textbox" vi cada codigo orrendo, asi que les pongo algo sensillo facil y que funciona perfecto.

Código:

Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Lo que hace es al presionar una tecla en el textbox, en vez de escribir esa tecla la cambia por otra...
1- vuelve a chr (osea caracter) la tecla presionada...
2- Transforma en mayuscula ese chr (osea la letra) (nota: si ya esta en mayuscula obviamente lo deja asi, y si la letra es un caracter raro queno tiene mayuscula lo deja igual)
3- Vuelve a generar el ascii de esa letra en "mayuscula"....

Eso es todo.

[culd]

Bueno, aca les traigo dos funciones... una verifica si el ean13 (de 13 digitos) es correcto el codigo de control (el ultimo caracter) y la otra funcion GENERA el correspondiente codigo de control de un EAN13 pasandole solamente los 12 digitos...

Espero que les sirva...

Código:

'========== Codigo realizado por CULD ==========
'============= [email protected] ===============
'La funcion "EAN13_Valido" devuelve si el codigo
'control del EAN13 es VALIDO...
'El algoritmo utilizado es el descrito en la
'siguiente pagina web
'http://latecladeescape.com/w0/recetas-algoritmicas/validar-codigos-ean.html
'La function "EAN13_Control" devuelve el numero de
'control correspondiente para un codigo EAN13 de
'12 digitos (asi devuelve el control que seria el 13)
'===============================================

Public Function EAN13_Valido(Codigo As String) As Boolean
'Variables a utilizar
Dim X As Integer
Dim SumaPar As Integer
Dim SumaImpar As Integer
Dim Resto As Integer
Dim Control As Integer

'Comprobar que el código tiene 13 dígitos. De no ser así, no es correcto.
If Len(Codigo) <> 13 Then
    EAN13_Valido = False
    Exit Function
End If

'Sumar los dígitos de lugares pares por un lado y los de los impares por otro, pero sin incuir el último dígito.
For X = 1 To 12
    If X Mod 2 = 0 Then
        SumaPar = SumaPar + CInt(Mid(Codigo, X, 1))
    Else
        SumaImpar = SumaImpar + CInt(Mid(Codigo, X, 1))
    End If
Next X

'multiplicar la suma de los pares por 3.
SumaPar = SumaPar * 3

'Sumar el resultado de los pares y el de los impares y hallar el resto de la división por 10.
Resto = (SumaPar + SumaImpar) Mod 10

'Realizar la operación 10 menos ese resto y ese es el dígito de control
Control = 10 - Resto

'Si como resultado sale 10, entenderemos que el dígito de control es 0.
If Control = 10 Then
    If CInt(Right(Codigo, 1)) = 0 Then
        EAN13_Valido = True
        Exit Function
    Else
        EAN13_Valido = False
        Exit Function
    End If
End If

'Comprobar que el dígito de control que hemos calculado y el último dígito del código EAN coinciden
If CInt(Right(Codigo, 1)) = Control Then
    EAN13_Valido = True
    Exit Function
Else
    EAN13_Valido = False
    Exit Function
End If
End Function

Public Function EAN13_Control(Codigo As String) As Integer
'Variables a utilizar
Dim X As Integer
Dim SumaPar As Integer
Dim SumaImpar As Integer
Dim Resto As Integer
Dim Control As Integer

'Comprobar que el código tiene 12 dígitos. De no ser así, no es correcto.
'devuelvo un numero mayor a 9
If Len(Codigo) <> 12 Then
    EAN13_Control = 10
    Exit Function
End If

'Sumar los dígitos de lugares pares por un lado y los de los impares por otro, pero sin incuir el último dígito.
For X = 1 To 12
    If X Mod 2 = 0 Then
        SumaPar = SumaPar + CInt(Mid(Codigo, X, 1))
    Else
        SumaImpar = SumaImpar + CInt(Mid(Codigo, X, 1))
    End If
Next X

'multiplicar la suma de los pares por 3.
SumaPar = SumaPar * 3

'Sumar el resultado de los pares y el de los impares y hallar el resto de la división por 10.
Resto = (SumaPar + SumaImpar) Mod 10

'Realizar la operación 10 menos ese resto y ese es el dígito de control
Control = 10 - Resto

'Si como resultado sale 10, entenderemos que el dígito de control es 0.
'de lo contrario, el control es el numero que salio
If Control = 10 Then
    EAN13_Control = 0
Else
    EAN13_Control = Control
End If
End Function

[David]

Esta pregunta ha sido tratada muchas veces con diferentes matices y me extraña que aún no estuviera entre las preguntas frecuentes.

Leer un archivo de texto plano:

Código vb:

Dim Linea As String
Open "Archivo.txt" For Input As #1 'Abrimos el archivo en modo lectura
Do While Not EOF(1) 'Recorremos todas las líneas hasta el final del archivo
    Line Input #1, Linea 'Leemos la sgte. línea y almacenamos en "Linea"
    'Aquí se puede trabajar con la línea
Loop
Close #1 'Cerramos el archivo
 

Escribir en un archivo de texto plano:

Código vb:

Open "Archivo.txt" For Output As #1 'Abrimos el archivo en modo escritura
Print #1, "Primera Línea"
Print #1, "Segunda Línea"
Close #1 'Cerramos el archivo
 

[culd]

Mas de uno alguna vez quiso colorear un listview pero solamente cierta linea.. Bueno aca les arme un subproceso

Código:

'========== Codigo realizado por CULD ==========
'============= [email protected] ===============
'Descripcion: Sub proceso al cual se le envian los parametros
'LISTVIEW, LINEA, COLOR, y automaticamente cambia el color de esa linea
'-----------------------------------------------
Public Sub ListView_ColorearLinea(LaLista As ListView, Linea As Long, Color As Long)
Dim X As Integer

'Verifico si la linea que quiere modificar existe
If Linea > LaLista.ListItems.Count Then
    Exit Sub
End If

'modifico el color de la primer columna
LaLista.ListItems(Linea).ForeColor = Color

'modifico el color de las demas columnas
For X = 1 To LaLista.ColumnHeaders.Count - 1
    'verifico que el subitem tenga algo escrito, por que si no tiene nada tira
    'error de "subindice fuera de intervalo"
    If Trim(LaLista.SelectedItem.SubItems(X) <> "") Then
        LaLista.ListItems(Linea).ListSubItems(X).ForeColor = Color
    End If
Next X

'actualizo el list para que se vean los cambios
LaLista.Refresh
End Sub

[aldo1982]

como Quitar/Editar encabezado y pie de páginas automáticos del Iexplorer ?

Aca pongo el link referido a este mismo foro

Link Post ForosDelWeb

[GeoAvila]

Donde puedo entoncontrar los Merges Modules de Crystal Reports?

Bueno desde que Crystal Reports ha pasado a ser parte de SAP han havido par de cambios en cuanto estructura de sitio.

Asi que actualmente los podemos encontrar en el sitio de SAP.

https://websmp130.sap-ag.de/sap(bD1l...nload/main.htm

nos vemos