كيف يمكن تشغيل برنامج تنفيذى Exe مضمن داخل نموذج

تحية طيبة

المشكلة هى : كيف يمكن تشغيل ملف تنفيذى وليكن الآلة الحاسبة مضمنة داخل محتوى النموذج

قمت باستخدام فكرة Parent / Child ولكنها تعمل جيداً داخل الفيجوال بيسك وهذا هو الكود

Option Explicit
Private Const GW_HWNDNEXT As Long = 2
Private 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 Long
Private 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 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 SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private old_parent As Long
Private child_hwnd As Long

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_BYPOSITION As Long = &H400&
Private Const MF_REMOVE As Long = &H1000&

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Type RECT
	Left As Long
	Top As Long
	Right As Long
	Bottom As Long
End Type
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

Private Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long
	test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
	Do While test_hwnd <> 0
		If GetParent(test_hwnd) = 0 Then
			test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
			If test_pid = target_pid Then
				InstanceToWnd = test_hwnd
				Exit Do
			End If
		End If
		test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
	Loop
End Function

Private Sub cmdFree_Click()
	SetParent child_hwnd, old_parent
	cmdRun.Enabled = True
	cmdFree.Enabled = False
End Sub

Private Sub cmdRun_Click()
Dim pid As Long
Dim buf As String
Dim buf_len As Long
Dim R As RECT
	pid = Shell(txtProgram.Text, vbNormalFocus)
	If pid = 0 Then
		MsgBox "Error starting program"
		Exit Sub
	End If
	GetWindowRect InstanceToWnd(pid), R
	MoveWindow InstanceToWnd(pid), 0, 0, R.Right - R.Left, R.Bottom - R.Top, 1
	MakeUnMoveable InstanceToWnd(pid)
	child_hwnd = InstanceToWnd(pid)
	old_parent = SetParent(child_hwnd, picChild.hwnd)
	Refresh
	cmdRun.Enabled = False
	cmdFree.Enabled = True
End Sub

Private Sub MakeUnMoveable(Handle As Long)
Dim hSysMenu As Long, nCnt As Long
' Get handle to our form's system menu
' (Restore, Maximize, Move, close etc.)
hSysMenu = GetSystemMenu(Handle, False)

If hSysMenu Then
	' Get System menu's menu count
	nCnt = GetMenuItemCount(hSysMenu)
	If nCnt Then
		' Menu count is based on 0 (0, 1, 2, 3...)
		RemoveMenu hSysMenu, nCnt - 6, MF_BYPOSITION Or MF_REMOVE ' Remove the seperator
		DrawMenuBar Handle
		' Force caption bar's refresh. Disabling X button
		SetWindowText Handle, "Embedded Calc"
	End If
End If
End Sub

Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub

ولكن عند التطبيق داخل الأكسس لم يعمل وظهرت عدة مشاكل التحويل من Vb إلى Vba فى خواص الدوال

مرفق المثال بالفيجوال بيسك

تقبلوا فائق تحياتى

StartInFixedWindow.rar