Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Как создать окно стороннего приложения на собствен Добавлено: 03.01.12 21:12  

Автор вопроса:  Эдик
Надо запустит ( встроит )другое ехе как дочернее окно. Помогите примерами пожалуйста.

Ответить

  Ответы Всего ответов: 13  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 04.01.12 22:09
встраивать примерно так
  1. Option Explicit
  2. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  3. Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  4. Private Declare Function MoveWindow Lib "user32.dll" (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
  5.  
  6. Private Sub Form_Load()
  7.     ScaleMode = vbPixels
  8.     Dim wnd As Long
  9.     wnd = FindWindow(vbNullString, "Калькулятор")
  10.     If wnd Then
  11.         SetParent wnd, hwnd
  12.         MoveWindow wnd, ScaleWidth / 2 - 100, ScaleHeight / 2 - 100, 200, 200, 1
  13.     Else
  14.         MsgBox "Калькулятор не найден"
  15.     End If
  16. End Sub

Ответить

Номер ответа: 2
Автор ответа:
 Эдик



Вопросов: 19
Ответов: 23
  Профиль | | #2 Добавлено: 05.01.12 10:13
Огромное Спасибо. Такое не часто встречается
Запустил калькулятор ,а потом форму.(Сперва простой а потом MDI)
  - При простой форме (VB6)
 все ОК но калькулятор из за строки 32 полностью не показывается. (раскрывается).После комментирования (с последующим снятием ) этой строки все стало ОК.???
При закрытие формы калькулятор остался в памяти

  - при MDI форме (VB6)
      строка 07. ScaleMode = vbPixels выдает ошибку “Variable not defined” из за отсутствия
      при минимизирование калькулятор исчез из виду
      при закрытие формы калкулятор остался в памяти
1. Пожалуйста исправте мои ощибки
2. Сделайте пожалуйста так ,чтоб код был приемлем и для MDI форм.
За ранее багодарью
  1.  
  2. Option Explicit
  3.    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  4.    Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  5.    Private Declare Function MoveWindow Lib "user32.dll" (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
  6.  
  7.  Private Sub MDIForm_Load()
  8.  ‘ Private Sub Form_Load()
  9.             ScaleMode = vbPixels ‘“Variable not defined”
  10. ‘Private Sub Command1_Click()
  11.   ' Private Sub mnuCalcExe_Click()
  12. Dim rc As Double
  13. rc = Shell("calc.exe")
  14. Dim wnd As Long
  15.        wnd = FindWindow(vbNullString, "Калькулятор Плюс")
  16.        If wnd Then
  17.            SetParent wnd, hwnd
  18.            'MoveWindow wnd, ScaleWidth / 2 - 100, ScaleHeight / 2 - 100, 200, 200, 1
  19.        End If
  20. End Sub

Ответить

Номер ответа: 3
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #3 		Добавлено: 05.01.12 17:18
у меня калькулятор завершается сам. В принципе можно его убить вручную, я думаю. Но я не стану заморачиваться.
  1. Option Explicit
  2. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  3. Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  4. Private Declare Function MoveWindow Lib "user32.dll" (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
  5. Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
  6. Private Type RECT
  7.     Left As Long
  8.     Top As Long
  9.     Right As Long
  10.     Bottom As Long
  11. End Type
  12.  
  13. Private Sub MDIForm_Load()
  14.     Dim wnd As Long
  15.     wnd = FindWindow(vbNullString, "Êàëüêóëÿòîð")
  16.     If wnd Then
  17.         SetParent wnd, hwnd
  18.         Dim rc As RECT, w As Long, h As Long
  19.         GetWindowRect wnd, rc
  20.         w = rc.Right - rc.Left
  21.         h = rc.Bottom - rc.Top
  22.         MoveWindow wnd, (WidthPix - w) / 2, (HeightPix - h) / 2, _
  23.                    w, h, 1
  24.     Else
  25.         MsgBox "Êàëüêóëÿòîð íå íàéäåí"
  26.     End If
  27. End Sub
  28.  
  29. Private Property Get WidthPix() As Long
  30.     Dim rc As RECT
  31.     Call GetWindowRect(hwnd, rc)
  32.     WidthPix = rc.Right - rc.Left
  33. End Property
  34.  
  35. Private Property Get HeightPix() As Long
  36.     Dim rc As RECT
  37.     Call GetWindowRect(hwnd, rc)
  38.     HeightPix = rc.Bottom - rc.Top
  39. End Property

Ответить

Номер ответа: 4
Автор ответа:
 Эдик



Вопросов: 19
Ответов: 23
  Профиль | | #4 Добавлено: 05.01.12 20:21
Winand
Благодарю за ответ.
 
Winand пишет:
Но я не стану заморачиваться.

Я не прощу «заморачиваться».Я прощу знающего помочь.
  - При минимизирование калькулятора он куда та исчезает.А в простом форме он минимизируется в форме
  - При закрытие MDI формы все равно « calc.exe » остается в памяти. В диспетчере задач его видно.

Ответить

Номер ответа: 5
Автор ответа:
 Ким Чен Ир



Вопросов: 0
Ответов: 140
  Профиль | | #5 Добавлено: 06.01.12 05:04
Если на время отбросить мысль о нелепости задания, то можно посоветовать установить родителем не главное MDI окно, а его дочернее - MDIClient. Правда, сомневаюсь, что получиться красиво организовать вызов DefMDIChildProc.
Функция Shell возвращает PID, по нему можно завершать чужой процесс.

Ответить

Номер ответа: 6
Автор ответа:
 Эдик



Вопросов: 19
Ответов: 23
  Профиль | | #6 Добавлено: 06.01.12 10:06
Winand
Ким Чен Ир
Ну допустим кто ни будь написал какую ни будь программу (Freeware) и он мне понравился. А код мне не доступен и я не могу такого написать. Но программа нужная. Что остается бедному юзеру. Попросить знающих – Как стотонную программу встроит в свою. Так и права не нарушается. Вот и Winand написал то, что пока на форуме не нашел. Все происходить когда VB программа закрывается , а сторонняя программа еще не закрыта. VB программа закрывается ,а он остается в памяти. Если его не убрать то он будет сидеть в памяти и использовать ресурсы машины. А если эту программу не выгрузить, то следующий раз при запуске в диспетчере задач их будет несколько.
 - Как выгрузить программы ?
Я собираюсь использовать 16 и 32 битовые программы. А 16 битовые проги в ХР открываются с помощью виртуальной машины(ntvdm.exe).Их пока мне не удалось встроит как дочернюю. ntvdm.exe даже при закрытие программы остается в памяти.
 - Как встроит 16 битовые программы ?

Ответить

Номер ответа: 7
Автор ответа:
 Ким Чен Ир



Вопросов: 0
Ответов: 140
  Профиль | | #7 Добавлено: 06.01.12 20:00
Ну разве что ради смеха...
  1. Option Explicit
  2. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  3. Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  4. Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
  5. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  6. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  7. Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
  8. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  9. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  10. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  11. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  12. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  13.  
  14. Private Const PROCESS_TERMINATE = 1
  15. Private Const SW_HIDE = 0
  16. Private Const SW_NORMAL = 1
  17. Private Const SW_SHOW = 5
  18. Private Const SW_MAXIMIZE = 3
  19. Private Const GWL_STYLE = (-16)
  20. Private Const WS_SYSMENU = &H80000
  21. Private Const GW_HWNDNEXT = 2
  22.  
  23. '
  24. Private hProcess1 As Long
  25. Private pid1 As Long
  26. Private hProcess2 As Long
  27. Private pid2 As Long
  28.  
  29.  
  30.  
  31. Private Sub MDIForm_Load()
  32.     Dim hwndClient As Long
  33.     hwndClient = FindWindowEx(hwnd, 0, "MDIClient", vbNullString)
  34.     Dim hwndmain1 As Long
  35.     Dim hwndmain2 As Long
  36.    ' pid1 = CLng(Shell("cmd.exe", vbHide))
  37.     pid1 = CLng(Shell("C:\Windows\dosrep.exe", vbHide))
  38.     Sleep 500
  39.     hProcess1 = OpenProcess(PROCESS_TERMINATE, 0, pid1)
  40.     hwndmain1 = hwndFromPid(pid1)
  41.     If CBool(hwndmain1) Then
  42.         SetParent hwndmain1, hwndClient
  43.         ShowWindow hwndmain1, SW_SHOW
  44.     End If
  45.  
  46.     pid2 = CLng(Shell("NOTEPAD.exe", vbHide))
  47.     hProcess2 = OpenProcess(PROCESS_TERMINATE, 0, pid2)
  48.     hwndmain2 = hwndFromPid(pid2)
  49.     If CBool(hwndmain2) Then
  50.         SetParent hwndmain2, hwndClient
  51.         ShowWindow hwndmain2, SW_SHOW
  52.     End If
  53. End Sub
  54.  
  55. Private Sub MDIForm_Unload(Cancel As Integer)
  56.     TerminateProcess hProcess1, 0
  57.     TerminateProcess hProcess2, 0
  58. End Sub
  59.  
  60. Private Function hwndFromPid(pid As Long) As Long
  61.     Dim hwtest As Long, pidtest As Long
  62.     hwtest = GetTopWindow(0)
  63.     Do While (CBool(hwtest))
  64.         GetWindowThreadProcessId hwtest, pidtest
  65.         If (pidtest = pid) Then
  66.             Dim style As Long
  67.             style = GetWindowLong(hwtest, GWL_STYLE)
  68.             If (style And WS_SYSMENU) And 0 = GetParent(hwtest) Then
  69.                 hwndFromPid = hwtest
  70.                 Exit Function
  71.                 End If
  72.         End If
  73.         hwtest = GetNextWindow(hwtest, GW_HWNDNEXT)
  74.     Loop
  75. End Function

Ответить

Номер ответа: 8
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #8 		Добавлено: 06.01.12 20:13
Ну допустим кто ни будь написал какую ни будь программу (Freeware) и он мне понравился. А код мне не доступен и я не могу такого написать. Но программа нужная. Что остается бедному юзеру.

Запустить программу в ОТДЕЛЬНОМ окне? зачем её встраивать в своё...

Ответить

Номер ответа: 9
Автор ответа:
 Ким Чен Ир



Вопросов: 0
Ответов: 140
  Профиль | | #9 Добавлено: 06.01.12 20:23
Он наверное думает, что эти программы войдут во вновь созданный экзешник :)

Ответить

Номер ответа: 10
Автор ответа:
 Эдик



Вопросов: 19
Ответов: 23
  Профиль | | #10 Добавлено: 07.01.12 11:29
Winand
Ким Чен Ир
Вам обоим БОЛЬШОЕ СПАСИБО. Вы сделали то, что до сих пор на форуме мне не встречался.РЕСПЕКТ вам. А теперь по порядку:
Winand пишет:
Запустить программу в ОТДЕЛЬНОМ окне? зачем её встраивать в своё

Допустим есть некое MDI приложение написанное на VB6.В программе выполняются разные вычислительные операции .Но часто приходиться кое что вычислять отдельно , переводить величины и делать инженерные вычисления и добавлять в свой отчет. Для этого как и вы задумали нужен калькулятор.Знаю что на VB6 можно написать калькулятор – а не лучше ли взять готовую и испытанную программу . Для примера возьмем Windows калькулятор .В нужный момент запускаем из меню основной программы Windows калькулятор, ставим его в самый край экрана, чтоб не загромождал наш отчет и кое что вычисляем , переходим на основное окно и добавляем информацию в документ. И вот здесь Windows калькулятор прячется за нашей программой – и это один из Неудобств. Потом опять активизируем Windows калькулятор и.т.д …..А нужно, чтоб Windows калькулятор постоянно был на виду.
Ким Чен Ир пишет:
Он наверное думает, что эти программы войдут во вновь созданный экзешник :)

 - Можно нужную программу в папке с основной программой держать ?
 - Можно его в Ресурсы ?(распаковывать файлы на жёсткий диск,оттуда запускать и после удалить )
 - Можно например сделать бинарный код файла прописать как то его в коде,
      и программу пользовать как бы из нутри? (imho)

Отличный код получился. С одним НО.
- Если два и более раза запустит Calc.exe или 16 битовую (следующие запуски16 бит прог не становятся дочерними ) программу и после этого закрыть основную программу, то запушенные программы остаются в памяти. А с блокнотом такое не случается.С Dosrep.exe не проверяйте .Он как то сразу вырубается и вырубает ntvdm.exe
Для теста http://illari.ru/electro/osc/ Wave Tools Oscilloscope (Paul Kellett)
http://illari.ru/electro/osc/files/oscilloscope.zip
Прим.: После выхода из программ в памяти остаются ntvdm.exe и wowexec.exe .
 - Пожалуйста поправьте мои ошибки .
  1.  
  2. Private Sub mnuCalc_Click()
  3.    Dim hwndClient As Long
  4.      hwndClient = FindWindowEx(hwnd, 0, "MDIClient", vbNullString)
  5.      Dim hwndmain1 As Long
  6.      Dim hwndmain2 As Long
  7.      pid2 = CLng(Shell("Calc.exe", vbHide))
  8.      hProcess2 = OpenProcess(PROCESS_TERMINATE, 0, pid2)
  9.      hwndmain2 = hwndFromPid(pid2)
  10. If CBool(hwndmain2) Then
  11.          SetParent hwndmain2, hwndClient
  12.          ShowWindow hwndmain2, SW_SHOW
  13. End If
  14. End Sub
  15.  
  16. Private Sub mnu16bit_Click()
  17.   Dim hwndClient As Long
  18.      hwndClient = FindWindowEx(hwnd, 0, "MDIClient", vbNullString)
  19.      Dim hwndmain1 As Long
  20.      Dim hwndmain2 As Long
  21.      pid1 = CLng(Shell("C:\oscilloscope\3_Oscilloscope\SCOPE.EXE", vbHide))
  22.     'pid1 = CLng(Shell("C:\Windows\Dosrep.exe", vbHide))
  23.      Sleep 500
  24.      hProcess1 = OpenProcess(PROCESS_TERMINATE, 0, pid1)
  25.      hwndmain1 = hwndFromPid(pid1)
  26. If CBool(hwndmain1) Then
  27.          SetParent hwndmain1, hwndClient
  28.          ShowWindow hwndmain1, SW_SHOW
  29. End If
  30. End Sub
  31.  
  32. Private Sub mnuNote_Click()
  33.    Dim hwndClient As Long
  34.      hwndClient = FindWindowEx(hwnd, 0, "MDIClient", vbNullString)
  35.      Dim hwndmain1 As Long
  36.      Dim hwndmain2 As Long
  37.              pid2 = CLng(Shell("NOTEPAD.exe", vbHide))
  38.      hProcess2 = OpenProcess(PROCESS_TERMINATE, 0, pid2)
  39.      hwndmain2 = hwndFromPid(pid2)
  40. If CBool(hwndmain2) Then
  41.          SetParent hwndmain2, hwndClient
  42.          ShowWindow hwndmain2, SW_SHOW
  43. End If
  44. End Sub

Ответить

Номер ответа: 11
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #11 		Добавлено: 07.01.12 19:58
Настаиваю на том, что это грязные хаки и так не делают. Альтернативный вариант - выводить приложение поверх всех окон. Часть кода скопипастил у кимченыра
  1. Option Explicit
  2. Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
  3. Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
  4. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  5. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  6. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  7. Private Const GWL_STYLE = (-16)
  8. Private Const WS_SYSMENU = &H80000
  9. Private Const GW_HWNDNEXT = 2
  10.  
  11. 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
  12. Private Const HWND_TOPMOST = -1
  13. Private Const SWP_NOMOVE = &H2
  14. Private Const SWP_NOSIZE = &H1
  15.  
  16. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  17. Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  18. Private Const PROCESS_TERMINATE = 1
  19. Private prc As Long
  20.  
  21. Private Sub Command1_Click()
  22.     Dim pid As Long, wnd As Long
  23.     pid = Shell("calc", vbNormalFocus)
  24.     prc = OpenProcess(PROCESS_TERMINATE, 0, pid)
  25.     If pid And prc Then
  26.         Do While wnd = 0
  27.             wnd = hwndFromPid(pid)
  28.         Loop
  29.         SetWindowPos wnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  30.     Else
  31.         MsgBox "Failed to get access to calculator app"
  32.     End If
  33. End Sub
  34.  
  35. Private Sub Form_Load()
  36.     WindowState = vbMaximized
  37. End Sub
  38.  
  39. Private Function hwndFromPid(pid As Long) As Long
  40.     Dim hwtest As Long, pidtest As Long
  41.     hwtest = GetTopWindow(0)
  42.     Do While (CBool(hwtest))
  43.         GetWindowThreadProcessId hwtest, pidtest
  44.         If (pidtest = pid) Then
  45.             Dim style As Long
  46.             style = GetWindowLong(hwtest, GWL_STYLE)
  47.             If (style And WS_SYSMENU) And 0 = GetParent(hwtest) Then
  48.                 hwndFromPid = hwtest
  49.                 Exit Function
  50.             End If
  51.         End If
  52.         hwtest = GetNextWindow(hwtest, GW_HWNDNEXT)
  53.     Loop
  54. End Function
  55.  
  56. Private Sub Form_Unload(Cancel As Integer)
  57.     If prc Then TerminateProcess prc, 0
  58. End Sub

Ответить

Номер ответа: 12
Автор ответа:
 Эдик



Вопросов: 19
Ответов: 23
  Профиль | | #12 Добавлено: 07.01.12 21:02
Winand
Спасибо.Если портабл vb6 на rutracker ваш, то вам благодарность отдельно.

Ответить

Номер ответа: 13
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #13 		Добавлено: 07.01.12 21:50
наш, да:-)

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам