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

黄玉宏

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