de Grenville Tryon Pera

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

141	Color de fondo en un Treeview	Como obtener los nombres de las bases de datos en un servidor SQL
142	Disparar eventos	Como poner en boton derecho (fuera de VB) un Shortcut
143	Mail con attachement	Cambiar color de un richtextobox desde codigo en VB
144	Direcciones MAPI de Windows	Como crear un DSN desde Visual Basic
145	Como imprimir un chart desde mschart	Como puede obtener los primeros 'n' registros en una sentencia SQL.
146	Obtener nombres y clases de las ventanas abiertas	Capturar las teclas de desplazamiento en un textbox
147	Ordenar facilmente el Tabkey	Como cerrar programas desde VB
148	Dejar que el usuario haga resize de sus controles	Como obtener el nombre de dominio en NT
149	Utilizar iconos del Windows	Como ejecutar comandos de otra ventana
150	Cargar imagenes del archivo de recursos	Como realizar una busqueda en un Combobox

COLOR DE FONDO DE UN TREEVIEW
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = -16&
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&
En el evento Form_Load() :
Dim nodX As Node
Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
nodX.EnsureVisible
TreeView1.style = tvwTreelinesText ' Style 4.
TreeView1.BorderStyle = vbFixedSingle
En el evento click del botón :
Dim lngStyle As Long
Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0)) 'cambiar el fondo a rojo
lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)

DISPARAR EVENTOS
CODE: Public event Success
In code somewhere
CODE: RaiseEvent Success
In your code where you will use your class type
CODE: Dim WithEvents MyClass as ClassWithEvents
and you will recieve a event (in the drop downs) in your code window
CODE: MyClass_Success

MAIL CON ATTACHEMENT
.MAPISession.LogonUI = True
.MAPISession.DownLoadMail = False
.MAPIMessages.AddressResolveUI = True
.MAPISession.SignOn
.MAPIMessages.SessionID = .MAPISession.SessionID
.MAPIMessages.Compose
.MAPIMessages.AttachmentIndex = 0
.MAPIMessages.AttachmentPosition = 0
.MAPIMessages.AttachmentPathName = sTextFileA
.MAPIMessages.AttachmentIndex = 1
.MAPIMessages.AttachmentPosition = 1
.MAPIMessages.AttachmentPathName = sTextFileB
.MAPIMessages.Send (False) ' FALSE = don't show message dialog just send
.MAPISession.SignOff
End With

DIRECCIONES MAPI DE WINDOWS
On Error GoTo err_ExportShowAddressBook
Dim oSession As MAPI.Session
Dim oRecips As MAPI.Recipients
Dim oRecip As MAPI.Recipient
Dim vRet As Variant
Dim i As Integer
Dim lret As Long
Dim oTemp As Object
Const CDO_Err_UserCancelled = &H80040113
'Prompt the user to log-on to their Exchange Profile
Set oSession = CreateObject("MAPI.Session")
oSession.Logon 'showdialog:=True ', newsession:=True
rdpParams.ExchangeProfile = oSession.Name
'Get the InfoStores object
Set oRecips = oSession.AddressBook(oRecips, "Address Dialog", False,True, 2)
If Not oRecips Is Nothing Then
ExportForm.txtTo.Text = ""
ExportForm.txtCC.Text = ""
For Each oRecip In oRecips
If oRecip.Type = CdoTo Then
ExportForm.txtTo.Text = ExportForm.txtTo.Text & oRecip.Name & "; "
End If
If oRecip.Type = CdoCc Then
ExportForm.txtCC.Text = ExportForm.txtCC.Text & oRecip.Name & "; "
End If
Next oRecip
If Len(ExportForm.txtTo.Text) >= 2 Then
ExportForm.txtTo.Text = Left(ExportForm.txtTo.Text,Len(ExportForm.txtTo.Text) - 2)
End If
If Len(ExportForm.txtCC.Text) >= 2 Then
ExportForm.txtCC.Text = Left(ExportForm.txtCC.Text,Len(ExportForm.txtCC.Text) - 2)
End If
End If
err_ExportShowAddressBook:
If Err.Number <> 0 Then
If Err.Number = -2147221229 Then
Set oRecips = Nothing
Resume Next
ElseIf Err.Number = -2147219963 Then
Resume Next
Else
MsgBox Err.Number & vbCrLf & Err.Description
endif
End If
End Sub

COMO IMPRIMIR UN CHART DEL MSCHART
MSChart1.EditCopy
Printer.Print " "
Printer.PaintPicture Clipboard.GetData(), 0, 0
Printer.EndDoc

OBTENER NOMBRES Y CLASES DE LAS VENTANAS
Option Explicit
Public Const GW_CHILD = 5
Public Const GW_HWNDNEXT = 2
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Sub AddChildWindows(ByVal hwndParent As Long, ByVal Level As Long)
Dim WT As String, CN As String, Length As Long, hwnd As Long
If Level = 0 Then
hwnd = hwndParent
Else
hwnd = GetWindow(hwndParent, GW_CHILD)
End If
Do While hwnd <> 0
WT = Space(256)
Length = GetWindowText(hwnd, WT, 255)
WT = Left$(WT, Length)
CN = Space(256)
Length = GetClassName(hwnd, CN, 255)
CN = Left$(CN, Length)
Me!Text1 = Me!Text1 & vbCrLf & String(2 * Level, ".") & WT & " (" & CN & ")"
AddChildWindows hwnd, Level + 1
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
End Sub
Sub Command1_Click()
Dim hwnd As Long
hwnd = GetTopWindow(0)
If hwnd <> 0 Then
AddChildWindows hwnd, 0
End If
End Sub

COMO ORDENAR FACILMENTE EL TABKEY

Para ordenar el orden de los controles de los tabkey, ubiquese en orden inverso, y presione 0 siempre en el tabkey.

DEJAR QUE EL USUARIO HAGA UN RESIZE DE SUS CONTROLES
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
' You can find more of these (lower) in the API Viewer. Here
' they are used only for resizing the left and right.
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nParam As Long
With Picture1
If (X > 0 And X < 100) Then
nParam = HTLEFT
ElseIf (X > .Width - 100 And X < .Width) Then
nParam = HTRIGHT
End If
If nParam Then
Call ReleaseCapture
Call SendMessage(.hWnd, WM_NCLBUTTONDOWN, nParam, 0)
End If
End With
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim NewPointer As MousePointerConstants
If (X > 0 And X < 100) Then
NewPointer = vbSizeWE
ElseIf (X > Picture1.Width - 100 And X < Picture1.Width) Then ' these too
NewPointer = vbSizeWE
Else
NewPointer = vbDefault
End If
If NewPointer <> Picture1.MousePointer Then
Picture1.MousePointer = NewPointer
End If
End Sub

UTILIZAR ICONOS DEL WINDOWS
Private Enum StandardIconEnum
IDI_ASTERISK = 32516& ' like vbInformation
IDI_EXCLAMATION = 32515& ' like vbExlamation
IDI_HAND = 32513& ' like vbCritical
IDI_QUESTION = 32514& ' like vbQuestion
End Enum
Private Declare Function LoadStandardIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconNum As
StandardIconEnum) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Sub Form_Paint()
Dim hIcon As Long
hIcon = LoadStandardIcon(0&, IDI_EXCLAMATION)
Call DrawIcon(Me.hDC, 10&, 10&, hIcon)
End Sub

CARGAR IMAGENES DE ARCHIVOS DE RECURSOS

Sub FillPictures(psdFrm As Form)
Dim lcl_Ctrl As Control
For Each lcl_Ctrl In psdFrm.Controls
If LCase(lcl_Ctrl.Tag) = "calendar" Then
Set lcl_Ctrl.Picture = LoadResPicture(lcl_ctrl.tag, vbResBitmap)
End If
Next
End Sub
Private Sub Form_Load()
Call FillPictures(Me)
End Sub