| de Grenville Tryon Pera |
|
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