VPF::программное размещение окон на экране

valex13

Дата 8.4.2005, 07:49 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 243
Регистрация: 29.1.2003
Где: Иркук. область, г . Иркутск

Репутация: 1
Всего: 1

Можно воспользоваться универсальной функцией поиска окна. Она описана в MSDN
Выкладываю:

Код


Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function apiGetWindow Lib "user32" Alias _
         "GetWindow" (ByVal hwnd As Long, ByVal wCmd As L

Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5
Public Const GWW_ID = (-12)
   
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = -20
Public Const GW_OWNER = 4


Function FindWindowLike(hWndArray() As Integer, ByVal hWndStart As _
      Integer, WindowText As String, Classname As String, ID) As Integer
   Dim hwnd As Integer
   Dim sWindowText As String
   Dim sClassname As String
   Dim sID
   Dim r As Integer
   ' Hold the level of recursion:
   Static level As Integer
   ' Hold the number of matching windows:
   Static iFound As Integer

   ' Initialize if necessary:
   If level = 0 Then
      iFound = 0
      ReDim hWndArray(0 To 0)
      If hWndStart = 0 Then hWndStart = GetDesktopWindow()
   End If

   ' Increase recursion counter:
   level = level + 1

   ' Get first child window:
   hwnd = apiGetWindow(hWndStart, GW_CHILD)

   Do Until hwnd = 0
      DoEvents ' Not necessary
      ' Search children by recursion:
      r = FindWindowLike(hWndArray(), hwnd, WindowText, Classname, ID)

      ' Get the window text and class name:
      sWindowText = Space(255)
      r = apiGetWindowText(hwnd, sWindowText, 255)
      sWindowText = Left(sWindowText, r)
      sClassname = Space(255)
      r = apiGetClassName(hwnd, sClassname, 255)
      sClassname = Left(sClassname, r)

      ' If window is a child get the ID:
      If apiGetParent(hwnd) <> 0 Then
         r = apiGetWindowWord(hwnd, GWW_ID)
         sID = CLng("&H" & Hex(r))
      Else
         sID = Null
      End If

      ' Check that window matches the search parameters:
      If sWindowText Like WindowText And sClassname Like Classname Then
         If IsNull(ID) Then
            ' If find a match, increment counter and add handle to array:
            iFound = iFound + 1
            ReDim Preserve hWndArray(0 To iFound)
            hWndArray(iFound) = hwnd
         ElseIf Not IsNull(sID) Then
            If sID = CLng(ID) Then
               ' If find a match increment counter and add handle to array:
               iFound = iFound + 1
               ReDim Preserve hWndArray(0 To iFound)
               hWndArray(iFound) = hwnd
            End If
         End If
      End If

      ' Get next child window:
      hwnd = apiGetWindow(hwnd, GW_HWNDNEXT)
   Loop

   ' Decrement recursion counter:
   level = level - 1

   ' Return the number of windows found:
   FindWindowLike = iFound
End Function

А искать окно можно так:

Код


      Static hWnds() As Integer
      r = FindWindowLike(hWnds(), 0, "Какой-то заголовок*", "*", Null)
      If r > 0 Then
            MsgBox "Нашел - " & CStr(hWnds(r))
      end if

Таким образом, ты можешь найти hWND обоих окон. В качестве параметра поиска окна по заголовку передай *FileName1 и *FileName2, а затем воспользуйся API функции для изменения размеров.
Однако, для этого нужно знать размеры экрана. Расширение!

kb-nn

Дата 18.4.2005, 14:13 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 227
Регистрация: 23.12.2003
Где: Нижний Новгород

Репутация: нет
Всего: 1

что- то я ничего не понимаю.
у меня вообще, как будто от функции MoveWindow толку не видно.
что бы я ей не давал, она ничего не меняет...

Exception

Дата 19.4.2005, 11:06 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 4525
Регистрация: 26.12.2004

Репутация: 7
Всего: 186

Ну ты попробуй с разными hwnd, эйчвинд вэбэ попробуй...
Может и правда

Цитата

По моему окно не успевает создаться, а ты уже его энумить собрался

kb-nn

Дата 19.5.2005, 12:29 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 227
Регистрация: 23.12.2003
Где: Нижний Новгород

Репутация: нет
Всего: 1

что- то я не понял.
что значит с разными hwnd?

Гость_Run-time Error

Дата 19.5.2005, 15:51 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Ну может у тебя конкретно с этим окном не выходит smile

а с окном vb может выйти. тогда будешь знать, где ошибка smile

__Sergey__

Дата 19.5.2005, 16:00 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 67
Регистрация: 21.1.2005

Репутация: 4
Всего: 4

Ну ты и растянул эту бадягу smile

Я уже пробовал. Вставь Sleep, как я выше писал и расслабся.
Добавлено @ 16:01
Со Sleep все работает smile

kb-nn

Дата 24.5.2005, 12:50 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 227
Регистрация: 23.12.2003
Где: Нижний Новгород

Репутация: нет
Всего: 1

со sleep у меня окно сворачивается через указанное время.

Exception

Дата 24.5.2005, 16:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 4525
Регистрация: 26.12.2004

Репутация: 7
Всего: 186

__Sergey__,
kb-nn,
просто сраыните друг с другом свой код и все smile

kb-nn

Дата 5.5.2006, 17:20 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 227
Регистрация: 23.12.2003
Где: Нижний Новгород

Репутация: нет
Всего: 1

простите, я всё о своем, о наболевшем....
у меня начало работать, но SetWindowPos срабатывает не для всех файлов.
(вручную для них размеры меняются и перемещаются без проблем)

может у вас появится мысля- от чего это может зависеть?

Код


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

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »