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

 

61 Posicion del Mouse respecto a la pantalla   Determinar la posicion del mouse en la pantalla.
62 Ejecutar archivos vinculados   p.e. Como al seleciconar un .DOC se llama al Word
63 Puntero invisible   Desaparecer el puntoero del mouse
64 Poner un icono en el system-tray   Poner un icono en el System Tray, sin OCX.
65 Formatear un disco desde VB   Formatear un diskette desde VB
66 Ventana Siempre Adelante   Arrastrando, mover una ventana, no solo del titulo
67 Shortcut para aplicativos   Shortcut para ejecutar aplicativos desde VB.
68 Transacciones en SP   Control de transacciones en SQL (Aqui a traves de un Stored Procedure)
69 Poner un combo en un Grid   Como poner un combo en una grilla
70 Ventana MDI centrada   Poner una ventana MDI hija centrada en pantalla.

 

 

 

 

POSICION DEL MOUSE RESPECTO A LA PANTALLA
Type PointAPI
X As Long
Y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Sub Timer1_Timer()
Dim Result As Long
Dim Pos As PointAPI
Result = GetCursorPos(Pos)
If Result <> 0 Then
StatusBar1.SimpleText = Pos.X & "," & Pos.Y
Else
StatusBar1.SimpleText = "Error"
End If
End Sub

 


 

EJECUTAR ARCHIVOS VINCULADOS (EJ. WORD.DOC LLAMA A WORD)

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
dim res as long
res = ShellExecute(Me.hwnd, "Open", "c:\documento.doc","", "", 1)

 

 

 


PUNTERO INVISIBLE
Declare Function ShowCursor Lib "user32" Alias "ShowCursor" (ByVal bShow As Long) As Long
'Para mostrar el cursor:
l=ShowCursor(1&)
'Para ocultarlo :
l=ShowCursor(0&)


ANADIR UN TRAY-ICON EN VB
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Sub CreateIcon()
Dim Tic As NOTIFYICONDATA
Tic.cbSize = Len(Tic)
Tic.hwnd = Picture1.hwnd
Tic.uID = 1&
Tic.uFlags = NIF_DOALL
Tic.uCallbackMessage = WM_MOUSEMOVE
Tic.hIcon = Picture1.Picture
Tic.szTip = "Visual Basic Demo" & Chr$(0)
erg = Shell_NotifyIcon(NIM_ADD, Tic)
End Sub
Public Sub DeleteIcon()
Dim Tic As NOTIFYICONDATA
Tic.cbSize = Len(Tic)
Tic.hwnd = Picture1.hwnd
Tic.uID = 1&
erg = Shell_NotifyIcon(NIM_DELETE, Tic)
End Sub
Private Sub Command1_Click()
CreateIcon
End Sub
Private Sub Command2_Click()
DeleteIcon
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
X = X / Screen.TwipsPerPixelX
Select Case X
Case WM_LBUTTONDOWN
Caption = "Left Click"
Case WM_RBUTTONDOWN
Caption = "Right Click"
Case WM_MOUSEMOVE
Caption = "Move"
Case WM_LBUTTONDBLCLK
Caption = "Double Click"
End Select
End Sub


Formatear disco desde VB
Call FmFormat(form1)
Type Rect
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As Rect)
Declare Function IsWindow Lib "User" (ByVal hWnd As Integer) As Integer
Declare Function WinExec Lib "Kernel" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As Integer
Declare Function SetActiveWindow Lib "User" (ByVal hWnd As Integer) As Integer
Declare Function GetActiveWindow Lib "User" () As Integer
Declare Function LockWindowUpdate Lib "User" (ByVal hwndLock As Integer) As Integer
Declare Function GetDesktopWindow Lib "User" () As Integer
Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Integer
Const WM_COMMAND = &H111
Const WM_CLOSE = &H10
Dim wFlag%
Dim lpDlgRect As Rect
Dim lpDskRect As Rect
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Sub CenterDialog (WinText As String)
Do
If FindWindow(0&, WinText) Then Exit Do
x% = DoEvents()
Loop
wnd% = GetActiveWindow()
Call GetWindowRect(wnd%, lpDlgRect)
wdth% = lpDlgRect.Right - lpDlgRect.Left
hght% = lpDlgRect.Bottom - lpDlgRect.Top
Call GetWindowRect(GetDesktopWindow(), lpDskRect)
Scrwdth% = lpDskRect.Right - lpDskRect.Left
Scrhght% = lpDskRect.Bottom - lpDskRect.Top
x% = (Scrwdth% - wdth%) / 2
Y% = (Scrhght% - hght%) / 2
Call SetWindowPos(wnd%, 0, x%, Y%, 0, 0, SWP_NOZORDER Or SWP_NOSIZE)
End Sub
Sub FMFormat (F As Form)
FMhWnd = FindWindow("WFS_Frame", 0&)
If FMhWnd = 0 Then
i% = WinExec("Winfile", 0)
FMhWnd = FindWindow("WFS_Frame", 0&)
If FMhWnd = 0 Then
MsgBox "FileMan ain't home"
Exit Sub
End If
wFlag = 1
End If
i% = LockWindowUpdate(GetDesktopWindow())
i% = PostMessage(FMhWnd, WM_COMMAND, &HCB, 0)
Call CenterDialog("Format Disk")
i% = LockWindowUpdate(0)
wnd% = GetActiveWindow()
While IsWindow(wnd%)
x = DoEvents()
Wend
x = DoEvents()
If wFlag Then
wFlag = 0
i% = PostMessage(FMhWnd, WM_CLOSE, 0, 0)
End If
i% = SetActiveWindow(F.hWnd)
End Sub


Ventana siempre delante
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0,SWP_NOMOVE Or SWP_NOSIZE


 

Shortcut para aplicativos
Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Sub Command1_Click()
Dim lReturn As Long
'Add to Desktop
lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\Winnt\system32\calc.exe", "")
'Add to Program Menu Group
lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\Winnt\system32\calc.exe", "")
'Add to Startup Group
lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator","C:\Windows\Calc.exe", "")
End Sub


Transacciones en SP
CREATE PROCEDURE spNextId @CounterName varchar(50) AS
declare @CounterValue integer
select @CounterName = upper(@CounterName)
begin transaction
if exists(select * from tCounters where CounterName = @CounterName)
begin
select @CounterValue = CounterValue
from tCounters
where CounterName = @CounterName
end
else
begin
insert into tCounters (CounterName, CounterValue)
values (@CounterName, 0)
select @CounterValue = 0
end
select @CounterValue = @CounterValue + 1
update tCounters
set CounterValue = @CounterValue
where CounterName = @CounterName
commit transaction
select @CounterValue CounterValue
return


Poner un combo en un grid
Private Sub msfMonitoreo_Click(index As Integer)
'If msfMonitoreo(0).Row = 0 Then
msfMonitoreo(0).RowHeight(0) = Combo1.Height - 10
Combo1.Top = msfMonitoreo(0).Top + 20
Combo1.Left = msfMonitoreo(0).ColPos(msfMonitoreo(0).Col) + msfMonitoreo(0).Left + 40
Combo1.Width = msfMonitoreo(0).ColWidth(msfMonitoreo(0).Col) + 10
'End If
End Sub


Centrar un MDI Child
Sub CenterFormWithParent(aForm As Form, aParent As Form)
aForm.Left = aParent.Left + (aParent.Width - aForm.Width) / 2
aForm.Top = aParent.Top + (aParent.Height - aForm.Height) / 2
If (aForm.Left + aForm.Width) > Screen.Width Then
aForm.Left = Screen.Width - aForm.Width
Else
If aForm.Left < 0 Then aForm.Left = 0
End If
If (aForm.Top + aForm.Height) > Screen.Height Then
aForm.Top = Screen.Height - aForm.Height
Else
If aForm.Top < 0 Then aForm.Top = 0
End If
End Sub

Hosted by www.Geocities.ws

1