Autor
mmm en lugar de solo criticar la funcion pondre una de mi tutela que uso para esto, es decir centrar las cosas por medio de su hWnd, Sirve con:
* Objetos del form ( Botones, frames, etc... ).
* Ventanas ( de la aplicacion o externas ).
* Pantalla ( Centra el objeto con restecto a la pantalla ).
* Funciona con TODO lo que tenga un hWnd valido.
Codigo Actualizado:
Código
'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Código siempre y cuando //
' // no se eliminen los créditos originales de este código //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este código //
' ////////////////////////////////////////////////////////////////
' //
' ////////////////////////////////////////////////////////////////
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Enum WS_InCenterOpt
InScreen = 0
InObject = 1
InParent = 2
InWinExtern = 3
End Enum
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Function WinCenterIn(ByVal hwnd As Long, Optional ByVal InhWnd As Long = 0, Optional ByVal Opt As WS_InCenterOpt = InParent)
Dim st_retm As RECT
Dim st_retd As RECT
Dim st_pt As POINTAPI
If GetWindowRect(hwnd, st_retm) <> 0 Then
Select Case Opt
Case InObject, InParent, InWinExtern
If Opt = InParent Then
InhWnd = GetParent(hwnd)
If InhWnd = 0 Then
WinCenterIn = WinCenterIn(hwnd, 0, InScreen)
End If
End If
If GetWindowRect(InhWnd, st_retd) = 0 Then
Exit Function
End If
Case InScreen
st_retd.Bottom = GetSystemMetrics(&H1)
st_retd.Right = GetSystemMetrics(&H0)
Case Else
Exit Function
End Select
st_pt.x = st_retd.Left + ((st_retd.Right - st_retd.Left) - (st_retm.Right - st_retm.Left)) \ 2
st_pt.y = st_retd.Top + ((st_retd.Bottom - st_retd.Top) - (st_retm.Bottom - st_retm.Top)) \ 2
If Opt <> InWinExtern Then
Call ScreenToClient(InhWnd, st_pt)
End If
WinCenterIn = MoveWindow(hwnd, st_pt.x, st_pt.y, (st_retm.Right - st_retm.Left), (st_retm.Bottom - st_retm.Top), 1) <> 0
End If
End Function
Ejemplo:
Código
Option Explicit
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub Command2_Click()
WinCenterIn Me.hwnd
WinCenterIn FindWindowA(vbNullString, "Administrador de tareas de Windows"), Me.hwnd, InWinExtern
'WinCenterIn Me.hwnd, FindWindowA(vbNullString, "Administrador de tareas de Windows"), InWinExtern
End Sub
Version Anterior:
Código:
'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Código siempre y cuando //
' // no se eliminen los créditos originales de este código //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este código //
' ////////////////////////////////////////////////////////////////
' //
' ////////////////////////////////////////////////////////////////
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Function WinCenterIn(ByVal hwnd As Long, Optional ByVal InhWnd As Long = 0, Optional ByVal WinExterna As Boolean)
Dim st_retm As RECT
Dim st_retd As RECT
Dim st_pt As POINTAPI
If GetWindowRect(hwnd, st_retm) = 0 Then
Exit Function
End If
If InhWnd = 0 Then
st_retd.Bottom = GetSystemMetrics(&H1)
st_retd.Right = GetSystemMetrics(&H0)
Else
If GetWindowRect(InhWnd, st_retd) = 0 Then
Exit Function
End If
End If
st_pt.x = st_retd.Left + (Abs((st_retd.Right - st_retd.Left) - (st_retm.Right - st_retm.Left))) \ 2
st_pt.y = st_retd.Top + (Abs((st_retd.Bottom - st_retd.Top) - (st_retm.Bottom - st_retm.Top))) \ 2
If Not WinExterna And InhWnd = 0 Then
Call ScreenToClient(InhWnd, st_pt)
Else
Call ScreenToClient(InhWnd, st_pt)
st_pt.x = st_pta.x + st_pt.x
st_pt.y = st_pta.y + st_pt.y
End If
WinCenterIn = MoveWindow(hwnd, st_pt.x, st_pt.y, (st_retm.Right - st_retm.Left), (st_retm.Bottom - st_retm.Top), 1) <> 0
End Function
La implementacion es bastante sencilla.
Código
WinCenterIn Command1.hwnd, Me.hwnd
WinCenterIn Command1.hwnd, 0
WinCenterIn me.hwnd, 0
Temibles Lunas!¡.
En línea
