Attribute VB_Name = "modBuild"
'Copyright [2012-2019] [www.cdrvba.com]

'Licensed under the Apache License, Version 2.0 (the "License");
'you may not use this file except in compliance with the License.
'You may obtain a copy of the License at

'    http://www.apache.org/licenses/LICENSE-2.0

'Unless required by applicable law or agreed to in writing, software
'distributed under the License is distributed on an "AS IS" BASIS,
'WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
'See the License for the specific language governing permissions and
'limitations under the License.


Option Explicit

Public startTime As Long ' 开始制作时间
Public endTime As Long ' 结束制作时间
Public totalUseTime As Long ' 总共花费的时间
Public avgTime As Long ' 平均制作时间
Public hasDefaultFont As Boolean ' 是否安装了默认字体
Public totalCount As Integer ' 要制作条幅的总数量
Public allBannerArray() As MyBanner ' 全部条幅数组
Public allHBannerArray() As MyBanner ' 全部横向条幅数组
Public allVBannerArray() As MyBanner ' 全部竖向条幅数组
Public totalHCount As Integer ' 全部横向条幅数组的总计
Public totalVCount As Integer ' 全部竖向条幅数组的总计
Public allHBannerShape() As Shape ' 全部横向条幅的图形组
Public allVBannerShape() As Shape ' 全部竖向条幅的图形组

Public makeHOrder As Integer ' 正在制作的横向条幅序号
Public makeVOrder As Integer ' 正在制作的竖向条幅序号

Public hTextModel As Shape                ' 横向文本模板
Public vTextModel As Shape                ' 竖向文本模板

Private mainFrameX As Shape                ' 主外框引用（矩形）
Private mainTextX As Shape                 ' 主内容引用（美术字）
Private cutHeadMarkX As Shape              ' 头部裁切线引用（矩形）
Private cutFootMarkX As Shape              ' 底部裁切线引用（矩形）
Private infoMarkX As Shape                 ' 备注引用（美术字）
Private sideTextX As Shape                 ' 小字引用（美术字）
Private inscribeTextX As Shape             ' 落款引用（美术字）
Private banner As MyBanner                 ' 条幅引用
Private autoMainTextSize As Double         ' 程序自动计算的主文本字体大小
Private autoInscribeTextSize As Double     ' 程序自动计算的落款文本字体大小
Private jx As Integer                      ' 美观模式下的精细值

Private uFontName As String                ' 字体配置
Private uCutMark As Boolean                ' 是否创建裁剪线
Private uCutMarkWidth As Double            ' 裁剪线宽度
Private uSideText As Boolean               ' 是否创建小字标记
Private uInfoMark As Boolean               ' 是否创建备注
Private uMainTextPerent As Double          ' 主文本宽度百分比
Private uMainTextStyle As String           ' 主文本的调整风格
Private uMinus As Double                   ' 色带宽度减去的数值

'=========================================================================================================================================================================================================================================
' 初始化
'=========================================================================================================================================================================================================================================
Private Sub initBanner(bannerX As MyBanner)
    banner = bannerX
    ' 获取用户设置的参数
    With UserForm2
        uFontName = .cboFontName.text
        uMainTextPerent = .cboMainTextPercent.text
        uMinus = .cboMinus.text
        uMainTextStyle = .cboMainTextStyle.text
        If .chkCutMark.value = True Then
            uCutMark = True
            uCutMarkWidth = .cboCutMarkWidth
        End If
        If .chkSideText.value = True Then
            uSideText = True
        End If
        If .chkInfoMark.value = True Then
            uInfoMark = True
        End If
        If .cboMainTextStyle.text = "美观优先" Then
            jx = Int(.cboJX.text)
        End If
        If banner.direction = "竖向" Then banner.inscribeText = ""
    End With
End Sub

'=========================================================================================================================================================================================================================================
' 制作
'=========================================================================================================================================================================================================================================
Public Function makeBanner(bannerX As MyBanner) As Shape
    Call initBanner(bannerX)
    getAutoTextSize ' 计算合适的字体大小
    createMainFrame ' 创建主外框
    If Trim(banner.inscribeText) <> "" Then
       createMainTextWithInscribe
      Else
       createMainTextOnly ' 创建主内容
    End If
    createCutMark ' 创建裁切线
    createSideText ' 创建小字标记
    createInfoMark ' 创建备注
    setSafeContent ' 保证在安全范围内
    Set makeBanner = createGroup ' 组合成形状返回
End Function

'=========================================================================================================================================================================================================================================
' 创建主外框
'=========================================================================================================================================================================================================================================
Private Sub createMainFrame()
    Select Case banner.direction
        Case "横向"
            Set mainFrameX = drawRectangle(0, 0, banner.length * 1000, banner.clothWidth)
        Case "竖向"
            Set mainFrameX = drawRectangle(0, 0, banner.clothWidth, banner.length * 1000)
    End Select
    Call fillShape(mainFrameX, 0, 100, 100, 0) ' 默认填充红色背景
End Sub

'=========================================================================================================================================================================================================================================
' 根据布料得到合适的文本字体大小（保证不变形）
'=========================================================================================================================================================================================================================================
Public Function getAutoTextSize() As Boolean
    Select Case banner.clothWidth
        Case 440
            autoMainTextSize = 950
            autoInscribeTextSize = 250
        Case 540
            autoMainTextSize = 1200
            autoInscribeTextSize = 260
        Case 670
            autoMainTextSize = 1520
            autoInscribeTextSize = 370
        Case 820
            autoMainTextSize = 1560
            autoInscribeTextSize = 370
        Case Else
            autoMainTextSize = 1500
            autoInscribeTextSize = 250
    End Select
    getAutoTextSize = True
End Function

'=========================================================================================================================================================================================================================================
' 对主文本的宽度应用调整风格
'=========================================================================================================================================================================================================================================
Public Sub applyMainTextStyle(mainTextObj As Shape)
    Dim t As text, value As Integer, Savetime As Double
    Set t = mainTextObj.text
    Select Case banner.direction
        Case "横向"
            Select Case uMainTextStyle
                Case "美观优先"
                    Do
                      value = t.Story.CharSpacing
                      If ((value + jx) <= 2000) Then ' 保证字符间距在安全范围内
                         t.Story.CharSpacing = t.Story.CharSpacing + jx
                      End If
                      If mainTextObj.SizeWidth >= mainFrameX.SizeWidth * (uMainTextPerent / 100) Then ' 若超出设定比例，则强制拉伸
                         mainTextObj.SetSize mainFrameX.SizeWidth * (uMainTextPerent / 100), mainTextObj.SizeHeight
                         Exit Do
                      End If
                    Loop Until mainTextObj.SizeWidth >= mainFrameX.SizeWidth * (uMainTextPerent / 100)
                Case "极速模式"
                    mainTextObj.SetSize mainFrameX.SizeWidth * (uMainTextPerent / 100), mainTextObj.SizeHeight
            End Select
        Case "竖向"
            Select Case uMainTextStyle
                Case "美观优先"
                    Do
                      value = t.Story.CharSpacing
                      If ((value + jx) <= 2000) Then ' 保证字符间距在安全范围内
                         t.Story.CharSpacing = t.Story.CharSpacing + jx
                      End If
                      If mainTextObj.SizeHeight >= mainFrameX.SizeHeight * (uMainTextPerent / 100) Then ' 若超出设定比例，则强制拉伸
                         mainTextObj.SetSize mainTextObj.SizeWidth, mainFrameX.SizeHeight * (uMainTextPerent / 100)
                         Exit Do
                      End If
                    Loop
                Case "极速模式"
                    mainTextX.SetSize banner.ribbonWidth - uMinus, banner.length * 1000 * (uMainTextPerent / 100)
            End Select
    End Select
End Sub

'=========================================================================================================================================================================================================================================
' 创建主内容（不带落款）
'=========================================================================================================================================================================================================================================
Private Sub createMainTextOnly()
    ' 若是竖向文本则直接从模型拷贝
    If banner.direction = "横向" Then
       Set mainTextX = drawArtisticText(0, 0, banner.mainText, uFontName, autoMainTextSize)
     Else
       ActiveLayer.Shapes.All.RemoveFromSelection
       vTextModel.Copy
       Set mainTextX = ActiveLayer.Paste
       mainTextX.text.Story.text = banner.mainText
       mainTextX.text.Story.Size = autoMainTextSize
    End If
    applyMainTextStyle mainTextX
    ' 设置颜色
    If banner.textColor = "白字" Then Call fillShape(mainTextX, 0, 0, 0, 0) Else Call fillShape(mainTextX, 0, 0, 100, 0)
    ' 居中对齐
    mainTextX.AlignToShape cdrAlignHCenter, mainFrameX
    mainTextX.AlignToShape cdrAlignVCenter, mainFrameX
End Sub

'=========================================================================================================================================================================================================================================
' 创建主内容（带落款）
'=========================================================================================================================================================================================================================================
Private Sub createMainTextWithInscribe()
    If banner.direction = "横向" Then
       Set mainTextX = drawArtisticText(0, 0, banner.mainText, uFontName, autoMainTextSize)
       applyMainTextStyle mainTextX
       ' 居中对齐
       mainTextX.AlignToShape cdrAlignHCenter, mainFrameX
       mainTextX.AlignToShape cdrAlignVCenter, mainFrameX
       ' 创建落款内容
       Set inscribeTextX = drawArtisticText(0, 0, banner.inscribeText, uFontName, autoInscribeTextSize)
       ' 减少主文本的高度，以便留出落款的空间
       mainTextX.SetSize mainTextX.SizeWidth, mainTextX.SizeHeight - inscribeTextX.SizeHeight
       ' 调整落款位置
       inscribeTextX.AlignToShape cdrAlignRight, mainTextX
       inscribeTextX.SetPosition inscribeTextX.LeftX, mainTextX.TopY - mainTextX.SizeHeight - 10
       ' 设置文本颜色
       If banner.textColor = "白字" Then
          Call fillShape(mainTextX, 0, 0, 0, 0)
          Call fillShape(inscribeTextX, 0, 0, 0, 0)
        Else
          Call fillShape(mainTextX, 0, 0, 100, 0)
          Call fillShape(inscribeTextX, 0, 0, 100, 0)
       End If
       ' 将主文本和落款组合，设置垂直居中对齐
       Dim tempGroup As Shape
       mainTextX.AddToSelection
       inscribeTextX.AddToSelection
       Set tempGroup = ActiveSelection.group
       tempGroup.AlignToShape cdrAlignVCenter, mainFrameX
    End If
End Sub

'=========================================================================================================================================================================================================================================
' 创建裁切线
'=========================================================================================================================================================================================================================================
Private Sub createCutMark()
    If uCutMark = True Then
       If banner.direction = "横向" Then
          Set cutHeadMarkX = drawRectangle(0, 0, uCutMarkWidth, banner.ribbonWidth * 0.9)
          Set cutFootMarkX = drawRectangle(0, 0, uCutMarkWidth, banner.ribbonWidth * 0.9)
        Else
          Set cutHeadMarkX = drawRectangle(0, 0, banner.ribbonWidth * 0.9, uCutMarkWidth)
          Set cutFootMarkX = drawRectangle(0, 0, banner.ribbonWidth * 0.9, uCutMarkWidth)
       End If
       If banner.textColor = "白字" Then
          Call fillShape(cutHeadMarkX, 0, 0, 0, 0)
          Call fillShape(cutFootMarkX, 0, 0, 0, 0)
        Else
          Call fillShape(cutHeadMarkX, 0, 0, 100, 0)
          Call fillShape(cutFootMarkX, 0, 0, 100, 0)
       End If
       If banner.direction = "横向" Then
          cutHeadMarkX.AlignToShape cdrAlignLeft, mainFrameX
          cutHeadMarkX.AlignToShape cdrAlignVCenter, mainFrameX
          cutFootMarkX.AlignToShape cdrAlignRight, mainFrameX
          cutFootMarkX.AlignToShape cdrAlignVCenter, mainFrameX
        Else
          cutHeadMarkX.AlignToShape cdrAlignTop, mainFrameX
          cutHeadMarkX.AlignToShape cdrAlignHCenter, mainFrameX
          cutFootMarkX.AlignToShape cdrAlignBottom, mainFrameX
          cutFootMarkX.AlignToShape cdrAlignHCenter, mainFrameX
       End If
    End If
End Sub

'=========================================================================================================================================================================================================================================
' 创建小字标记
'=========================================================================================================================================================================================================================================
Private Sub createSideText()
    If uSideText = True Then
       Dim sideText As String
       sideText = banner.mainText & "_长" & banner.length & "米_宽" & banner.clothWidth & "mm_" & banner.direction
       Set sideTextX = drawArtisticText(0, 0, sideText, uFontName, 10)
       sideTextX.SetSize banner.ribbonWidth * 0.8, 10
       If banner.textColor = "白字" Then Call fillShape(sideTextX, 0, 0, 0, 0) Else Call fillShape(sideTextX, 0, 0, 100, 0)
       ' 如果有裁切线，则和裁切线对齐，否则贴齐边缘
       If uCutMark = True Then
            If banner.direction = "横向" Then
               sideTextX.Rotate 270
               sideTextX.AlignToShape cdrAlignLeft, cutHeadMarkX
               sideTextX.SetPosition cutHeadMarkX.PositionX + uCutMarkWidth + 2, cutHeadMarkX.PositionY
               sideTextX.AlignToShape cdrAlignVCenter, cutHeadMarkX
             Else
               sideTextX.AlignToShape cdrAlignTop, cutHeadMarkX
               sideTextX.SetPosition cutHeadMarkX.PositionX, cutHeadMarkX.PositionY - uCutMarkWidth - 2
               sideTextX.AlignToShape cdrAlignHCenter, cutHeadMarkX
            End If
          Else
            If banner.direction = "横向" Then
               sideTextX.Rotate 270
               sideTextX.AlignToShape cdrAlignLeft, mainFrameX
               sideTextX.SetPosition mainFrameX.PositionX + uCutMarkWidth + 2, mainFrameX.PositionY
               sideTextX.AlignToShape cdrAlignVCenter, mainFrameX
             Else
               sideTextX.AlignToShape cdrAlignTop, mainFrameX
               sideTextX.SetPosition mainFrameX.PositionX, mainFrameX.PositionY - uCutMarkWidth - 2
               sideTextX.AlignToShape cdrAlignHCenter, mainFrameX
            End If
       End If
    End If
End Sub

'=========================================================================================================================================================================================================================================
' 创建备注
'=========================================================================================================================================================================================================================================
Private Sub createInfoMark()
    If uInfoMark = True Then
       Dim infoText As String
       infoText = banner.direction & "_长" & banner.length & "米_宽" & banner.clothWidth & "mm_" & banner.number & "条_" & banner.textColor
       Set infoMarkX = drawArtisticText(0, 0, infoText, uFontName, 400)
       infoMarkX.AlignToShape cdrAlignLeft, mainFrameX
       infoMarkX.SetPosition infoMarkX.LeftX, mainFrameX.TopY + infoMarkX.SizeHeight + 50
       Call fillShape(infoMarkX, 0, 0, 0, 100)
    End If
End Sub

'=========================================================================================================================================================================================================================================
' 条幅成组
'=========================================================================================================================================================================================================================================
Private Function createGroup() As Shape
    mainFrameX.AddToSelection
    mainTextX.AddToSelection
    If uCutMark = True Then
       cutHeadMarkX.AddToSelection
       cutFootMarkX.AddToSelection
    End If
    If uSideText = True Then
       sideTextX.AddToSelection
    End If
    If uInfoMark = True Then infoMarkX.AddToSelection
    If banner.inscribeText <> "" Then inscribeTextX.AddToSelection
    Set createGroup = ActiveSelection.group
End Function

'=========================================================================================================================================================================================================================================
' 将内容区控制在安全范围内
'=========================================================================================================================================================================================================================================
Public Function setSafeContent() As Boolean
    Dim safeValue As Double
    safeValue = banner.ribbonWidth - uMinus
    'MsgBox "正在处理安全范围，正常安全范围应该是" & safeValue
    Select Case banner.direction
        Case "横向"
            ' 若是带落款的，先将主文本和落款组合，得到总高度
            If banner.inscribeText <> "" Then
               ActiveLayer.Shapes.All.RemoveFromSelection ' 取消所有选择
               mainTextX.AddToSelection
               inscribeTextX.AddToSelection
               Dim temGroup As Shape
               Set temGroup = ActiveSelection.group
               If temGroup.SizeHeight > safeValue Then
                  'MsgBox "带落款条幅的总高度" & temGroup.SizeHeight & "超出了安全值" & safeValue & "，已强制调整"
                  temGroup.SetSize temGroup.SizeWidth, safeValue
                  temGroup.AlignToShape cdrAlignHCenter, mainFrameX ' 居中对齐
                  temGroup.AlignToShape cdrAlignVCenter, mainFrameX
               End If
               ActiveSelection.Ungroup ' 解除临时组合
             Else
               ' 若是不带落款的，直接判断是否在安全范围内，若超出则强行设置
               If mainTextX.SizeHeight > safeValue Then
                  'MsgBox "横幅的高度" & mainTextX.SizeHeight & "超出了安全值" & safeValue & "，已强制调整"
                  mainTextX.SetSize mainTextX.SizeWidth, safeValue
               End If
               mainTextX.AlignToShape cdrAlignHCenter, mainFrameX ' 居中对齐
               mainTextX.AlignToShape cdrAlignVCenter, mainFrameX
            End If
        Case "竖向"
            If mainTextX.SizeWidth > safeValue Then
               'MsgBox "竖幅的宽度" & mainTextX.SizeWidth & "超出了安全值" & safeValue & "，已强制调整"
               mainTextX.SetSize safeValue, mainTextX.SizeHeight
            End If
            mainTextX.AlignToShape cdrAlignHCenter, mainFrameX ' 居中对齐
            mainTextX.AlignToShape cdrAlignVCenter, mainFrameX
    End Select
    setSafeContent = True
End Function