frmmodcommonprintsetup.frm

来自「通用书店管理系统」· FRM 代码 · 共 1,707 行 · 第 1/5 页

Private Sub cboLayoutLabelAlign_Click()
    '触发内容替换
    If blnChangedByQuery Then Exit Sub
    
    Select Case cboLayoutLabelAlign.Text
    Case "左"
        Call UpdatePrintInfo(tv.SelectedItem, "", "lblAlign", "Left")
    Case "中"
        Call UpdatePrintInfo(tv.SelectedItem, "", "lblAlign", "Center")
    Case "右"
        Call UpdatePrintInfo(tv.SelectedItem, "", "lblAlign", "Right")
    End Select
End Sub

Private Sub cboLayoutTextAlign_Click()
    '触发内容替换
    If blnChangedByQuery Then Exit Sub
    
    Select Case cboLayoutTextAlign.Text
    Case "左"
        Call UpdatePrintInfo(tv.SelectedItem, "", "txtAlign", "Left")
    Case "中"
        Call UpdatePrintInfo(tv.SelectedItem, "", "txtAlign", "Center")
    Case "右"
        Call UpdatePrintInfo(tv.SelectedItem, "", "txtAlign", "Right")
    End Select
End Sub

Private Sub cboPageOfFormat_Validate(Cancel As Boolean)
    '信息得到改变
    If cboPageOfFormat.DataChanged Then
        PI.cqPageFoot.LayOut = UpdateFieldInfo(PI.cqPageFoot.LayOut, "PageOf", "PageOfFormat", Trim(cboPageOfFormat.Text))
    End If
    cboPageOfFormat.DataChanged = False
End Sub

Private Sub cboPageOfPosition_Validate(Cancel As Boolean)
        '信息得到改变
    If cboPageOfPosition.DataChanged Then
        PI.cqPageFoot.LayOut = UpdateFieldInfo(PI.cqPageFoot.LayOut, "PageOf", "PageOfPosType", Trim(cboPageOfPosition.Text))
    End If
    cboPageOfPosition.DataChanged = False
End Sub

Private Sub chkNewLine_Click()
    '触发内容替换
    
    Select Case chkNewLine.Value
    Case vbChecked
        Call UpdatePrintInfo(tv.SelectedItem, "", "<BR>", "TRUE")
    Case Else
        Call UpdatePrintInfo(tv.SelectedItem, "", "<BR>", "False")
    End Select
    
End Sub



Private Sub CmdDelete_Click()
    '清除
    On Error GoTo Err
    
    If Trim(strPrintInfoName) = "" Then
        VBA.MsgBox "没有可以清空的打印配置信息！"
        Exit Sub
    End If
    
    If VBA.MsgBox("确认要清除吗？", vbYesNo) = vbNo Then Exit Sub
    
    Dim strSQL$, intAffected%
    Dim arrInfo
    
    arrInfo = Split(strPrintInfoName, "|")
    
    cN.BeginTrans  '开事务
    
    strSQL = "Delete From " & strDBMainTable & " Where chrSystem='" & Trim(arrInfo(0)) & "' And vchPrintName='" & Trim(arrInfo(1)) & "'"
    Call cN.Execute(strSQL, intAffected)   '删除主表
    
    strSQL = "Delete From " & strDBDetailTable & " Where chrSystem='" & Trim(arrInfo(0)) & "' And vchPrintName='" & Trim(arrInfo(1)) & "'"
    Call cN.Execute(strSQL)    '删除明细表
    
    cN.CommitTrans
    
    If intAffected <> 1 Then
        VBA.MsgBox "信息已经清除！"
    Else
        VBA.MsgBox "清除成功！"
    End If
    
    Exit Sub
Err:
    cN.RollbackTrans
    MsgBox "打印配置信息删除失败！"
End Sub

Private Sub cmdFont_Click()
    '设置字体
    On Error Resume Next
    
    Err.Number = 0
    cd.CancelError = True
    cd.flags = cdlCFBoth + cdlCFEffects
    cd.FontBold = txtContent.Font.Bold
    cd.FontItalic = txtContent.Font.Italic
    cd.FontUnderline = txtContent.FontUnderline
    cd.FontSize = txtContent.FontSize
    cd.FontName = txtContent.Font.Name
    cd.Color = txtContent.ForeColor
    
    cd.ShowFont
    If Err.Number = 0 Then
        txtContent.Font.Bold = cd.FontBold
        txtContent.Font.Italic = cd.FontItalic
        txtContent.Font.Underline = cd.FontUnderline
        txtContent.Font.Size = cd.FontSize
        txtContent.Font.Name = cd.FontName
        txtContent.ForeColor = cd.Color
        Call UpdatePrintInfo(tv.SelectedItem, "", "", "")
    End If
        
End Sub

Private Sub cmdReset_Click()
    '数据复位
    Call CopyPrintInfoToPI(True)
    Call iniForm
End Sub

Private Function getFieldValues(obj As Object, Optional strType As String = "Insert") As String
    Dim strSQL$
    With obj
        Select Case UCase(strType)
        Case "INSERT"
            
            strSQL = IIf(.FontBold, 1, 0) & "," _
                & IIf(.FontItalic, 1, 0) & "," _
                & "'" & Trim(.FontName) & "'," _
                & .FontSize & "," _
                & IIf(.FontUnderline, 1, 0) & "," _
                & .ForeColor & "," _
                & "'" & Replace(Trim(.LayOut & ""), "'", "''") & "'," _
                & "'" & Trim(.Separation & "") & "'"
        Case "UPDATE"
            strSQL = "blnFontBold=" & IIf(.FontBold, 1, 0) & "," _
                & "blnFontItalic=" & IIf(.FontItalic, 1, 0) & "," _
                & "vchFontName='" & Trim(.FontName) & "'," _
                & "intFontSize=" & .FontSize & "," _
                & "blnFontUnderline=" & IIf(.FontUnderline, 1, 0) & "," _
                & "intForeColor=" & .ForeColor & "," _
                & "vchLayOut='" & Replace(Trim(.LayOut), "'", "''") & "'," _
                & "chrSeparation='" & Trim(.Separation) & "'"
        End Select
    End With
    getFieldValues = strSQL
End Function

Private Sub CmdSave_Click()
    '保存
    On Error GoTo Err
    
    If Trim(strPrintInfoName) = "" Then
        VBA.MsgBox "该打印配置信息不能保存！"
        Exit Sub
    End If
    
    If VBA.MsgBox("确认要保存吗？", vbYesNo) = vbNo Then Exit Sub
    
    Dim strSQL$, intAffected%
    Dim arrInfo
    
    arrInfo = Split(strPrintInfoName, "|")
    
    cN.BeginTrans  '开事务
    
    strSQL = "Delete From " & strDBMainTable & " Where chrSystem='" & Trim(arrInfo(0)) & "' And vchPrintName='" & Trim(arrInfo(1)) & "'"
    Call cN.Execute(strSQL)    '删除主表
    strSQL = "Delete From " & strDBDetailTable & " Where chrSystem='" & Trim(arrInfo(0)) & "' And vchPrintName='" & Trim(arrInfo(1)) & "'"
    Call cN.Execute(strSQL)    '删除明细表
    
    strSQL = "Insert Into " & strDBMainTable & " (chrSystem, vchPrintName, blnRepeatTitle, blnRepeatSayingAboveTable, " _
        & "blnRepeatSayingBelowTable, blnRepeatSign, blnEmptyRow, blnExtenLastCol," _
        & "blnColumnForPage, intMaxRowsPerPage, intRow_Height," _
        & "decPrintMarginLeft,decPrintMarginRight,decPrintMarginHeader,decPrintMarginFooter,intPrintOrientation,intPrintPaperSize,decPrintPaperWidth,decPrintPaperHeight)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & Me.chkRepeat(0).Value & "," & Me.chkRepeat(1).Value & "," & Me.chkRepeat(2).Value & "," & Me.chkRepeat(3).Value & "," _
        & Me.chkTableEmptyRow.Value & "," & Me.chkTableExtenLastCol & "," & Me.chkColumnForPage.Value & "," _
        & Val(Me.txtMaxRows.Text) & "," & Val(Me.txtRowHeight.Text) & "," _
        & PrintMarginLeft & "," & PrintMarginRight & "," & PrintMarginHeader & "," & PrintMarginFooter & "," & PrintOrientation & "," _
        & PrintPaperSize & "," & PrintPaperWidth & "," & PrintPaperHeight & ")"
    Call cN.Execute(strSQL, intAffected)   '插入主表
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqFirstTitle'," & getFieldValues(PI.cqFirstTitle, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqFirstTitle)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqPageBrow'," & getFieldValues(PI.cqPageBrow, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqPageBrow)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqPageFoot'," & getFieldValues(PI.cqPageFoot, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqPageFoot)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqSayingAboveTable'," & getFieldValues(PI.cqSayingAboveTable, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqSayingAboveTable)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqSayingBelowTable'," & getFieldValues(PI.cqSayingBelowTable, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqSayingBelowTable)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqSecondTitle'," & getFieldValues(PI.cqSecondTitle, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqSecondTitle)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqSign'," & getFieldValues(PI.cqSign, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqSign)
    If intAffected <> 1 Then GoTo Err
    
    strSQL = "Insert Into " & strDBDetailTable & " (chrSystem , vchPrintName, chrObjectType,  blnFontBold, blnFontItalic, " _
        & "vchFontName, intFontSize, blnFontUnderline, intForeColor, vchLayOut,chrSeparation)" _
        & " Values(" _
        & "'" & Trim(arrInfo(0)) & "','" & Trim(arrInfo(1)) & "'," _
        & "'cqTable'," & getFieldValues(PI.cqTable, "insert") _
        & ")"
    Call cN.Execute(strSQL, intAffected)   '插入明细表(cqTable)
    If intAffected <> 1 Then GoTo Err
    
    cN.CommitTrans
    
    VBA.MsgBox "保存成功！"
    
    Exit Sub
Err:
    cN.RollbackTrans
    MsgBox "保存配置出错：" & Err.Description
End Sub

Private Sub Form_Load()
    Call iniForm
End Sub

Private Sub OKButton_Click()
    blnOK = True
    
    strTxtPageRange = Trim(txtPageRange.Text)
    strTxtCopyQty = Trim(txtCopyQty.Text)
    
    Call CopyPrintInfoToPI(False)
    
    With frmParent
        .blnRepeatTitle = Me.chkRepeat(0).Value
        .blnRepeatSayingAboveTable = Me.chkRepeat(1).Value
        .blnRepeatSayingBelowTable = Me.chkRepeat(2).Value
        .blnRepeatSign = Me.chkRepeat(3).Value
        
        .blnColumnForPage = Me.chkColumnForPage.Value
        .blnExtenLastCol = Me.chkTableExtenLastCol.Value
        .blnEmptyRow = Me.chkTableEmptyRow
        
        .intPrintModel = Me.intPrintModel
        .MaxRowsPerPage = Val(Me.txtMaxRows.Text)
        .Row_Height = Val(Me.txtRowHeight.Text)
    End With
    
    Me.Hide
End Sub

Private Sub optPrintModel_Click(Index As Integer)
    Dim strLayout$
    Select Case Index
    Case 0
        With PI.cqSayingAboveTable
            strLayout = Trim(.LayOut)
            strLayout = UpdateFieldInfo(strLayout, "Label", "visable", "true")
            strLayout = UpdateFieldInfo(strLayout, "Text", "visable", "true")
            .LayOut = strLayout
        End With
        
        With PI.cqSayingBelowTable
            strLayout = Trim(.LayOut)
            strLayout = UpdateFieldInfo(strLayout, "Label", "visable", "true")
            strLayout = UpdateFieldInfo(strLayout, "Text", "visable", "true")
            .LayOut = strLayout
        End With
        
        With PI.cqSign
            strLayout = Trim(.LayOut)
            strLayout = UpdateFieldInfo(strLayout, "Label", "visable", "true")
            strLayout = UpdateFieldInfo(strLayout, "Text", "visable", "true")
            .LayOut = strLayout
        End With
        
        With PI.cqTable
            strLayout = UCase(Trim(.LayOut))
            If InStr(1, " " & strLayout, " LABELVISABLE=") = 0 Then
               strLayout = strLayout & " LabelVisable=True "
            Else
               strLayout = Replace(strLayout, "LABELVISABLE=FALSE", "LABELVISABLE=TRUE")
            End If
            If InStr(1, " " & strLay