如何让自己的窗体做为一个程序的父窗体…

Question

SetParent 你的外部程序窗体的句柄, Me.hwnd

Answer 1

要知道窗体上有些什么控件Dim ctl As Control
    For Each ctl In Me.Controls
        Debug.Print ctl.Name
        Debug.Print TypeName(ctl)
    Next

Answer 2

Private Const GW_HWNDNEXT = 2Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal Hwnd As Long, _
    lpdwProcessId As Long) As Long
    
Private Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, _
    ByVal lpWindowName As Long) As Long
    
Private Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As LongPrivate Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long) As LongPrivate OldParent&
Private Hwnd1&Private Sub Form_Load()
  Drive1.Drive = App.Path
  Dir1.Path = App.Path
End SubPrivate Sub Dir1_Change()
  File1.Path = Dir1.Path
End SubPrivate Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub
Private Sub Command1_Click()                            '调用程序为本程序子窗口
  Dim myexe As Long
  Dim newhwnd As Long
  Dim newexe As Long
  Dim myvalue As Long  myexe = Shell(File1.Path & "\" & File1.FileName, vbNormalFocus)    '调用程序
  If myexe = 0 Then
     MsgBox ""
     Exit Sub
  End If
  newhwnd = FindWindow(ByVal 0&, ByVal 0&)               '获取windows句柄
  Do While newhwnd <> 0
     If GetParent(newhwnd) = 0 Then
        myvalue = GetWindowThreadProcessId(newhwnd, newexe)  '获取窗口的进程
        If newexe = myexe Then
           Hwnd1& = newhwnd
           Exit Do
        End If
     End If
        newhwnd = GetWindow(newhwnd, GW_HWNDNEXT)      '获取窗口值
    Loop
    OldParent& = SetParent(Hwnd1&, Me.Hwnd)              '指定本程序为打开程序的父窗口
End SubPrivate Sub Command2_Click()       '释放程序
  SetParent Hwnd1&, OldParent&
End SubPrivate Sub Command3_Click()
  End
End Sub

Answer 3

to litsnake1(litsnake) 我想得到是外部程序的控件呀。谢谢

Answer 4

如果你是要枚举外部程序中的所有控件：'form1 codePrivate Sub Command1_Click()    
   Call EnumChildWindows(这里是外部程序窗体的句柄, AddressOf EnumChildProc, &H0)End Sub'module code
Public Declare Function EnumChildWindows Lib "user32" _
  (ByVal hWndParent As Long, _
   ByVal lpEnumFunc As Long, _
   ByVal lParam As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" _
    Alias "GetWindowTextLengthA" _
   (ByVal hwnd As Long) As Long
    
Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
    
Private Declare Function GetClassName Lib "user32" _
    Alias "GetClassNameA" _
   (ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
Public Function EnumChildProc(ByVal hwnd As Long, _
                              ByVal lParam As Long) As Long
   
  'working vars
   Dim sTitle As String
   Dim sClass As String
   Dim sIDType As String
   Dim itmX As ListItem  'get the window title / class name
   sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
'这里显示出所有的控件名，类型，caption
  Debug.Print sTitle
  Debug.Print sIDType
  Debug.Print sClass
   Debug.Print "   "
   EnumChildProc = 1
   
End Function
Private Function GetWindowIdentification(ByVal hwnd As Long, _
                                         sIDType As String, _
                                         sClass As String) As String   Dim nSize As Long
   Dim sTitle As String  'get the size of the string required
  'to hold the window title
   nSize = GetWindowTextLength(hwnd)
   
  'if the return is 0, there is no title
   If nSize > 0 Then
   
      sTitle = Space$(nSize + 1)
      Call GetWindowText(hwnd, sTitle, nSize + 1)
      sIDType = "title"
      
      sClass = Space$(64)
      Call GetClassName(hwnd, sClass, 64)
   
   Else
   
     'no title, so get the class name instead
      sTitle = Space$(64)
      Call GetClassName(hwnd, sTitle, 64)
      sClass = sTitle
      sIDType = "class"
   
   End If
   
   GetWindowIdentification = TrimNull(sTitle)End FunctionPrivate Function TrimNull(startstr As String) As String  Dim pos As Integer  pos = InStr(startstr, Chr$(0))
  
  If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
  End If
  
 'if this far, there was
 'no Chr$(0), so return the string
  TrimNull = startstr
  
End Function