将CAD窗体嵌入到VB窗体中(CAD窗口自动随VB窗体缩放)

黄玉宏 · 发表于 2007-9-13 12:26:37

Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Public 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 Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public AcadApp As Object Public lHwnd As Long      '保存ACAD应用程序的窗口句柄 Public lState As Long     '保存ACAD的初始窗口状态 Public r As RECT          '保存ACAD的初始窗口位置 Public L As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Const GWL_STYLE = (-16) Public Const WS_CAPTION = &HC00000   Private Sub Form_Load() On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") If Err Then Err.Clear Set AcadApp = CreateObject("AutoCAD.Application") End If lHwnd = GetParent(GetParent(AcadApp.Activedocument.hwnd)) If lHwnd = 0 Then Exit Sub lState = AcadApp.WindowState AcadApp.WindowState = 1      '设置ACAD的窗口状态为默认,用于保存窗口位置 'GetWindowRect lHwnd, r SetParent lHwnd, Form1.hwnd Form1.ScaleMode = vbPixels   '将VB窗体默认的缇单位改为以像素为单位 SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth - 0, Form1.ScaleHeight - 0, 0 Me.WindowState = 2 AcadApp.WindowState = 0 GetWindowRect lHwnd, r   L = GetWindowLong(lHwnd, GWL_STYLE) L = L And Not (WS_CAPTION) L = SetWindowLong(lHwnd, GWL_STYLE, L) '以上三句：隐藏CAD标题栏，最上面是VB窗体标题栏，下面是ACAD的菜单和工具栏 'L = GetWindowLong(acadhwnd, GWL_STYLE) 'L = L Or (WS_CAPTION) 'L = SetWindowLong(acadhwnd, GWL_STYLE, L) '以上三句：恢复CAD标题栏 End Sub Private Sub Form_Resize() SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth - 0, Form1.ScaleHeight - 0, 0 End Sub Private Sub Form_Unload(Cancel As Integer) If lHwnd = 0 Then Exit Sub SetParent lHwnd, 0 SetWindowPos lHwnd, 0, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, 0 AcadApp.WindowState = lState AcadApp.Quit Set AcadApp = Nothing End Sub

		自动登录	找回密码
密码			立即注册