FAQ's de VB6

[GeoAvila]

! Importante

Las FAQ (Frequentely Asked Questions) están abiertas a que cualquier usuario haga sus aportaciones y tenga deseo de hacerla.
Si embargo les pido que tengan algunas consideraciones especiales a la hora de colocar su aportación:

• Asegúrate de que la FAQ que vas a aportar pertenece a este foro (VB).
• Por favor al muy importante, no colocar preguntas en las FAQ's, si bien aqui se responden prengutas, son a las preguntas mas frecuentes.
• Asegúrate de que tu aportación no ha sido yá insertada. Si ha sido aportada pero ofreces una forma diferente de hacer lo mismo, bienvenida sea. Pero no si vas a proponer una solución que yá esté en las FAQ. Las FAQ duplicadas también serán eliminadas.
• Indica el número de FAQ y sobre qué trata
• Si tienes alguna duda sobre alguna FAQ plantéala en un nuevo tema indicando el número de FAQ {que se encuentra en la parte superior derecha de cada mensaje}. Este tema no es para plantear preguntas. cualquier mensaje en este tema que no sea una FAQ será eliminado sin previo aviso.

Este Sub-Foro es para los usuarios de VB Usemoslo y Cuidemoslo.

Antes de preguntar leamos que nos ayuda a como formular preguntas en este foro.
http://www.forosdelweb.com/faq.php?faq=como_preguntar

Vamos a empezar creando las las FAQ's para nuestro VB. aqui van..

[GeoAvila]

Prengunta:
¿Cómo ejecutar una sola vez un programa?
Respuesta:

Incluir este código en

Código:

Private Sub Form_Load()
Dim Ya_Existe As Integer
Ya_Existe = App.PrevInstance
If Ya_Existe <> 0 Then
MsgBox "El Programa ya se esta ejecutando", 0 + 48, "News"
End
End If
End Sub 

[GeoAvila]

Pregunta:
¿Cómo usar el Random?
Respuesta:

Código:

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

[GeoAvila]

Prengunta:
¿Como saber desde que directorio se ejecuta mi aplicación?
respuesta:

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
   

[hmtech]

hola

muy buena idea la de GeoAvila

Pregunta:

como hacer un inputbox que solo permita numeros?

Respuesta:

Dim Numero As String
Do Numero = InputBox("Introduzca un numero:")
Loop Until IsNumeric(Numero)
MsgBox "El numero es el " & Numero
Unload Me

[hmtech]

Pregunta:

Como verificar si un fichero existe?

Resuesta:

Public Sub VerificarFichero(sNombreFichero As String)
On Error Resume Next
Open sNombreFichero For Input As #1
If Err Then
MsgBox ("El fichero " & sNombreFichero & " no existe.")
Exit Sub
End If
Close #1
End Sub


en un botton:

VerificarFichero "c:\prueba.txt"


Version corregida por David el Grande y GeoAvila:

Código:

Dim Archivo As String
Archivo = "C:\MiTexto.txt"
If Dir(Archivo, vbArchive) = "" Then
MsgBox "El Fichero No Existe"
End If

Modificado por RootK

[GeoAvila]

pregunta:
¿Como ingresar solo numeros en un campo de texto?

respuesta:

Código:

	If ((KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii < 44 Or KeyAscii > 44)) Then
		 If (KeyAscii <> 8) Then KeyAscii = 0
	 End If

[GeoAvila]

pregunta:
¿cómo le puesdo dar vuelta a un texto?
respuesta:

Vamos a imaginar que por el motivo que sea deseamos invertir el orden de los caracteres de un texto. Imaginemos que el texto lo tenemos en una variable llamada Texto y almacenamos el contenido de la caneda texto al inverso en la variable Otxet. Por ejemplo: si tenemos el texto Casa obtendremos asaC.

Para ello deberíamos escribir el siguiente código:

Código:

 
For Contador = Len(Texto) To 1 Step -1 

Otxet = Otxet & Mid (Texto, Contador, 1) 
Next Contador 

[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

[GeoAvila]

pregunta:
¿Cómo Usar IF THEN ELSE ENDIF en una misma línea?
respuesta:
Insertar un CommandButton y un TextBox y escribir el siguiente código:

Código:

 
Private Sub Command1_Click()
Dim I As Integer
Dim A As String
I = 3
A = IIf(I <> 1, "True", "False")
Text1.Text = A
End Sub

Una variante del mismo codigo aportada por David el Grande.

Código:

 
 Insertar un CommandButton y un TextBox y escribir el siguiente código:
 Private Sub Command1_Click()
 Dim I As Integer
 Dim A As String
 I = 3
If I <> 1 Then A = "True" Else A = "False"
 Text1.Text = A
 End Sub

[GeoAvila]

pregunta:
¿cómo Convertir un texto a mayúsculas o minúsculas?
respuesta:

Código:

 Crear un formulario y situar un TextBox. Escribir:
Private Sub Text1_Change()
Dim I As Integer
Text1.Text = UCase(Text1.Text)
I = Len(Text1.Text)
Text1.SelStart = I
End Sub

[GeoAvila]

pregunta:
¿cómo Apagar el equipo, reiniciar Windows, reiniciar el Sistema?
respuesta:
Añadir tres botones a un formulario y escribir lo siguiente en el código del formulario:

Código:

 Private Declare Function ExitWindowsEx& Lib "user32" (ByVal
uFlags&, ByVal dwReserved&)
Private Sub Command1_Click()
Dim i as integer
i = ExitWindowsEx(1, 0&) 'Apaga el equipo
End Sub
Private Sub Command2_Click()
Dim i as integer
i = ExitWindowsEx(0, 0&) 'Reinicia Windows con nuevo usuario
End Sub
Private Sub Command3_Click()
Dim i as integer
i = ExitWindowsEx(2, 0&) 'Reinicia el Sistema
End Sub

[GeoAvila]

pregunta:
¿cómo Leer y escribir un fichero Ini?
respuesta:

Declaraciones generales en un módulo:

Código:

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As _
String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As _
Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Leer en "Ejemplo.Ini":
Private Sub Form_Load()
	Dim I As Integer
	Dim Est As String
	Est = String$(50, " ")
	I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
	If I > 0 Then
		MsgBox "Tu Nombre es: " & Est
	End If
End Sub
'Escribir en "Prueba.Ini":
Private Sub Form_Unload(Cancel As Integer)
	Dim I As Integer
	Dim Est As String
	Est = "Ejemplo - Apartado"
	I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub
'Leer en "Ejemplo.Ini":
Private Sub Form_Load()
	Dim I As Integer
	Dim Est As String
	Est = String$(50, " ")
	I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
	If I > 0 Then
		MsgBox "Tu Nombre es: " & Est
	End If
End Sub
'Escribir en "Prueba.Ini":
Private Sub Form_Unload(Cancel As Integer)
	Dim I As Integer
	Dim Est As String
	Est = "Ejemplo - Apartado"
	I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub

(Nota: si I=0 quiere decir que no existe información en la línea de fichero Ini a la
que hacemos referencia. El fichero "Ejemplo.Ini" se creará automáticamente).

[GeoAvila]

pregunta:
¿como Hacer sonar un fichero Wav o Midi?
respuesta:
Insertar el siguiente código en un módulo:

Código:

 Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Insertar un botón en el formulario y escribir el siguiente código:
Private Sub Command1_Click()
	iResult = mciExecute("Play c:\windows\ringin.wav")
End Sub

[GeoAvila]

Seleccionar todo un procedimiento
Para seleccionar un procedimiento completo (ya sea para borrarlo o para copiarlo a otro formulario) abrimos la pantalla de edición correspondiente y luego hacemos un doble clic en la parte izquierda de la misma (donde el cursor cambia a una flecha apuntando hacia la derecha).



Cambiar rápidamente la propiedad Enabled
La propiedad Enabled de un objeto se puede alternar fácilmente con una única línea de código:
optAlternar.Enabled = NOT optAlternar.Enabled
Este código es independiente de la definición de True y False, la cual varía según la versión de VB utilizada. Ya sea que se represente numéricamente (-1 = True; 0 = False) o lógicamente, la operación NOT se adapta para dar el resultado correcto.



Date y Date$ no son equivalentes
La función Date$ devuelve la fecha del sistema en un string con el formato MM-DD-AAAA. Date devuelve un variant con el formato de fecha especificado en el Panel de Control (puede devolver, por ejemplo, DD-MM-AA). Si queremos realizar cálculos con fechas, debemos utilizar Date$. Para mostrar la fecha actual al usuario, basta con usar Date (sin el símbolo $).



"Couldn't find installable ISAM"
En una aplicación que accede a bases de datos, este error indica que VB no encuentra información sobre los archivos de acceso a bases de datos. Debemos crear un archivo en la carpeta de Windows con esa información: copiar el archivo Vb.INI a dicha subcarpeta, con el nombre de la aplicación ejecutable y la extensión INI (por ejemplo, Agenda.INI).



Evitar la carga de complementos
Al cargar VB 4 o 5, cualquier complemento (Add-In) activo también se ejecuta. Si hay un error en algún complemento, puede ocurrir un GPF (falla de protección general). Para evitar esto, apagar los complementos antes de cargar VB, editando el archivo VBAddin.INI (en la carpeta de Windows), poniendo un 0 al lado de cada complemento. Por ejemplo: AppWizard.Wizard=0.



Pasar cadenas de caracteres a una DLL
VB presenta un problema a la hora de recibir cadenas de caracteres grandes de una DLL. Se produce una sobrecarga que demora el procesamiento, aun cuando ningún resultado es devuelto. Por esta razón, en programas de tiempo crítico es necesario salvar este inconveniente pasando cadenas inicializadas con la longitud exacta que se espera recibir.



Descargar formularios poco utilizados
Hay que tener en cuenta que, aunque estén ocultos, los formularios ocupan un espacio de memoria. Tener en memoria un formulario con muchos controles que se usará una sola vez no resulta una muy buena idea, o sea que no es conveniente ocultarlo. En tal caso, conviene descargarlo después de usado.



Evitar el uso de las propiedades por defecto
Si bien las propiedades por defecto muchas veces nos ahorran tipear unos cuantos caracteres demás, no siempre es bueno confiar en ellas. Por ejemplo, algunas propiedades por defecto cambiaron de Visual Basic 3 a la versión 4, causando "cuelgues" inexplicables. Aunque es un poco más trabajoso, conviene utilizar todas las propiedades explícitamente.



Comentar e indentar el código
Realizar comentarios acerca de cómo funciona una rutina, e indentar el código de la misma para que sea más fácil de leer, son dos acciones que debemos realizar siempre al programar. Un simple renglón aclaratorio puede ahorrar horas de prueba y error el día de mañana. Indentar significa poner cada ciclo repetitivo hacia la derecha, para lo cual basta una presión de la tecla [TAB].



Grabar antes de ejecutar
Es una buena costumbre de programación el grabar los programas antes de ejecutarlos. Esto es especialmente recomendado en el caso de usar alguna función API, puesto que una mala definición de la misma, o el paso incorrecto de algún argumento, pueden causar un GPF (Error de protección general) en Visual Basic, e incluso en el mismo Windows.



Seleccionar varios controles
Para setear un grupo de propiedades en varios controles, podemos acelerar el trabajo seleccionándolos a todos y seteando las propiedades una sola vez. Para ello se "dibuja" un rectángulo que contenga a todos los controles a seleccionar. Automáticamente, VB mostrará en la ventana de propiedades sólo las que son comunes a todos los controles seleccionados, pudiendo setearlas en conjunto.



Borrar las variables objeto
Al terminar de usar una variable que contiene un objeto (por ejemplo, una variable definida As Database) conviene setear su valor a Nothing. Esto libera la memoria ocupada por dicha variable, lo que no siempre ocurre al cerrar el objeto. Por ejemplo:
Dim DB As Database
' Abro la base
Set DB = OpenDatabase ("C:\VB\BIBLIO.MDB")
...
' Cierro
DB.Close
' Libero la memoria
Set DB = Nothing





Evitar el "beep" del [ENTER]
Muchas veces, cuando se ingresa información en una caja de texto y se presiona la tecla [ENTER], se escucha un "beep". Para evitar esto, colocar el código siguiente en el evento KeyPress de la caja de texto:
If KeyAscii = Asc(vbCR) Then

KeyAscii = 0
End If



TextBox de sólo lectura
Para hacer que un TextBox sea de sólo lectura, podemos setear su propiedad locked a True.

Error al utilizar SetFocus
Si utilizamos el método SetFocus sobre un control o formulario que no está visible o habilitado (propiedad Enabled), Visual Basic puede llegar a colgar nuestra aplicación, si es que no se utiliza control de errores. Antes de usar este método, hay que asegurarse que el control esté visible y habilitado.



La excepción que confirma la regla
Si bien el truco del SetFocus funciona casi siempre, hay una excepción muy importante, constituida por los métodos gráficos (Print, Line, Circle y PSet). Al llamar a estos métodos no puede usarse la estructura With ... End With, debiéndose anteponer el objeto a dichos métodos, aun dentro de dicha estructura. Un ejemplo sería:
With Picture

.Move 0, 0

Picture.Print "Hola, Mundo!"
End UIT



Evitar cadenas nulas en campos de Access
Si se utiliza una base de datos de Access, los campos alfanuméricos contienen valor NULL hasta tanto se les asigne algún valor (aunque sea una cadena vacía). Si se lee un campo con valor NULL de un RecordSet, asignando su valor a una variable de tipo cadena, se produce un error de ejecución. Para evitar esto, se concatena una cadena vacía a cada campo en cuanto se lo lee.



Usar Sleep en lugar de DoEvents
En un programa que se ejecuta en Windows 95 o Windows NT, es conveniente usar la función API Sleep. DoEvents pierde parte de su tiempo procesando mensajes del mismo proceso, lo que en un entorno multitarea es innecesario. La declaración de la función es:
Public Declare Sub Sleep Lib "KERNEL32" Alias Sleep (ByVal Milisegundos As Long)
Y se usa de la siguiente manera:
Sleep 0&



Error al cambiar el tamaño de los formularios
Si intentamos cambiar el tamaño de un formulario mientras está minimizado, obtendremos un error. Para evitar esto, ay que chequear antes todo el estado del formulario. Esto se logra con el siguiente fragmento de código:

If Me.WindowState <> 1 Then




' NO estoy minimizado
' El código para mover o cambiar el tamaño del formulario va aqui.
End If





No genera eventos al mostrar un MessageBox

Mientras un programa se encuentra mostrando un cuadro de mensaje en la pantalla (generado con la instrucción MsgBox) no admite que se produzca ningún evento. Esto es para prevenir la ejecución de código que podría causar problemas, ya que un mensaje de este tipo sólo debería aparecer en contadas ocasiones.



Cantidad de Bytes que Ocupa un Directorio

Sub Form_Load()

Dim FileName As String

Dim FileSize As Currency

Dim Directory As String

Directory = "c:\windows\"

FileName = Dir$(Directory & "*.*")

FileSize = 0



Do While FileName <> ""

FileSize = FileSize + FileLen(Directory & FileName)

FileName = Dir$

Loop



Text1.Text = "Este directorio ocupa la cantidad de bytes = " + Str$(FileSize)

End Sub





Entrar en las Propiedades de Accesibilidad (para windows 98)
1. Crear un nuevo formulario, Form1 por defecto
2. Añadir un boton al formulario "Command Button control"
3. Añadir el siguiente codigo a la propieded Clik del boton.

Private Sub Command1_Click()
X = Shell("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @2")
End Su

[GeoAvila]

pregunta:
¿como Compactar una base de datos, usando código VB ?
respuesta:
Este es el código que uso para compactar las bases de datos. Cosa que suelo hacer bastante a menudo, sobre todo en las que uso en la empresa, que cambian a diario.
Por aquello de la seguridad, mantengo dos copias: la anterior y la última. Más vale prevenir. Nunca se sabe cuando se cortará la luz o se quedará colgado el equipo... así que, me curo en salud.

Código:

 
'Cerrar la base (esto sólo si la tienes abierta...)
Db.Close
'Liberar memoria y "desligarla"
Set Db = Nothing
'
'Tomar el nombre sin la extensión
sTmp = ""
i = InStr(NombreBase, ".")
If i Then
	p = i - 1
Else
	p = Len(NombreBase)
End If
sTmp = Left$(NombreBase, p)
'Buscar \, para tomar el directorio (path)
For i = p To 1 Step -1
	If Mid$(NombreBase, i, 1) = "\" Then
		sTmp = Left$(NombreBase, i)
		Exit For
	End If
Next
If Right$(sTmp, 1) <> "\" Then
	sTmp = sTmp & "\"
End If
'Todo este proceso es para estar seguro de que se quede una copia
'en caso de que falle la compactación...
dBaseTmp = sTmp & "~dBase2.mdb"
If Len(Dir$(dBaseTmp)) Then Kill dBaseTmp
If Len(Dir$(sTmp & "~dBase1.mdb")) Then Kill sTmp & "~dBase1.mdb"
'Esta es la madre del cordero, se pueden usar otras "versiones", es cuestión de adecuarte.
CompactDatabase NombreBase, dBaseTmp, dbLangSpanish, dbVersion20
'Guardar una copia de como estaba antes
Name NombreBase As sTmp & "~dBase1.mdb"
'Esta es la base ya compactada, así que asignar el nombre
Name dBaseTmp As NombreBase
'Borrar los ficheros LDB
If Len(Dir$(sTmp & "*.ldb")) Then Kill sTmp & "*.ldb"

[Sylvestre]

Cómo imprimir un MSFLEXGRID

Pregunta:

¿Cómo imprimir un MSFlexGrid?

Respuesta


Public Sub MSHFG_Print(ByVal gri As Control, cabecer As String, peu As String)
Set grid = gri
ReDim dimen(grid.Cols)
If grid.Rows = 1 Then Exit Sub
'Agafo l'amplada del grid total a imprimir
ample = 0
For x = 0 To grid.Cols - 1
grid.Col = x
If grid.CellWidth > 20 Then
If grid.CellWidth < 200 Then grid.ColWidth(x) = 200
ample = grid.CellWidth + ample
End If
dimen(x) = grid.CellWidth
Next x
grid.LeftCol = 1
'ja tinc el ample a imprimir
tppx = Printer.TwipsPerPixelX
tppy = Printer.TwipsPerPixelY
cabecera = cabecer
pie = peu
x0 = (Printer.ScaleWidth - ample) / 2
y0 = (Printer.Height - Printer.ScaleHeight) / 2
y1 = y0
Printer.CurrentY = y1
grid.Col = 0
grid.Row = 0
For Row = 0 To grid.Rows - 1
If Row = 0 Then PosCapMSHFG
'faig la ultima linea del grid si ha acabat sense cuadricular
If Printer.ScaleHeight - 1500 < y1 Then 'finalitzo pag i poso capçelera.
If cuadro = True Then Printer.Line (x0, y1)-(x0 + ample, y1), vbBlack, B
Printer.CurrentY = Printer.ScaleHeight - 500
Printer.CurrentX = x0
Printer.Print pie
Printer.CurrentX = Printer.ScaleWidth - 1000
Printer.Print "Pág " & Printer.Page
Printer.NewPage
PosCapMSHFG
End If
ImpLinMSHFG

Next
'faig la ultima linea del grid si ha acabat sense cuadricular
If cuadro = True Then Printer.Line (x0, y1)-(x0 + ample, y1), vbBlack, B
Printer.CurrentY = Printer.ScaleHeight - 500
Printer.CurrentX = x0
Printer.Print pie
Printer.CurrentX = Printer.ScaleWidth - 1000
Printer.Print "Pág " & Printer.Page
Printer.EndDoc
End Sub


Private Sub ImpLinMSHFG()
alt = grid.RowHeight(Row)

Printer.FillStyle = 1 'solido 0
Printer.CurrentX = x0
Printer.CurrentY = y1 'printer.CurrentY - tppy
If cuadro Then
Printer.Line -Step(ample + tppx, alt + tppy), vbBlack, B
Else
Printer.Line (x0 + ample, y1)-(x0 + ample, y1 + alt + tppy), vbBlack, B
End If
cuadro = Not cuadro
For Col = 0 To grid.Cols - 1
If Col = 0 Then
x1 = x0 'COMENÇO PER L'ESQUERRA
'alt = printer.FontSize * tppy * 5
Else
x1 = x1 + dimen(Col - 1)
End If
If dimen(Col) < 20 Then Col = Col + 1
If dimen(Col) > 20 Then
Printer.CurrentX = x1 + tppx
Printer.CurrentY = y1 '+ tppy
Printer.Line (x1, y1 + tppy)-(x1, alt + y1 - tppy), vbBlack, B
Printer.CurrentX = x1 + 30 / tppx
Printer.CurrentY = y1 '+ tppy
texte = grid.TextArray(grid.Cols * Row + Col)
Do While Printer.TextWidth(texte) > dimen(Col) And Len(texte) > 0
texte = Left(texte, Len(texte) - 1)
punts = True
Loop
If punts = True And Len(texte) > 0 Then texte = Left(texte, Len(texte) - 2) & "..."
punts = False
If grid.ColAlignment(Col) > 5 Then Printer.CurrentX = Printer.CurrentX + dimen(Col) - Printer.TextWidth(texte) - 30 / tppx
If grid.ColAlignment(Col) >= 3 And grid.ColAlignment(Col) <= 5 Then Printer.CurrentX = Printer.CurrentX + (dimen(Col) - Printer.TextWidth(texte)) / 2

Printer.Print texte
End If
Next
y1 = y1 + grid.RowHeight(Row) '- tppy 'y + alto de la fila actual

End Sub

Public Sub PosCapMSHFG()
Printer.CurrentY = y0
Printer.FontSize = 20
Printer.ForeColor = vbBlue
Printer.FontBold = True
Printer.CurrentX = (Printer.Width - Printer.ScaleWidth) + (Printer.ScaleWidth - Printer.TextWidth(cabecera)) / 2
Printer.Print cabecera
Printer.FontSize = 8.25
Printer.ForeColor = vbBlack
Printer.FontBold = False
y1 = Printer.CurrentY + 300 'separaciò amb el titol
'Row = trow
'grid.Row = Row
'grid.Col = 0
For Col = 0 To grid.Cols - 1
'grid.Col = Col
If Col = 0 Then
x1 = x0 'COMENÇO PER L'ESQUERRA
'alt = printer.FontSize * tppy * 5
Else
x1 = x1 + dimen(Col - 1)
End If
If dimen(Col) < 20 Then Col = Col + 1
'If grid.Col = 9 Or grid.Col = 11 Then x1 = x1 + 400
'grid.Col = Col
If dimen(Col) > 20 Then
Printer.CurrentX = x1 + tppx
Printer.CurrentY = y1 '+ tppy
Printer.Line (x1, y1 + tppy)-(x1, alt + y1 - tppy), vbBlack, B
Printer.CurrentX = x1 + 15 / tppx
Printer.CurrentY = y1 '+ tppy
texte = grid.TextArray(Col)
Do While Printer.TextWidth(texte & "...") > dimen(Col) And Len(texte) > 0
texte = Left(texte, Len(texte) - 1)
punts = True
Loop
If punts = True And Len(texte) > 0 Then texte = Left(texte, Len(texte) - 2) & "..."
punts = False
Printer.CurrentX = Printer.CurrentX + (dimen(Col) - Printer.TextWidth(texte)) / 2
Printer.Print texte
End If
Next
y1 = y1 + grid.RowHeight(Row) '- tppy 'y + alto de la fila actual
cuadro = True
If Row = 0 Then Row = 1

End Sub


Saludos

[GeoAvila]

Pregunta:
como imprimir un FlexGrid

Repuesta :

Bueno en forma de pensar esta es una de las manera, puesto que imprime un grid tal como se, tipo hoja de excel,(no lo habia publicado porque no lo habia encontrado.)

Código:

'**************************************
' Formatear e impremir un MSFLEXIGRID
' Entrada el FlexiGrid que quiere imprimir
' No retorna nada
'************************************
 
 
Sub PrintGrid(pGrid As MSFlexGrid, sTitulo As String, pHorizontal As Boolean)
' pGrid = El Gri a imprimir
' sTitulo = El título de la página
' pHorizontal = True para imprimir página invertida
 
On Error GoTo ErrorImpresion
Dim i As Integer
Dim iMaxRow As Integer
Dim j As Integer
Dim msfGrid As MSFlexGrid
Dim iPaginas As Integer
Printer.ColorMode = vbPRCMMonochrome
Printer.PrintQuality = 160
 
 
Set msfGrid = fMainForm.MSFlexGrid1
msfGrid.FixedCols = 0
msfGrid.Clear
 
 
If pHorizontal = True Then
Printer.Orientation = vbPRORLandscape
iMaxRow = 44
Else
Printer.Orientation = vbPRORPortrait
iMaxRow = 57
End If
 
' calcula el número de páginas
 
 
If pGrid.Rows Mod iMaxRow = 0 Then
iPaginas = pGrid.Rows \ iMaxRow
Else
iPaginas = pGrid.Rows \ iMaxRow + 1
End If
msfGrid.Rows = iMaxRow
msfGrid.Cols = pGrid.Cols
 
 
For i = 0 To pGrid.Cols - 1
msfGrid.ColWidth(i) = pGrid.ColWidth(i)
Next
 
' impresion de un logo o de una imagen que Vd. quiera
 
Printer.PaintPicture fMainForm.ImageList1.ListImages(1).Picture, 0, 0, 4300, 600
' imprime título
Printer.CurrentY = 650
Printer.FontName = "Courier New"
Printer.FontBold = True
Printer.FontSize = 12
Printer.Print sTitulo
Printer.Print
' justifica a la derecha fecha de impresión
 
 
 
If pHorizontal = True Then
Printer.CurrentX = 10000
Else
Printer.CurrentX = 7000
End If
Printer.CurrentY = 0
Printer.FontSize = 10
Printer.Print Now & " - Pág 1 de " & iPaginas
 
 
For i = 0 To pGrid.Rows - 2 + iPaginas
 
 
If i Mod iMaxRow = 0 And i > 0 Then
 
 
With msfGrid
.Row = 0
.Col = 0
.ColSel = 0
.RowSel = 0
 
 
If pHorizontal Then
Printer.PaintPicture .Picture, 20, 1250, 15000, 10350
Else
Printer.PaintPicture .Picture, 20, 1250, 11400, 13950
End If
End With
Printer.NewPage
msfGrid.Clear
 
 
For j = 0 To msfGrid.Cols - 1
' restablece títulos
msfGrid.TextMatrix(0, j) = pGrid.TextMatrix(0, j)
Next
' print logo
Printer.PaintPicture fMainForm.ImageList1.ListImages(23).Picture, 0, 0, 4300, 600
Printer.CurrentY = 650
Printer.FontSize = 12
Printer.Print sTitulo
Printer.Print
' justifica a la derecha fecha de impres
' ión
 
 
If pHorizontal = True Then
Printer.CurrentX = 10000
Else
Printer.CurrentX = 7000
End If
Printer.CurrentY = 0
Printer.FontSize = 10
Printer.Print Now & " - Pág " & i \ iMaxRow + 1 & " de " & iPaginas
i = i + 1 ' deja títulos
End If
 
 
For j = 0 To msfGrid.Cols - 1
msfGrid.TextMatrix(i Mod iMaxRow, j) = pGrid.TextMatrix(i - i \ iMaxRow, j)
Next
Next
 
 
With msfGrid
.Row = 0
.Col = 0
.ColSel = 0
.RowSel = 0
 
 
If pHorizontal Then
Printer.PaintPicture .Picture, 20, 1250, 15000, 10350
Else
Printer.PaintPicture .Picture, 20, 1250, 11400, 13950
End If
End With
Printer.EndDoc
MsgBox sTitulo & vbCrLf & "Se ha(n) enviado " & iPaginas & " página(s) a la impresora " & Printer.DeviceName, vbInformation, Printer.Port
 
salir:
Set msfGrid = Nothing
Exit Sub
ErrorImpresion:
Printer.KillDoc
MsgBox "Compruebe la impresora", vbCritical, "Printer Error"
Resume salir
End Sub

este ejemplo usa dos Grid's uno donde esta imformación y otro donde va imprimiendo hoja tras hoja, tipo excel, lo recomiendo mucho puesto que es muy estético..

nos vemos y bueno es otro ejemplo mas aparte de del amigo sylvestre que colabora con las FAQ´s

[GeoAvila]

pregunta:
como guardar los datos de un MsFlexgrid en una base de datos
repuesta

Código:

 On Local Error Resume Next
 Dim i As Integer
 If Metida = True Then
 Exit Sub
 End If
 For i = 1 To Me.ListadoDetalleFactura.Rows - 1
 If Me.ListadoDetalleFactura.TextMatrix(i, 1) = "" Then' nos basamo en una columna para determinar donde termina el area con texto.. o bien si contiene algo la linea del flexgrid
 Else
  Dim db As Connection
 		  Dim adoPrimaryRS As Recordset
 		  Set db = New Connection
 		  Set adoPrimaryRS = New Recordset
 		  db.CursorLocation = adUseClient
 		  db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & BasePath' base path es direccionamiento a la base de datos
 		  adoPrimaryRS.Open "Select * From detalle_cargos_habitacion", db, adOpenStatic, adLockOptimistic
 		  adoPrimaryRS.AddNew
 		  adoPrimaryRS!id_registro = CodigoRegistro
 		  adoPrimaryRS!id_servicio = Val(Me.ListadoDetalleFactura.TextMatrix(i, 1))
 		  adoPrimaryRS!ticket = Val(Me.ListadoDetalleFactura.TextMatrix(i, 3))
 		  adoPrimaryRS!id_empleado = CodU
 		  adoPrimaryRS!id_sesion = Sesion
 		  adoPrimaryRS!Fecha = Date
 		  adoPrimaryRS!hora = Time
 		  adoPrimaryRS!cantidad = Val(Me.ListadoDetalleFactura.TextMatrix(i, 4))
 		  adoPrimaryRS!Total = Val(Me.ListadoDetalleFactura.TextMatrix(i, 5))
 		  adoPrimaryRS.Update
 End If
 Next i
 If Err <> 0 Then
 MsgBox "No se han podido guardar todos los datos por el siguiente error " & Err, vbInformation, "Error"
 Metida = True
 Exit Sub
 End If

[GeoAvila]

Pregunta:
Como Hacer un MsFlexGrid Editable

Respuesta:
Grid con casillas editables.
En el ejemplo veremos cómo usar tanto un control TextBox como un comboBox.
como verás en el código es fácil decidir si debemos mostrar el textbox o el combo... dependiendo de lo que necesitemos usar... en caso de que necesites usar diferentes combos, te recomiendo que uses un array del control combo1 para que te resulte fácil de interceptar las pulsaciones y otras acciones con dichos controles... puede que en otra ocasión amplíe este ejemplo con esto que digo, además de usar un control checkbox... pero eso será en otra ocasión... así que... paciencia.

Te explico lo que el código hace... aunque puedes seguirlo sin problemas, eso espero, con los comentarios incluidos en el código de ejemplo.

En principio el Grid sólo tendrá una fila "disponible", cuando pulsamos en una de las celdas de la última fila, la cual está identificada con ">>*", se creará una nueva fila... cuando pruebes el código de ejemplo, sabrás de que estoy hablando.

Para introducir algo en cualquiera de las celdas, podemos hacerlo de varias formas:
-haciendo doble-click en la celda a editar,
-escribiendo directamente en el grid,
-pulsando la tecla F2

Para aceptar lo que hemos escrito, pulsaremos Intro o simplemente haciendo Click en cualquier otra celda.
Si se pulsa ESC, se cancela la edición de la celda.

En el código mostrado, uso dos procedimientos para guardar el contenido del grid en un fichero de texto y para leer de ese fichero y asignarlo al grid. Este código tendrás que adaptarlo a los campos que tengas en el grid, aunque usado tal y como lo muestro te puede ser útil al 100%.

Bueno, me dejo de "cháchara" y te muestro el código.

El formulario contiene los siguientes controles:
Un control FlexGrid llamado Grid2,
un TextBox llamado Text1,
un ComboBox llamado Combo1,
un PictureBox llamado picStatus con la propiedad Align = 2 (para que se ajuste a la parte inferior),
una etiqueta llamada lblStatus, (insertada en el picStatus),
un botón llamado cmdSalir, (insertado en el picStatus).

Nota:
No tienes que preocuparte por "insertar" los dos últimos controles mencionados en el PictureBox, ya que eso se hace en el código del evento Form_Load

Como bono extra, una función para "interpretar" fechas y asignar el formato que queramos a partir de varias formas de entrada, por ejemplo, acepta fechas con y sin separadores, e incluso sin indicar el año...



Aquí tienes el código:

Código:

'------------------------------------------------------------------------------
' Prueba de Grid con celdas editables							 (09/May/01)
' Revisado: 17/May/2001
'
' Ejemplo de código con TextBox y ComboBox
'
' ©Guillermo 'guille' Som, 2001
'------------------------------------------------------------------------------
Option Explicit
 
Private sFicDatos As String ' Fichero con los datos del grid
Const cNuevaFila As String = ">>*" ' Para indicar que es una nueva fila
Private ControlVisible As Boolean ' Si el control está o no visible (editándose)
Private LastRow As Long ' La última fila en que se editó
Private LastCol As Long ' La última columna en que se editó
 
Private Sub cmdSalir_Click()
	Unload Me
End Sub
 
Private Sub Combo1_Change()
	If Combo1.Visible Then
		Grid2.TextMatrix(LastRow, LastCol) = Combo1.Text
		AsignarCelda
	End If
End Sub
 
Private Sub Combo1_Click()
	Combo1_Change
End Sub
 
Private Sub Combo1_KeyPress(KeyAscii As Integer)
	If KeyAscii = vbKeyReturn Then
		KeyAscii = 0
	 AsignarCelda
		SiguienteCelda
	ElseIf KeyAscii = vbKeyEscape Then
		KeyAscii = 0
		Combo1.Visible = False
	End If
End Sub
 
Private Sub Form_Load()
	Dim i As Long
	Dim s As String
	'
	picStatus.Height = 585
	With lblStatus
		.Caption = " Código de ejemplo: ©Guillermo 'guille' Som, 2001 <[email protected]>"
		Set .Container = picStatus
		.Height = 285
		.BorderStyle = vbFixedSingle
		.Left = 90
		.Top = 120
		.Visible = True
	End With
	With cmdSalir
		Set .Container = picStatus
		.Height = 405
		.Top = 60
		.Visible = True
	End With
	'
	s = App.Path
	sFicDatos = s & IIf(Right$(s, 1) = "\", "", "\") & "PruebaGrid.txt"
	'
	With Combo1
		.Clear
		For i = 1 To 20
			.AddItem i
		Next
	End With
	'
	OcultarControles
	'
	CabeceraGrid
	LeerDatos
End Sub 

Continua en la siguiente Página son 4 Post en Total

[GeoAvila]

Código:

 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 	' Guardar los datos del grid
 	GuardarDatos
 End Sub
 
 Private Sub Form_Resize()
 	' Reajustar el tamaño del grid al de la ventana
 	' Si tuviesemos otro control, por ejemplo una barra de estado,
 	' restarle el ancho de la misma al Grid
 	If WindowState <> vbMinimized Then
 		Grid2.Move 0, 0, ScaleWidth, ScaleHeight - picStatus.Height
 		With cmdSalir
 			.Left = picStatus.ScaleWidth - .Width - 90
 			lblStatus.Width = .Left - 120 - lblStatus.Left
 		End With
 	End If
 End Sub
 
 Private Sub Grid2_Click()
 	' Cuando se hace un sólo click en otra columna,
 	' asigna el valor seleccionado, (como si se pulsara intro)
 	AsignarCelda
 End Sub
 
 Private Sub Grid2_DblClick()
 	' Editar al hacer dobleclick
 	LastRow = Grid2.Row
 	LastCol = Grid2.Col
 	'
 	OcultarControles
 	'
 	MostrarCelda
 End Sub
 
 Private Sub Grid2_KeyDown(KeyCode As Integer, Shift As Integer)
 	' Editar si se pulsa F2
 	If KeyCode = vbKeyF2 Then
 		MostrarCelda
 	ElseIf KeyCode = vbKeyDelete Then
 		' Borrar las filas seleccionadas						    (13/May/01)
 		BorrarFilas
 	End If
 End Sub
 
 Private Sub Grid2_KeyPress(KeyAscii As Integer)
 	Select Case KeyAscii
 	' Si se pulsa Intro, editar la celda
 	Case vbKeyReturn
 		KeyAscii = 0
 		MostrarCelda
 	' Cancelar si se pulsa ESC
 	Case vbKeyEscape
 		KeyAscii = 0
 		AsignarCelda
 	' Si se pulsa cualquier letra, editar la celda
 	Case 32 To 255
 		MostrarCelda
 		With Text1
 	  	  If .Visible Then
 			    '.Text = .Text & Chr$(KeyAscii)
 				.Text = Chr$(KeyAscii)
 				.SelStart = Len(.Text) + 1
 			End If
 		End With
 	End Select
 End Sub
 
 Private Sub Grid2_Scroll()
 	' Comprobar si la columna en la que está el control está visible
 	' si es así, ocultar los controles
 	'
 	If Grid2.ColIsVisible(LastCol) = False Then
 		OcultarControles
 		Exit Sub
 	End If
 	If Grid2.RowIsVisible(LastRow) = False Then
 		OcultarControles
 		Exit Sub
 	End If
 	' Comprobar si estaba visible antes de ocultarlo
 	' y posicionarlo en la misma celda
 	If ControlVisible Then
 		MostrarCelda
 	End If
 End Sub
 
 Private Sub MostrarCelda()
 	Static YaEstoy As Boolean
 	'
 	' Salir si es una de las celdas fijas
 	If Grid2.Col <= Grid2.FixedCols - 1 Or Grid2.Row <= Grid2.FixedRows - 1 Then
 		Exit Sub
 	End If
 	'
 	If YaEstoy Then Exit Sub
 	YaEstoy = True
 	'
 	OcultarControles
 	'
 	LastRow = Grid2.Row
 	LastCol = Grid2.Col
 	'
 	' Si es una nueva celda
 	With Grid2
 		If .TextMatrix(LastRow, 0) = cNuevaFila Then
 			.Rows = .Rows + 1
 			.TextMatrix(LastRow, 0) = LastRow
 			.TextMatrix(.Rows - 1, 0) = cNuevaFila
 		End If
 	End With
 	'
 	Select Case LastCol
 	Case 2
 		Combo1.Text = Grid2.TextMatrix(LastRow, LastCol)
 		Combo1.Move Grid2.CellLeft - Screen.TwipsPerPixelX, Grid2.CellTop - Screen.TwipsPerPixelY
 		Combo1.Width = Grid2.CellWidth + Screen.TwipsPerPixelX * 2
 		Combo1.Visible = True
 		Combo1.ZOrder
 		Combo1.SetFocus
 	Case Else
 		Text1.Move Grid2.CellLeft - Screen.TwipsPerPixelX, Grid2.CellTop - Screen.TwipsPerPixelY, Grid2.CellWidth + Screen.TwipsPerPixelX * 2, Grid2.CellHeight + Screen.TwipsPerPixelY * 2
 		Text1.Text = Grid2.Text
 		If Len(Grid2.Text) = 0 Then
 			If LastRow > 1 Then
 				Text1.Text = Grid2.TextMatrix(LastRow - 1, LastCol)
 			End If
 		End If
 		Text1.Visible = True
 		If Text1.Visible Then
 			Text1.ZOrder
 			Text1.SetFocus
 		End If
 	End Select
 	'
 	ControlVisible = True
 	'
 	YaEstoy = False
 End Sub
 
 Private Sub SiguienteCelda()
 	If Grid2.Col < Grid2.Cols - 1 Then
 		Grid2.Col = Grid2.Col + 1
 	Else
 		Grid2.Col = 1
 		If Grid2.Row < Grid2.Rows - 1 Then
 			Grid2.Row = Grid2.Row + 1
 		End If
 	End If
 End Sub
 
 Private Sub Text1_GotFocus()
 	With Text1
 		' Posicionar el cursor al final
 		.SelStart = Len(.Text)
 	End With
 End Sub
 
 Private Sub Text1_KeyPress(KeyAscii As Integer)
 	' Si se pulsa Intro, aceptar lo que se ha escrito
 	If KeyAscii = vbKeyReturn Then
 		KeyAscii = 0
 		AsignarCelda
 		SiguienteCelda
 	' Si se pulsa ESC, cancelar la edición
 	ElseIf KeyAscii = vbKeyEscape Then
 		KeyAscii = 0
 		Text1.Visible = False
 		ControlVisible = False
 	End If
 End Sub
 
 Private Sub AsignarCelda()
 	' Asignar al grid el texto escrito o seleccionado del combo
 	Dim s As String
 	'
 	OcultarControles
 	ControlVisible = False
 	'
 	' Asignar el texto anterior a la celda
 	Select Case LastCol
 	Case 2
 		'
 		Grid2.TextMatrix(LastRow, LastCol) = Combo1.Text
 	Case Else
 		s = Text1.Text
 		' si es la columna de la fecha...
 		If LastCol = 1 Then ' Fecha
 			s = AjustarFecha(s)
 		End If
 		Grid2.TextMatrix(LastRow, LastCol) = s
 	End Select
 End Sub
 
  

[GeoAvila]

Código:

 Private Function AjustarFecha(ByVal sFecha As String) As String
 	' Ajustar la cadena introducida a formato de fecha			  (27/Abr/01)
 	Dim i As Long
 	Dim s As String
 	'
 	If sFecha = "" Then
 		AjustarFecha = ""
 		Exit Function
 	End If
 	'
 	'On Error Resume Next
 	On Error GoTo 0
 	'
 	' Comprobar si se usan puntos como separador
 	' si es así, cambiarlos por /
 	Do
 		i = InStr(sFecha, ".")
 		If i Then
 			Mid$(sFecha, i, 1) = "/"
 		End If
 	Loop While i
 	'
 	' Comprobar si se usan - como separador
 	' si es así, cambiarlos por /
 	Do
 		i = InStr(sFecha, "-")
 		If i Then
 			Mid$(sFecha, i, 1) = "/"
 		End If
 	Loop While i
 	'
 	s = ""
 	Do
 		i = InStr(sFecha, "/")
 		If i Then
 			s = s & Right$("0" & Left$(sFecha, i - 1), 2) & "/"
 			sFecha = Mid$(sFecha, i + 1)
 		End If
 	Loop While i
 	sFecha = s & sFecha
 	'
 	If InStr(sFecha, "/") Then
 		If Len(sFecha) = 5 Then
 			' Si es igual a 5 caracteres, es que falta el año
 			sFecha = sFecha & "/"
 		ElseIf Len(sFecha) < 3 Then
 			' Si es menor de 3 caracteres es que falta el mes
 			sFecha = sFecha & "/" & CStr(Month(Now)) & "/"
 		End If
 	ElseIf Len(sFecha) < 3 Then
 		sFecha = sFecha & "/" & CStr(Month(Now)) & "/"
 	Else
 		s = ""
 		For i = 1 To 2
 	  	  s = s & "/" & Mid$(sFecha, (i - 1) * 2 + 1, 2)
 		Next
 		s = s & "/" & Mid$(sFecha, 5)
 		sFecha = s
 	End If
 	sFecha = Trim$(sFecha)
 	'
 	' Comprobar si tiene una barra al principio, si es así, quitarla
 	If Left$(sFecha, 1) = "/" Then
 		sFecha = Mid$(sFecha, 2)
 	End If
 	' Si tiene una barra al final, es que falta el año
 	If Right$(sFecha, 1) = "/" Then
 		sFecha = sFecha & CStr(Year(Now))
 	End If
 	'
 	' Convertir la fecha, por si no se especifican todos los caracteres
 	' Nota: Aquí puedes usar el formato que más te apetezca
 	sFecha = Format$(sFecha, "dd/mm/yyyy")
 	'
 '	' Si no es una fecha correcta...
 '	If IsDate(sFecha) = False Then
 '		AjustarFecha = sFecha
 '	Else
 '	    AjustarFecha = sFecha
 '	End If
 	'
 	Err = 0
 	'
 	AjustarFecha = sFecha
 End Function
 
 Private Sub CabeceraGrid()
 	' Asignar las cabeceras del grid y asignación de valores predeterminados
 	Dim i As Long
 	'
 	With Grid2
 		.FixedRows = 1
 		.FixedCols = 1
 		.ScrollBars = flexScrollBarBoth
 		.AllowUserResizing = flexResizeColumns
 		.Cols = 11				  ' Número de columnas, contando la cabecera
 		.Rows = 2				   ' Número de filas, contando la cabecera
 								    ' el número de filas se asignará dinámicamente
 		.ColWidth(0) = 600		  ' El ancho de la columna 0
 		'
 		' Asignar los nombres de las cabeceras y el ancho de las columnas
 		.TextArray(1) = "Fecha"
 		.ColWidth(1) = 1100
 		.TextArray(2) = "Número"
 		.ColWidth(2) = 900
 		.TextArray(3) = "Nombre"
 		.ColWidth(3) = 1500
 		.TextArray(4) = "Apellidos"
    	 .ColWidth(4) = 2000
 		.TextArray(5) = "Domicilio"
 		.ColWidth(5) = 2500
 		.TextArray(6) = "Población"
 		.ColWidth(6) = 2000
 		.TextArray(7) = "Provincia"
 		.ColWidth(7) = 1600
 		.TextArray(8) = "Teléfonos"
    	 .ColWidth(8) = 1500
 		.TextArray(9) = "e-mail"
 		.ColWidth(9) = 1200
 		.TextArray(10) = "Observaciones"
 		.ColWidth(10) = 2500
 		'
 		' Mostrar los números en las filas
 		For i = 1 To .Rows - 1
 			.TextMatrix(i, 0) = i
 		Next
 		'
 		' Esto indicará que es una nueva fila
 		' (asignarla a la primera columna de la última fila)
 		.TextMatrix(.Rows - 1, 0) = cNuevaFila
 	End With
 End Sub
 
 Private Sub BorrarFilas()
 	' Borrar las filas seleccionadas							    (13/May/01)
 	Dim i As Long
 	Dim j As Long
 	Dim k As Long
 	Dim n As Long
 	'
 	' Si está seleccionada la última fila, no borrarla
 	If Grid2.RowSel = Grid2.Rows - 1 Then
 		Beep
  	   Exit Sub
 	End If
 	If Grid2.Row = Grid2.Rows - 1 Then
 		Beep
 		Exit Sub
 	End If
 	'
 	' Borrar siempre desde la fila mayor a la menor
 	i = Grid2.Row
 	j = Grid2.RowSel
 	If i < j Then
 		k = i
 		i = j
 	    j = k
 	End If
 	For n = i To j Step -1
 		Grid2.RemoveItem n
 	Next
 	LastRow = Grid2.Rows - 1
 	LastCol = 1
 	Grid2.Col = LastCol
 	Grid2.Row = LastRow
 	Grid2.RowSel = LastRow
 	Grid2.ColSel = LastCol
 End Sub
 
 

[GeoAvila]

Código:

 Private Sub OcultarControles()

	' Ocultar los controles de edición							  (17/May/01)

	' (aunque son pocos, se pueden ampliar y así es más fácil saber dónde

	' poner el código para ocultarlos)

	Text1.Visible = False

	Combo1.Visible = False

End Sub



Private Sub LeerDatos()

	' Leer los datos y asignarlos al grid

	Dim nFic As Long

	Dim r As Long

	Dim c As Long

	Dim s As String

	'

	' Si no existe el fichero, nada que hacer...

	If Len(Dir$(sFicDatos)) = 0 Then Exit Sub

	'

	r = Grid2.Rows - 2

	nFic = FreeFile

	Open sFicDatos For Input As nFic

	Do While Not EOF(nFic)

		r = r + 1

		Grid2.Rows = r + 2

		Grid2.TextMatrix(r, 0) = r

		For c = 1 To Grid2.Cols - 1

			If Not EOF(nFic) Then

				Line Input #nFic, s

				Grid2.TextMatrix(r, c) = s

			Else

				Exit For

			End If

		Next

	Loop

	Close nFic

	'

	With Grid2

		.TextMatrix(.Rows - 1, 0) = cNuevaFila

		LastRow = .Rows - 1

		LastCol = 1

		.Col = LastCol

		.Row = LastRow

		.RowSel = LastRow

		.ColSel = LastCol

	End With

End Sub



Private Sub GuardarDatos()

	' Guardar los datos del Grid

	Dim nFic As Long

	Dim r As Long

	Dim c As Long

	'

	nFic = FreeFile

	Open sFicDatos For Output As nFic

	' No guardar la última fila, (si se usa el indicador de nueva fila)

	For r = 1 To Grid2.Rows - 2

		For c = 1 To Grid2.Cols - 1

			Print #nFic, Grid2.TextMatrix(r, c)

		Next

	Next

	Close nFic

End Sub 

[Loquillo_]

Me uno al club de FAQs.
Aquí les envío un código de cómo generar códigos de barra
les puede servir mucho en lo que es codificación o rotulación de productos.

El codigo a continuación tiene un Procedimiento llamado
DrawBarCode, el cual recibe el codigo del item, la descripción del mismo y un control PictureBox, el cual contendrá el codigo de barras.

Sólo debes diseñar un form con 3 controles (2 textBox y 1 PictureBox), luego
ejecutas

Call DrawBarcode(codigo_item, Descripcion_item, PictureBox)

Atentamente,
Darwin Alvarado Marin
Machala - El Oro - Ecuado

Sub DrawBarcode(ByVal bc_string As String, sDescripcion As String, VLPrecio as String, obj As Control)

Dim xpos!, y1!, y2!, dw%, th!, tw, new_string$
Dim bc(90) As String
Dim sAux As String
Dim I As Byte

bc(1) = "1 1221" 'pre-amble
bc(2) = "1 1221" 'post-amble
bc(48) = "11 221" 'dígitos
bc(49) = "21 112"
bc(50) = "12 112"
bc(51) = "22 111"
bc(52) = "11 212"
bc(53) = "21 211"
bc(54) = "12 211"
bc(55) = "11 122"
bc(56) = "21 121"
bc(57) = "12 121"
'Letras Mayúsculas
bc(65) = "211 12" 'A
bc(66) = "121 12" 'B
bc(67) = "221 11" 'C
bc(68) = "112 12" 'D
bc(69) = "212 11" 'E
bc(70) = "122 11" 'F
bc(71) = "111 22" 'G
bc(72) = "211 21" 'H
bc(73) = "121 21" 'I
bc(74) = "112 21" 'J
bc(75) = "2111 2" 'K
bc(76) = "1211 2" 'L
bc(77) = "2211 1" 'M
bc(78) = "1121 2" 'N
bc(79) = "2121 1" 'O
bc(80) = "1221 1" 'P
bc(81) = "1112 2" 'Q
bc(82) = "2112 1" 'R
bc(83) = "1212 1" 'S
bc(84) = "1122 1" 'T
bc(85) = "2 1112" 'U
bc(86) = "1 2112" 'V
bc(87) = "2 2111" 'W
bc(88) = "1 1212" 'X
bc(89) = "2 1211" 'Y
bc(90) = "1 2211" 'Z
'Misceláneos Caracteres
bc(32) = "1 2121" 'Espacio
bc(35) = "" '# no se puede realizar
bc(36) = "1 1 1 11" '$
bc(37) = "11 1 1 1" '%
bc(43) = "1 11 1 1" '+
bc(45) = "1 1122" '-
bc(47) = "1 1 11 1" '/
bc(46) = "2 1121" '.
bc(64) = "" '@ no se puede realizar
bc(65) = "1 1221" '*

bc_string = UCase(bc_string) 'Convertir a mayúsculas

'Dimensiones
obj.ScaleMode = 2 'Pixeles
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40) 'Espacio entre barras
If dw < 1 Then dw = 1
th = obj.TextHeight(bc_string) 'Alto texto
tw = obj.TextWidth(bc_string) 'Ancho texto
new_string = Chr$(1) & bc_string & Chr$(2) 'Agregar pre-amble, post-amble
y1 = obj.ScaleTop + 12
y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth

'Dibujar cada caracter en el string barcode
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = bc(c)
'Dibujar cada barra
For I = 1 To Len(bc_pattern$)
Select Case Mid(bc_pattern$, I, 1)
Case " "
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
Case "1"
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'Línea
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &H0&, BF
xpos = xpos + dw
Case "2"
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'Ancho línea
obj.Line (xpos, y1)-(xpos + 2 * dw, y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next

'Mas espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw

'Medida final y tamaño
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = 1
obj.CurrentY = 1
If VLPrecio = "0.00" Then VLPrecio = ""
If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sDescripcion) Then
sAux = ""
For I = 1 To Len(sDescripcion)
If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sAux) Then
Exit For
Else
sAux = sAux & Mid(sDescripcion, I, 1)
End If
Next I
obj.Print sAux
Else
obj.Print sDescripcion
End If
obj.CurrentX = xpos - obj.TextWidth(VLPrecio)
obj.CurrentY = 1
obj.Print VLPrecio
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = y2 + 0.25 * th
obj.Print bc_string

'Copiar a clipboard
obj.Picture = obj.Image
Clipboard.Clear
Clipboard.SetData obj.Image, 2
End Sub

[GeoAvila]

Prengunta:
Como Guardar datos en el registro de Windows

Respuesta:
Hola. Create un formulario llamado Form1, y en el pon un CheckBox, llamado Check1. Depués añade este código.

Código:

  Private Sub Form_Load()
  	Check1.Value = GetSetting(App.Title, Form1.Name, Check1.Name, vbChecked) 
  End Sub

Código:

  Private Sub Form_Unload(Cancel As Integer)
  	SaveSetting App.Title, Form1.Name, Check1.Name, Check1.Value
  End Sub

Tendrás que hacer lo mismo con cada uno de los controles de tu formulario.
Se podría hacer incluso un procedimiento para guardar en un bucle todas las propiedades de todos los controles de un formulario, pero eso te lo dejamos investigar a vos.
en caso de que fuera un texto un label se reemplaza el codigo por las propiedades de un texto, por ejemplo

Código:

   Private Sub Form_Load()
  text1.text = GetSetting(App.Title, Form1.Name, text1.name, vbChecked) 
  End Sub

Código:

   Private Sub Form_Unload(Cancel As Integer)
   	SaveSetting App.Title, Form1.Name, text1.name, text1.text
   End Sub

para una label seria igual pero con label1.caption..

nos vemos espero les sirva de mucho

[GeoAvila]

Prengunta:
Como Utilizar el componente ProgressBar

Respuesta:
Una barra del progreso exhibe una barra azul creciente o que se contrae para dar la regeneración de usuario en una cierta clase de operación. Esto puede descargar un archivo del Internet o de la terminación de una tarea muy larga. La barra azul puede ser dividida en segmentos o puede ser sólida. El ProgressBar está situado en los controles comunes de Microsoft Windows así que agregar este control a su caja de herramientas que usted tiene que chascar encendido proyectos sobre la barra de menú, después chascar encendido componentes y los componentes caja aparecerá de diálogo, después enrollan abajo y localizan los controles 6 del campo común de Microsoft Windows y ponen un cheque en la caja de cheque al lado de ella y chascan encendido MUY BIEN.

* Nota: CTRL + t también abre la caja de diálogo de los componentes

Características, métodos y acontecimientos

características significativas

Movimiento en sentido vertical(Scrolling): se determina si la exhibición del progreso aparece sólida o dividida en segmentos
Negotiate: esto se determina si un control que puede ser alineado está exhibido cuando un objeto activo en la forma exhibe unos o más toolbars.
Orientación( Orientación): se determina si la orientación es horizontal o vertical
Valor(Value): el ajuste actual de la barra del progreso
Aspecto(Appearance): esto hace que la barra del progreso aparece o en 3D o plano
BorderStyle: fija el estilo de la frontera de los controles
Max, Min: fija los valores máximos y mínimos de la barra del progreso

Métodos las barras del progreso hacen que los métodos estándares de otros controles éstos incluyan el movimiento, tecleo, DblClick etcétera.


Ejemplo:

Coloque simplemente una barra del progreso en la pantalla fijada su característica mínima a 0 y su característica máxima a 100. Experimente entre las dos diversas características de Scolling del ccScrollingSmooth (normal) o del ccScrollingStandard (dividido en segmentos). Para animar la barra del progreso ponga un control del contador de tiempo(Timer) en la forma y fije su característica del intervalo a 1000 milisegundos que el Now agrega un botón de comando a la forma (el usuario chascará esto y la barra del progreso se moverá), hace que los botones de comando subtitulan dice algo como comienzo.

Primero ponga el código siguiente en el procedimiento del acontecimiento del Form Load.

Código:

 Private Sub Form_Load()
 
 	  Timer1.Enabled = False
 	  ProgressBar1.Value = 0
 
 End Sub

Ahora ponga el código siguiente en el procedimiento del acontecimiento del Command buttons Click

Código:

 Private Sub Command1_Click()
 
 	  ProgressBar1.Value = 0
 	  Timer1.Enabled = True
 
 End Sub

y finalmente el código siguiente consigue colocado en el acontecimiento del contador de tiempo de los contadores de tiempo

Código:

 Private Sub Timer1_Timer()
 
 	ProgressBar1.Value = ProgressBar1.Value + 1
 	If ProgressBar1.Value >= 10 Then _
 			Timer1.Enabled = False
 
 End Sub

nos vemos..

[GeoAvila]

Manual de como bloquear CTRL+ALT+SUP, ALT+TAB, Y OTROS con Visual Basic en Win XP[Por CBBzun] Muy bien, luego de buscar mucho por todos lados y quedarme muchas horas trabajando, logré bloquear todo en windows, por ahí decían que era imposible, otros que XP no lo permiete, pero aquí está, no se si será que quienes lo descubrieron no quisieron revelar el proceso, en todo caso creo que será muy útil.

CTRL+ALT+SUP (TaskManager)

Se debe ingresar la instrucción "DisableTaskMgr" directamente en el regedit con el valor "1" en la carpeta abajo indicada, esto es fácil hacerlo desde VB.

[HKEY_CURRENT_USER\Software\Microsoft\Windows\Curre ntVersion\Policies\System]

Value Name: DisableTaskMgr

Data Type: REG_DWORD (DWORD Value)

Value Data: (0 = default, 1 = bloquea Task Manager)

------------------------------------------------------------------

ALT+TAB, CTRL+ESC (Tecla Windows), ALT+F4

Crear el siguiente Módulo (.BAS), no importa como le llamen

Código:

 Option Explicit
 
 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
 Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
 Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
 Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 
 Public Const HC_ACTION = 0
 Public Const WM_KEYDOWN = &H100
 Public Const WM_KEYUP = &H101
 Public Const WM_SYSKEYDOWN = &H104
 Public Const WM_SYSKEYUP = &H105
 Public Const WH_KEYBOARD_LL = 13
 
 Public Type KBDLLHOOKSTRUCT
     vkCode As Long
     scanCode As Long
     flags As Long
     time As Long
     dwExtraInfo As Long
 End Type
 
 Public Enum VirtualKey
   VK_LBUTTON = &H1
   VK_RBUTTON = &H2
   VK_CTRLBREAK = &H3
   VK_MBUTTON = &H4
   VK_BACKSPACE = &H8
   VK_TAB = &H9
   VK_ENTER = &HD
   VK_SHIFT = &H10
   VK_CONTROL = &H11
   VK_ALT = &H12
   VK_PAUSE = &H13
   VK_CAPSLOCK = &H14
   VK_ESCAPE = &H1B
   VK_SPACE = &H20
   VK_PAGEUP = &H21
   VK_PAGEDOWN = &H22
   VK_END = &H23
   VK_HOME = &H24
   VK_LEFT = &H25
   VK_UP = &H26
   VK_RIGHT = &H27
   VK_DOWN = &H28
   VK_PRINTSCREEN = &H2C
   VK_INSERT = &H2D
   VK_DELETE = &H2E
   VK_0 = &H30
   VK_1 = &H31
   VK_2 = &H32
   VK_3 = &H33
   VK_4 = &H34
   VK_5 = &H35
   VK_6 = &H36
   VK_7 = &H37
   VK_8 = &H38
   VK_9 = &H39
   VK_A = &H41
   VK_B = &H42
   VK_C = &H43
   VK_D = &H44
   VK_E = &H45
   VK_F = &H46
   VK_G = &H47
   VK_H = &H48
   VK_I = &H49
   VK_J = &H4A
   VK_K = &H4B
   VK_L = &H4C
   VK_M = &H4D
   vk_n = &H4E
   VK_O = &H4F
   VK_P = &H50
   VK_Q = &H51
   VK_R = &H52
   VK_S = &H53
   VK_T = &H54
   VK_U = &H55
   VK_V = &H56
   VK_W = &H57
   VK_X = &H58
   VK_Y = &H59
   VK_Z = &H5A
   VK_LWINDOWS = &H5B
   VK_RWINDOWS = &H5C
   VK_APPSPOPUP = &H5D
   VK_NUMPAD_0 = &H60
   VK_NUMPAD_1 = &H61
   VK_NUMPAD_2 = &H62
   VK_NUMPAD_3 = &H63
   VK_NUMPAD_4 = &H64
   VK_NUMPAD_5 = &H65
   VK_NUMPAD_6 = &H66
   VK_NUMPAD_7 = &H67
   VK_NUMPAD_8 = &H68
   VK_NUMPAD_9 = &H69
   VK_NUMPAD_MULTIPLY = &H6A
   VK_NUMPAD_ADD = &H6B
   VK_NUMPAD_PLUS = &H6B
   VK_NUMPAD_SUBTRACT = &H6D
   VK_NUMPAD_MINUS = &H6D
   VK_NUMPAD_MOINS = &H6D
   VK_NUMPAD_DECIMAL = &H6E
   VK_NUMPAD_POINT = &H6E
   VK_NUMPAD_DIVIDE = &H6F
   VK_F1 = &H70
   VK_F2 = &H71
   VK_F3 = &H72
   VK_F4 = &H73
   VK_F5 = &H74
   VK_F6 = &H75
   VK_F7 = &H76
   VK_F8 = &H77
   VK_F9 = &H78
   VK_F10 = &H79
   VK_F11 = &H7A
   VK_F12 = &H7B
   VK_NUMLOCK = &H90
   VK_SCROLL = &H91
   VK_LSHIFT = &HA0
   VK_RSHIFT = &HA1
   VK_LCONTROL = &HA2
   VK_RCONTROL = &HA3
   VK_LALT = &HA4
   VK_RALT = &HA5
   VK_POINTVIRGULE = &HBA
   VK_ADD = &HBB
   VK_PLUS = &HBB
   VK_EQUAL = &HBB
   VK_VIRGULE = &HBC
   VK_SUBTRACT = &HBD
   VK_MINUS = &HBD
   VK_MOINS = &HBD
   VK_UNDERLINE = &HBD
   VK_POINT = &HBE
   VK_SLASH = &HBF
   VK_TILDE = &HC0
   VK_LEFTBRACKET = &HDB
   VK_BACKSLASH = &HDC
   VK_RIGHTBRACKET = &HDD
   VK_QUOTE = &HDE
   VK_APOSTROPHE = &HDE
 End Enum
 
 Dim p As KBDLLHOOKSTRUCT
 
 Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim fEatKeystroke As Boolean
   If (nCode = HC_ACTION) Then
     If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
       CopyMemory p, ByVal lParam, Len(p)
       fEatKeystroke = _
         (p.vkCode = VK_CAPSLOCK) Or _
         (p.vkCode = VK_LWINDOWS) Or _
         (p.vkCode = VK_RWINDOWS) Or _
         (p.vkCode = VK_APPSPOPUP) Or _
         ((p.vkCode = VK_SPACE) And ((GetKeyState(VK_ALT) And &H8000) <> 0)) Or _
         ((p.vkCode = VK_TAB) And ((GetKeyState(VK_ALT) And &H8000) <> 0)) Or _
         ((p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0))
     End If
   End If
   If fEatKeystroke Then
     LowLevelKeyboardProc = -1
   Else
     LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
   End If
 End Function 

--------------------------------------------------------------
Es mucho texto, sugiero Copiar y Pegar.

Para bloquear en cualquier momento se debe escribir la sigueinte setencia:

Código:

 hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0) 

Para desbloquear (ojo, esto es importantísimo, si no hay que resetear la máquina), se digita la siguiente sentencia:

Código:

 UnhookWindowsHookEx hhkLowLevelKybd 

Para bloquear y ocultar la barra de tareas (TaskBar)

En otro módulo (.BAS) digitar:

Código:

 Global Const SW_HIDE = 0
 Global Const SW_SHOWNORMAL = 1
 Global Const SW_SHOW = 5
 
 Public Declare Function FindWindowHandle Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long 

Para que se ejecute las funciones escribir las siguientes sentencias:

Código:

   Dim hWnd As Long
   Dim Res As Long
   hWnd = FindWindowHandle("shell_traywnd", Chr(0))
   Res = ShowWindow(hWnd, SW_HIDE) 

Y para desbloquear y mostrar de nuevo:

Código:

   hWnd = FindWindowHandle("shell_traywnd", Chr(0))
   Res = ShowWindow(hWnd, SW_SHOW) 

---------------------------------------------------------------

Por último para minimizar todas las ventanas incluso si están en modo gráfico como juegos,

En un módulo (.BAS) digitar lo siguiente:

Código:

 Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
 ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
 Public Const VK_LWIN = &H5B
 Public Const KEYEVENTF_KEYUP = &H2 

Para que se ejecute el proceso dar las siguientes instrucciones:

Código:

   Call keybd_event(VK_LWIN, 0, 0, 0)
   Call keybd_event(&H4D, 0, 0, 0)
   Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0) 

---------------------------------------------------------------


Listo, es todo, espero que con esto puedan trabajar todos los que han querido saber como bloquear todas esas cosillas en Windows XP, y ojo, si funciona con XP, yo monté un programa donde uso todos esos comandos y corre perfectamente en XP, no lo he probado en otros windows, pero lo que es W9x/Me es mucho más simple para bloquear y en W2000 puede que trabaje parecido al XP al menos la versión profesional, y en los Windows Server dudo que funcione.

Nos vemos!!! Pura vida!!!

[GeoAvila]

Pregunta :
Tipos de Conexiones a Bases de Datos en Visual Basic

Respuesta:
Bueno por alli yo investigando he econtrado estos tipos de conexiones

SQL Server

ODBC


Standard Security:

"Driver={SQL Server};Server=Aron1;Database=pubs;Uid=sa;Pwd=asda sd;"


Trusted connection:

"Driver={SQL Server};Server=Aron1;Database=pubs;Trusted_Connect ion=yes;"


Prompt for username and password:

oConn.Properties("Prompt") = adPromptAlways
oConn.Open "Driver={SQL Server};Server=Aron1;DataBase=pubs;"

Access

ODBC


Standard Security:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;Uid=Admin;Pwd=;"


Workgroup:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;SystemDB=C:\mydatab ase.mdw;"


Exclusive:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;Exclusive=1;Uid=adm in;Pwd="

Oracle

ODBC


New version:

"Driver={Microsoft ODBC for Oracle};Server=OracleServer.world;Uid=Username;Pwd =asdasd;"


Old version:

"Driver={Microsoft ODBC Driver for Oracle};ConnectString=OracleServer.world;Uid=myUse rname;Pwd=myPassword;"

MySQL

ODBC


Local database:

"Driver={mySQL};Server=mySrvName;Option=16834;Data base=mydatabase;"


Remote database:

"Driver={mySQL};Server=data.domain.com;Port=3306;O ption=131072;Stmt=;Database=my-database;Uid=username;Pwd=password;"

Interbase

ODBC, Easysoft


Local computer:

"Driver={Easysoft IB6 ODBC};Server=localhost;Database=localhost:C:\mydat abase.gdb;Uid=username;Pwd=password"


Remote Computer:

"Driver={Easysoft IB6 ODBC};Server=ComputerName;Database=ComputerName:C: \mydatabase.gdb;Uid=username;Pwd=password"



ODBC, Intersolv


Local computer:

"Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};Server=localhost;Database=localhost:C:\my database.gdb;Uid=username;Pwd=password"


Remote Computer:

"Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};Server=ComputerName;Database=ComputerName :C:\mydatabase.gdb;Uid=username;Pwd=password"

Sybase

ODBC


Standard Sybase System 12 (or 12.5) Enterprise Open Client:

"Driver={SYBASE ASE ODBC Driver};Srvr=Aron1;Uid=username;Pwd=password"


Standard Sybase System 11:

"Driver={SYBASE SYSTEM 11};Srvr=Aron1;Uid=username;Pwd=password;"

Intersolv 3.10:

"Driver={INTERSOLV 3.10 32-BIT Sybase};Srvr=Aron1;Uid=username;Pwd=password;"


Sybase SQL Anywhere (former Watcom SQL ODBC driver):

"ODBC; Driver=Sybase SQL Anywhere 5.0; DefaultDir=c:\dbfolder\;Dbf=c:\mydatabase.db;Uid=u sername;Pwd=password;Dsn="""""



Informix

ODBC


Informix 3.30:

"Dsn='';Driver={INFORMIX 3.30 32 BIT};Host=hostname;Server=myserver;Service=service-name;Protocol=olsoctcp;Database=mydb;UID=username; PWD=myPwd


Informix-CLI 2.5:

"Driver={Informix-CLI 2.5 (32 Bit)};Server=myserver;Database=mydb;Uid=username;P wd=myPwd"

Mimer SQL

ODBC


Standard Security:

"Driver={MIMER};Database=mydb;Uid=myuser;Pwd=mypw; "


Prompt for username and password:

"Driver={MIMER};Database=mydb;"

DSN

ODBC


DSN:

"DSN=myDsn;Uid=username;Pwd=;"


File DSN:

"FILEDSN=c:\myData.dsn;Uid=username;Pwd=;"

Excel

ODBC


Standard:

"Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=C:\MyExcel.xls;DefaultDi r=c:\mypath;"

Text

ODBC


Standard:

"Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=c:\txtFilesFolder\;Extensions=asc,csv, tab,txt;"

DBF / FoxPro

ODBC


standard:

"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=c:\mydbpath;"

Visual FoxPro

ODBC


Database container (.DBC):

"Driver={Microsoft Visual FoxPro Driver};SourceType=DBC;SourceDB=c:\myvfpdb.dbc;Exc lusive=No;Collate=Machine;"


Free Table directory:

"Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=c:\myvfpdbfolder;E xclusive=No;Collate=Machine;"

Pervasive

ODBC


Standard:

"Driver={Pervasive ODBC Client Interface};ServerName=srvname;dbq=@dbname"

OLE DB


Standard:

"Provider=PervasiveOLEDB;Data Source=C:\path"

UDL

UDL


UDL:

"File Name=c:\myDataLink.udl;"

[GeoAvila]

pregunta:
¿como Imprimir en tamaño especial en Impresoras Matriciales en XP?

respuesta:
bueno yo tope con lo mismo y pedi soporte a Epson.es y me respondieron esto para las impresoras matriciales en windows XP con tamaño de papel "No", standar.

Para XP.

1. Acceda desde el botón INICIO (CONFIGURACIÓN) carpeta IMPRESORAS (Y
FAXES).

2. Seleccione el icono del driver haciendo un clic con el botón izquierdo
marcando el icono de la impresora EPSON.

3. Busque en el menú ARCHIVO la opción PROPIEDADES DEL SERVIDOR.

4. En la pestaña FORMULARIOS, active la casilla de verificación CREAR UN
NUEVO FORMULARIO.

5. Encontrará un cuadro de texto que dice DESCRIPCIÓN DEL FORMULARIO
(Medidas)

6. En este campo escriba un nombre que identifique su papel por ejemplo
NUEVO_FORMULARIO:

7. En el área MEDIDAS encontrará dos cuadros de valores que corresponderán a
la ANCHURA y ALTURA del formulario
que vaya a utilizar, si tiene seleccionado el botón MÉTRICO introduzca los
valores en centímetros.

8. Una vez introduzca las medidas tanto de altura como de anchura, pulse
sobre el botón GUARDAR FORMULARIO para
grabarlo y a partir de ese momento le aparecerá en la lista de la ventana
superior donde se puede escoger el papel
por defecto para esa impresora.

9. A continuación pulse sobre el botón ACEPTAR y le aparecerá para escoger
el nuevo papel NUEVO_FORMULARIO. En la
carpeta de impresoras, pulse el botón derecho del ratón sobre el icono de su
impresora, entre en 'Configuración predeterminada para este documento' y en
la pestaña de avanzadas, seleccione el tamaño de papel personalizado que
hemos creado.

Recuerde que es muy importante además de crear el formulario, definir en
la propia aplicación desde donde se
desea imprimir, el tamaño físico del formulario que deberá coincidir con las
medidas de NUEVO_FORMULARIO.

Esperamos que esta información le sea de utilidad.

Aprovechamos la ocasión para saludarle atentamente,

Centro de Atención al Cliente
EPSON IBÉRICA, S.A.U.


Espero les sirva a muchos...

[jpvm]

¿Solo numeros en un texbox?

Código PHP:

  Function SoloNumeros(ByVal KeyAscii As Integer) As Integer
      ' Intercepta un codigo ASCII recibido admitiendo solamente
      ' caracteres numéricos, además:
      ' cambia el punto por una coma
      ' acepta el signo -
      
      ' deja pasar sin afectar si recibe tecla de borrado o return
       If KeyAscii = Asc(".") Then KeyAscii = Asc(",")
       If InStr("0123456789.,-", Chr(KeyAscii)) = 0 Then
          SoloNumeros = 0
         Else
          SoloNumeros = KeyAscii
        End If
        ' teclas especiales permitidas
        If KeyAscii = 8 Then SoloNumeros = KeyAscii  borrado atras
        
    End Function
 
 
Private Sub txtvalor_KeyPress(KeyAscii As Integer)
KeyAscii = SoloNumeros(KeyAscii)
End Sub