PC go! 2008 April/PCgo 2008-04 (DVD).iso/interface/contents/demoversionen_3846/13664/files/Data1.cab/tcengine.vb

Text File | 2004-07-15 | 5.2 KB | 124 lines

'******************************************************************'
'*                                                                *'
'*                      TurboCAD for Windows                      *'
'*                   Copyright (c) 1993 - 2004                    *'
'*             International Microcomputer Software, Inc.         *'
'*                            (IMSI)                              *'
'*                      All rights reserved.                      *'
'*                                                                *'
'******************************************************************'
Public Class TCEngine
    Public m_gxApp As IMSIGX.XApplication
    Public m_gxDrawing As IMSIGX.IDrawing
    Public m_gxView As IMSIGX.View

    Public Sub New()
        m_gxApp = Nothing
        m_gxDrawing = Nothing
        m_gxView = Nothing
    End Sub
    Public Sub CreateGxApp()
        If m_gxApp Is Nothing Then
            m_gxApp = New IMSIGX.XApplication
        End If
    End Sub
    Public Sub CreateNewDrawing()
        If m_gxApp Is Nothing Then
            CreateGxApp()
        End If
        If Not m_gxDrawing Is Nothing Then
            MsgBox("Drawing is already created !")
        Else
            m_gxDrawing = m_gxApp.Drawings.Add()
        End If
    End Sub
    Public Sub CreateGxView(ByVal hWnd As Long)
        ' hWnd - handle of window to which we attach the TurboCAD's view
        If Not m_gxDrawing Is Nothing Then
            m_gxView = m_gxDrawing.Views.Add()
            m_gxView.HWND = hWnd
            m_gxView.Update = False
            m_gxView.MappingMode = 1
            m_gxView.FixedAspectRatio = True
        End If
    End Sub
    Public Function AddLineSingle(ByVal x1Screen As Double, ByVal y1Screen As Double, ByVal x2Screen As Double, ByVal y2Screen As Double) As IMSIGX.IGraphic

        Dim x1View As Double, y1View As Double, x2View As Double, y2View As Double, zView As Double
        Dim x1World As Double, y1World As Double, x2World As Double, y2World As Double
        zView = 0
        Dim grRet As IMSIGX.IGraphic

        Me.m_gxView.ScreenToView(x1Screen, y1Screen, x1View, y1View)
        Me.m_gxView.ScreenToView(x2Screen, y2Screen, x2View, y2View)
        Me.m_gxView.ViewToWorld(x1View, y1View, zView, x1World, y1World, zView)
        Me.m_gxView.ViewToWorld(x2View, y2View, zView, x2World, y2World, zView)

        grRet = Me.m_gxDrawing.Graphics.AddLineSingle(x1World, y1World, 0, x2World, y2World, 0)
        Return grRet
    End Function

    Public Function AddCircleCenterAndPoint(ByVal x1Screen As Double, ByVal y1Screen As Double, ByVal x2Screen As Double, ByVal y2Screen As Double) As IMSIGX.IGraphic

        Dim x1View As Double, y1View As Double, x2View As Double, y2View As Double, zView As Double
        Dim x1World As Double, y1World As Double, x2World As Double, y2World As Double
        zView = 0
        Dim grRet As IMSIGX.IGraphic

        Me.m_gxView.ScreenToView(x1Screen, y1Screen, x1View, y1View)
        Me.m_gxView.ScreenToView(x2Screen, y2Screen, x2View, y2View)
        Me.m_gxView.ViewToWorld(x1View, y1View, zView, x1World, y1World, zView)
        Me.m_gxView.ViewToWorld(x2View, y2View, zView, x2World, y2World, zView)

        grRet = Me.m_gxDrawing.Graphics.AddCircleCenterAndPoint(x1World, y1World, 0, x2World, y2World, 0)
        Return grRet
    End Function
    Public Function SelectGraphic(ByVal xScreen As Double, ByVal yScreen As Double) As IMSIGX.IGraphic
        Dim xView As Double, yView As Double
        Dim gxPickResult As IMSIGX.PickResult
        Dim gxPickEntry As IMSIGX.PickEntry
        Dim grRet As IMSIGX.IGraphic
        Me.m_gxView.ScreenToView(xScreen, yScreen, xView, yView)
        gxPickResult = Me.m_gxView.PickPoint(xView, yView)
        If (gxPickResult.Count <> 0) Then
            gxPickEntry = gxPickResult.Item(0)
            grRet = gxPickEntry.Graphic
        Else
            Me.m_gxDrawing.Graphics.Unselect()
        End If
        gxPickResult = Nothing
        gxPickEntry = Nothing
        Return grRet
    End Function

    Public Sub Zoom(ByVal zoomfactor As Double)
        If (zoomfactor <> 0) Then
            Try
                Me.m_gxView.Camera.Zoom(zoomfactor)
            Catch ex As Exception
                '// in case of paper space (not possible to get camera object in paperSpace) or unexpected error in model space
                Dim xC As Double, yC As Double, w As Double, h As Double
                xC = yC = 0
                w = h = 0

                '    //On Error GoTo Err
                w = Me.m_gxView.ViewWidth
                h = Me.m_gxView.ViewHeight

                xC = Me.m_gxView.ViewLeft + w / 2
                yC = Me.m_gxView.ViewTop - h / 2
                w = w * zoomfactor
                h = h * zoomfactor
                Me.m_gxView.Update = False

                Me.m_gxView.ViewLeft = xC - w / 2
                Me.m_gxView.ViewTop = yC + h / 2
                Me.m_gxView.ViewWidth = w
                Me.m_gxView.ViewHeight = h
            End Try
        Else
            Me.m_gxView.ZoomToExtents()
        End If
    End Sub
End Class