Форум программистов [Powered by Invision Power Board]

Код

Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) 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
Private Declare Function SetWindowPos Lib "user32" (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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
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
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Const NORMAL_PRIORITY_CLASS = &H20&
Const INFINITE = -1&
Const SW_SHOWNORMAL = 1
Const GW_HWNDNEXT = 2

Dim workArea As RECT

Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
'Find the first window
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0
'Check if the window isn't a child
If GetParent(test_hwnd) = 0 Then
'Get the window's thread
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
'retrieve the next window
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function

Private Sub Main()


' константы для wFlags
Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Const SWP_HIDEWINDOW = &H80
Const SWP_NOACTIVATE = &H10
Const SWP_NOCOPYBITS = &H100
Const SWP_NOMOVE = &H2
Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering
Const SWP_NOREDRAW = &H8
Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Const SWP_SHOWWINDOW = &H40

' константы для hWndInsertAfter
Const HWND_BOTTOM = 1
Const HWND_BROADCAST = &HFFFF&
Const HWND_DESKTOP = 0
Const HWND_NOTOPMOST = -2
Const HWND_TOP = 0
Const HWND_TOPMOST = -1

Const SPI_GETWORKAREA = 48

Dim Pid1 As Long, Pid2 As Long
Dim wr As Long, wb As Long
Dim hWnd1 As Long, hwnd2 As Long
Dim AppName As String
Dim sFinal As String
Dim s As String

Call SystemParametersInfo(SPI_GETWORKAREA, vbNull, workArea, 0)

wr = workArea.Right
wb = workArea.Bottom

AppName = "D:\1.xls"
sFinal = AppName
'If (Right(AppName, 4) <> ".exe") Then
s = String$(255, 0)
FindExecutable sFinal, "", s
sFinal = Mid$(s, 1, InStr(1, s, Chr$(0)) - 1) & " """ & sFinal & """"
'End If

Pid1 = Shell(sFinal, vbNormalFocus)
hWnd1 = InstanceToWnd(Pid1)

'MsgBox "Идентификатор процесса: " & Pid1 & vbCrLf _
& "Дескриптор окна:" & hWnd1 & vbCrLf

SetWindowPos hWnd1, HWND_TOPMOST, 0, 0, 2 * wr / 3, wb, SWP_SHOWWINDOW
'MoveWindow hWnd1, 0, 0, 2 * wr / 3, wb, 1