de Grenville Tryon Pera      

Aplicaciones

Controles

Trucos

Preguntas

Teoria

Internet

Enlaces

Casos

Surf

Las paginas de Visual Basic
Pagina  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

 

91 Menu de resolucion de pantalla   Como acceder al menu de resolucion de pantalla
92 Llenar un grid de datos   Llenar una grilla con datos
93 Crear un DSN   Como crear/editar/eliminar DSN desde VB
94 Pintar una parte de la pantalla   Pintar una parte de la pantalla en un PictureBox
95 Nombre de la PC   Determinar el nombre de la PC
96 RGB a Numero   Como convertir un RGB a un numero long/visceversa
97 Mostrar parte de la grilla visible desde codigo   Mostrar una parte de la grilla visible con codigo
98 Elegir un directorio   Como elegir un directorio
99 Crear un menu desde codigo   Como crear un menu desde codigo VB
100 Texto con fondo transparente para imprimir   Como pintar texto en mipresora sobre una imagen

 

Menu de resolucion de pantalla
Dim x As Long
x = Shell("Rundll32.exe shell32.dll,Control_RunDLL desk.cpl @0")

 

 

 

 

 

 

 

Llenar un Grid de datos
Grid1.Cols = 5 ' seis columnas, empezando a numerar desde 0
Grid1.Rows = 10 '
Para rellenarlo :
Dim intC as integer
for intC = 1 to grid1.rows
grid1.additem Rs("Campo1") & chr$(9) & Rs("Campo2") & chr$(9) & Format(Rs("Campo3"),"##,###,###") & chr$(9) & Rs("Campo4") & chr$(9) & Rs("Campo5")
next intc

 

 

 

 

 

Crear DSN en VB
'declaracion de constantes
Private Const ODBC_ADD_DSN = 1 ' Add data source
Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data source
Private Const vbAPINull As Long = 0& ' NULL Pointer
'delcaracion de funciones
#If Win32 Then
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
#Else
Private Declare Function SQLConfigDataSource Lib "ODBCINST.DLL" (ByVal hwndParent As Integer, ByVal fRequest As Integer, ByVal  lpszDriver As String, ByVal lpszAttributes As String) As Integer
#End If
Para crear un DSN :
#If Win32 Then
Dim intRet As Long
#Else
Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String
'usamos el driver de SQL Server porque es el mas comun
strDriver = "SQL Server"
'Asignamos los parametros separados por null.
strAttributes = "SERVER=SomeServer" & Chr$(0)
strAttributes = strAttributes & "DESCRIPTION=Temp DSN" & Chr$(0)
strAttributes = strAttributes & "DSN=DSN_TEMP" & Chr$(0)
strAttributes = strAttributes & "DATABASE=pubs" & Chr$(0)
strAttributes = strAttributes & "UID=sa" & Chr$(0)
strAttributes = strAttributes & "PWD=" & Chr$(0)
'Para mostrar el diálogo usar Form1.Hwnd en vez de vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver,strAttributes)
If intRet Then
MsgBox "DSN Creado"
Else
MsgBox "Fallo en la creación"
End If
'Para borrarlo :
#If Win32 Then
Dim intRet As Long
#Else
Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String
'usamos el driver de SQL Server porque es el mas comun
strDriver = "SQL Server"
'Asignamos los parametros separados por null.
strAttributes = "DSN=DSN_TEMP" & Chr$(0)
'Para mostrar el diálogo usar Form1.Hwnd en vez de vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, strDriver,strAttributes)
If intRet Then
MsgBox "DSN Eliminado"
Else
MsgBox "Fallo en el borrado"
End If
Para modificarlo:
#If Win32 Then
Dim intRet As Long
#Else
Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String
'usamos el driver de SQL Server porque es el mas comun
strDriver = "SQL Server"
'Asignamos los parametros separados por null.
strAttributes = "SERVER=OtroSomeServer" & Chr$(0)
strAttributes = strAttributes & "DESCRIPTION=Temp DSN modificado" & Chr$(0)
strAttributes = strAttributes & "DSN=DSN_TEMP" & Chr$(0)
strAttributes = strAttributes & "DATABASE=pubs" & Chr$(0)
strAttributes = strAttributes & "UID=sa" & Chr$(0)
strAttributes = strAttributes & "PWD=" & Chr$(0)
'Para mostrar el diálogo usar Form1.Hwnd en vez de vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_CONFIG_DSN, strDriver,strAttributes)
If intRet Then
MsgBox "DSN Modificado"
Else
MsgBox "Fallo en la modificacion"
End If

 

Pintar una parte de la pantalla
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Sub Command1_Click()
Const PIXEL = 3
pic1.ScaleMode = PIXEL
pic2.ScaleMode = PIXEL
hDestDC& = pic2.hDC
x& = 0: y& = 0
nWidth& = pic2.ScaleWidth
nHeight& = pic2.ScaleHeight
hSrcDC& = pic1.hDC
xSrc& = 0: ySrc& = 0
dwRop& = &HCC0020
Suc& = BitBlt(hDestDC&, x&, y&, nWidth&, nHeight&, hSrcDC&, xSrc&, ySrc&, dwRop&)
End Sub

 

 

 

NOMBRE DE LA PC
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim aux As String
Dim res As Long
aux = space$(255)
res = GetComputerName(aux, 255)
If res <> 0 Then aux = Left(aux, InStr(aux, Chr$(0)))
debug.print "El nombre del pc es " & aux

 

 

 

 



RGB a CMYK & HSL
Converting CMYK to CMY
Cyan = Min(1, Cyan*(1-Black)+Black)
Magenta = Min(1, Magenta*(1-Black)+Black)
Yellow = Min(1, Yellow*(1-Black)+Black)
'To convert the CMYK color 40-100-0-45 to CMY, the equations work out to
Cyan = Min(1, 0.40*(1-0.45)+0.45) = Min(1, 0.22+0.45) = 0.67
Magenta = Min(1, 1.00*(1-0.45)+0.45) = Min(1, 0.55+0.45) = 1.00
Yellow = Min(1, 0.00*(1-0.45)+0.45) = Min(1, 0.00+0.45) = 0.45
Converting CMY to RGB
Red = 255*(1-Cyan)
Green = 255*(1-Magenta)
Blue = 255*(1-Yellow)
'To convert the CMY color 67-100-45 to RGB, the computation would be
Red = 255*(1-0.67) = 255*(0.33) = 84
Green = 255*(1-1.00) = 255*(0.00) = 0
Blue = 255*(1-0.45) = 255*(0.55) = 140
Converting RGB to CMY
Cyan = 1-(Red/255)
Magenta = 1-(Green/255)
Yellow = 1-(Blue/255)
'Converting the RGB color 84-0-140 to CMY produces the expected result:
Cyan = 1-(84/255) = 1-0.33 = 0.67
Magenta = 1-(0/255) = 1-0.00 = 1.00
Yellow = 1-(140/255) = 1-0.55 = 0.45
Converting CMY to CMYK
Black = Min(Cyan, Magenta, Yellow)
Cyan = (Cyan-Black)/(1-Black)
Magenta = (Magenta-Black)/(1-Black)
Yellow = (Yellow-Black)/(1-Black)
Converting the CMY color 67-100-45 to CMYK works as below (find the
black value first so that you can use it in the C, M, and Y formulas).
Black = Min(0.67, 1.00, 0.45) = 0.45
Cyan = (0.67-0.45)/(1-0.45) = 0.22/0.55 = 0.40
Magenta = (1.00-0.45)/(1-0.45) = 0.55/0.55 = 1.00
Yellow = (0.45-0.45)/(1-0.45) = 0/0.55 = 0.00

 

MOSTRAR LA PARTE VISIBLE DE UN GRILLA AL USAR PGDN EN CODIGO
'En un grid con 45 o mas filas
For i = 1 To 45
MSFlexGrid1.Row = i
MSFlexGrid1.Text = i
If Not MSFlexGrid1.RowIsVisible(i + 2) Then '+ 2 Porque en ocasiones las ultimas filas supuestamente visibles no se ven
If i < 7 Then
MSFlexGrid1.TopRow = 1
Else
MSFlexGrid1.TopRow = i - 5 'El 5 y el 7
son valores aleatorios
End If
End If
Next i

 

 

ELEGIR UN DIRECTORIO
Private Type BrowseInfo
hWndOwner As Long
pidlRoot As Long
sDisplayName As String
sTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" (bBrowse As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" (ByVal lItem As Long, ByVal sDir As String) As Long
Public Function DirGet() As String
Dim tpBrowseInfo As BrowseInfo
Dim item As Long
Dim strDirName As String
With tpBrowseInfo
.hWndOwner = frmMainForm.hwnd
.pidlRoot = 0
.sDisplayName = Space$(260)
.sTitle = "Select Directory"
.ulFlags = 1 ' Return directory name.
.lpfn = 0
.lParam = 0
.iImage = 0
End With
item = SHBrowseForFolder(tpBrowseInfo)
If item Then
strDirName = Space$(260)
If SHGetPathFromIDList(item, strDirName) Then
DirGet = Left(strDirName, InStr(strDirName, Chr$(0)) - 1)
Else
' DirGet = kNO_TEXT
DirGet = ""
End If
End If
End Function

 

CREAR UN MENU CON CODIGO
Private Sub Command1_Click()
Dim MyDb As Database, MyRS As Recordset
Set MyDb = OpenDatabase("C:\My Documents\Biblio.mdb")
Set MyRS = MyDb.OpenRecordset("Authors")
MyRS.MoveFirst
mnuDataItem(0).Caption = MyRS!Author
MyRS.MoveNext
For i = 1 To 10
Load mnuDataItem(i)
mnuDataItem(i).Caption = MyRS!Author
MyRS.MoveNext
Next
End Sub
'---Seleccion del menu
Private Sub mnuDataItem_Click(Index As Integer)
MsgBox "You selected " & mnuDataItem(Index).Caption
If mnuDataItem(Index).Caption = "Arntson, L. Joyce" Then
MsgBox "Joyce is a babe!"
End If
End Sub
'----remover items
Private Sub Command2_Click()
While mnuDataItem.Count > 1
Unload mnuDataItem(mnuDataItem.Count - 1)
Wend
End Sub


 

TEXTOS CON FONDO TRANSPARENTE PARA IMPRIMIR
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetBkMode Lib "gdi32" (ByVal hDC As Long) As Integer
Private iBKMode as Long
Private Const TRANSPARENT = 1
Private Const OPAQUE = 2
Printer.Print ""
Printer.Line (0,0)-(10000, 2000), &HC0C0C0, BF
Printer.CurrentX = 0
Printer.CurrentY = 0
Printer.FontTransparent = True
'Poner el "background mix mode" a transparente
iBKMode = SetBKMode(Printer.Hdc, TRANSPARENT)
Printer.Print "Printer.FontTransparent = " & Printer.FontTransparent
Printer.FontTransparent = False
'Poner el "background mix mode" a opaco
iBKMode = SetBKMode(Printer.Hdc, OPAQUE)
Printer.Print "Printer.FontTransparent = " & Printer.FontTransparent
Printer.EndDoc