CorelDRAW的二次开发源码

最新推荐文章于 2023-02-18 10:56:11 发布

LiuKaiMIn

最新推荐文章于 2023-02-18 10:56:11 发布

阅读量3.3k

点赞数

文章标签： insert shapes each function integer database

本文链接：https://blog.csdn.net/LiuKaiMIn/article/details/6107426

版权

本人写的用于从CorelDRAW获取图形数据的源码，因为VB使用指针很麻烦，所以就使用access数据库存储图形数据。请多指教。

Dim m_oAdoCnn As ADODB.Connection

Public Sub output()
ActiveDocument.Unit = cdrMillimeter
ActiveDocument.ReferencePoint = cdrBottomLeft

    Set m_oAdoCnn = New ADODB.Connection
    m_oAdoCnn.Mode = adModeShareExclusive
    m_oAdoCnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=filename.mdb;User ID=;Password=;Jet OLEDB:Database Password=;"

Dim lShapeCount As Long
lShapeCount = get_coreldraw_shape(m_oAdoCnn, ActivePage.Shapes, True)

m_oAdoCnn.Close
Set m_oAdoCnn = Nothing
End Sub

Private Function get_coreldraw_shape(ByVal m_oAdoCnn As ADODB.Connection, ByVal vShapes As Variant, Optional ByVal isResetId As Boolean = False) As Long
    Static lShapeId As Long
    If isResetId Then lShapeId = 1
    ActiveDocument.Unit = cdrMillimeter
    Dim oShape As CorelDRAW.Shape
    Dim oColorShape As CorelDRAW.Color
    Dim lEntityColor As Long
    Dim sObjectName As String

    For Each oShape In vShapes
        Select Case oShape.Type
            Case cdrRectangleShape, cdrEllipseShape, cdrPolygonShape, cdrCurveShape, cdrTextShape
                If oShape.Type <> cdrCurveShape Then
                    oShape.ConvertToCurves
                End If
                If oShape.Type <> cdrCurveShape Then
                    get_coreldraw_shape m_oAdoCnn, oShape.Shapes