本帖最后由 作者 于 2008-8-14 15:02:13 编辑
Private Declare Function SetParent Lib "user32"
(ByVal hWndChild As Long, ByVal hWndNewParent As Long)
As Long Private Declare Function GetParent Lib "user32"
(ByVal hwnd
As Long)
As Long Private Declare Function GetWindowRect Lib "user32"
(ByVal hwnd
As Long, lpRect As RECT)
As Long 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
Private
Type RECT Left
As Long Top
As Long Right
As Long Bottom As Long End
Type
Private acadApp As Object Private lHwnd As Long '保存ACAD应用程序的窗口句柄 Private lState As Long '保存ACAD的初始窗口状态 Private r As RECT '保存ACAD的初始窗口位置
Private
Sub Form_Load()
On
Error
GoTo ErrTrap Set acadApp =
GetObject(, "AutoCAD.Application") acadApp.Visible
= True 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, Form1.ScaleHeight, 0 Exit
Sub
ErrTrap: On
Error
GoTo 0 End Sub
Private
Sub Form_Resize() SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 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 Set acadApp = Nothing End Sub
参考页面: http://www.mjtd.com/bbs/Archive_view.asp?boardID=4&ID=10991 |