frmaccinfo.frm

财务信息管理系统,适合做毕业论文的人使用

    End If
End Function
'打印处理程序
Private Sub printProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Printer.DoPrint
        xmlInit = False
    End If
End Sub
'预览处理程序
Private Sub previewProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Printer.PrintPreview
        xmlInit = False
    End If
End Sub
'输出处理程序
Private Sub outputProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Dim sTypeList As String
        Dim sSizeList As String
        Dim i As Long
        Dim e As Long
    
        i = 0
        sTypeList = ""
        sSizeList = ""
        For i = 0 To 14
            If m_fields(i).fshow Then
                Select Case i
                    Case 0
                        sTypeList = "8,"
                        'sTypeList = "10,"
                        sSizeList = "10,"
                    Case 1, 2, 3, 4, 7, 10, 11, 12, 13, 14
                        sTypeList = sTypeList & "10,"
                        sSizeList = sSizeList & "80,"
                    Case 5, 6, 9
                        sTypeList = sTypeList & "10,"
                        sSizeList = sSizeList & "80,"
                     Case 8
                        sTypeList = sTypeList & "7,"
                        sSizeList = sSizeList & "18,"
                End Select
            End If
        Next
       i = 0
       sTypeList = left(sTypeList, Len(sTypeList) - 1)
        sSizeList = left(sSizeList, Len(sSizeList) - 1)
        e = Printer.ExportToFile(i, sTypeList, sSizeList, "", "")
        xmlInit = False
    '    MsgBox e
    End If
End Sub
'保存用户设置
Private Sub printer_SettingChanged(ByVal varLocalSettings As Variant, ByVal varModuleSettings As Variant)
    Dim xmlstr As String
    xmlstr = "<?xml version='1.0' standalone='yes' ?>"
    xmlstr = xmlstr & "<格式>"
    xmlstr = xmlstr & varLocalSettings
    xmlstr = xmlstr & varModuleSettings
    xmlstr = xmlstr & "</格式>"
    Dim rs As New ADODB.Recordset
    On Error GoTo Error0
    rs.Open "select * from prn_format where moduleid='accinfoprn'", con, adOpenDynamic, adLockOptimistic
    If Not (rs.EOF Or rs.BOF) Then
        rs("formatXml") = xmlstr
        rs.Update
        rs.Close
        Set rs = Nothing
    Else
        rs.Close
        sqlstr = "insert into prn_format values('accinforprn','" & xmlstr & "')"
        con.Execute sqlstr
        Set rs = Nothing
    End If
    Exit Sub
Error0:
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    MsgBox "打印设置保存失败！"
End Sub
'设置打印格式
Private Function initStyleXml() As Boolean
'    Dim rs As New ADODB.Recordset
    Dim PrnDom As New DOMDocument
    Dim sSizeList As String
    Dim sposList As String
    Dim xmlstr As String
    
'    sqlStr = "select formatXml from PRN_format where moduleID='accUpprn'"
'    rs.Open sqlStr, con, adOpenDynamic, adLockOptimistic
'    If Not (rs.EOF Or rs.BOF) Then
'        xmlstr = Trim(rs("formatXml"))
'    Else
'        xmlstr = "<?xml version=''1.0'' standalone=''yes'' ?>"
'        xmlstr = xmlstr & "<格式>"
'        xmlstr = xmlstr & "<打印设置 打印范围=''全部'' 页码范围=''1-1'' 打印份数=''1'' 压缩=''是'' 多任务强制分页=''否'' />"
'        xmlstr = xmlstr & "<纸张设置 纸张类型=''9'' 纸张大小=''2100,2970'' 打印方向=''纵向'' 页边距=''300,200,200,200'' />"
'        xmlstr = xmlstr & "<页眉 对齐方式=''左'' 左顶点=''0,0'' 宽=''0'' 高=''100'' 字体名=''楷体_GB2312'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
'        xmlstr = xmlstr & "<标题 对齐方式=''中'' 左顶点=''0,200'' 宽=''0'' 高=''300'' 字体名=''黑体'' 字体大小=''24'' 颜色=''#000000'' 粗体=''是'' 斜体=''否'' 打印=''是'' /> "
'        xmlstr = xmlstr & "<表头 对齐方式=''左'' 左顶点=''0,500'' 宽=''1600'' 高=''300'' 字体名=''宋体'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是''>"
'        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''日期'' 对齐方式=''左'' 左顶点=''1100,500'' 宽=''800'' 高=''200'' 字体名=''黑体'' 字体大小=''16'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 标题宽度=''0'' 下标线=''否'' />"
'        'xmlstr = xmlstr & "<字段 打印=''是'' 名字=''生成单据名称'' 对齐方式=''右'' 左顶点=''1200,650'' 宽=''600'' 高=''140'' />"
'        xmlstr = xmlstr & "</表头>"
'        xmlstr = xmlstr & "<表体 左顶点=''0,800'' 宽=''0'' 高=''1400'' 固定行数=''0'' 列宽=''250,220,350,350,300,400,200''>"
'        xmlstr = xmlstr & "<表体头 对齐方式=''中'' 边框风格=''0'' 边框宽度=''2'' 行高=''140'' 字体名=''黑体'' 字体大小=''14'' 颜色=''#000000'' 粗体=''是'' 斜体=''否'' 打印=''是'' />"
'        xmlstr = xmlstr & "<表体行 对齐方式=''左,左,左,左,左,左,左'' 边框风格=''261'' 边框宽度=''2'' 行高=''0'' 字体名=''Times New Roman'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
'        xmlstr = xmlstr & "<表体尾 对齐方式=''中'' 边框风格=''0'' 边框宽度=''2'' 行高=''140'' 字体名=''黑体'' 字体大小=''14'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
'        xmlstr = xmlstr & "</表体>"
''        xmlstr = xmlstr & "<表尾 对齐方式=''左'' 左顶点=''0,2200'' 宽=''1600'' 高=''200'' 字体名=''新宋体'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是''>"
''        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''操作员'' 对齐方式=''左'' 左顶点=''50,2200'' 宽=''500'' 高=''200'' 字体名='''' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 标题宽度=''0'' 下标线=''否'' />"
''        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''操作日期'' 对齐方式=''右'' 左顶点=''800,2200'' 宽=''600'' 高=''150'' 字体名='''' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 标题宽度=''0'' 下标线=''否'' />"
''        xmlstr = xmlstr & "</表尾>"
'        xmlstr = xmlstr & "<页脚 对齐方式=''右'' 左顶点=''0,2400'' 宽=''0'' 高=''170'' 字体名=''楷体_GB2312'' 字体大小=''10'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
'        xmlstr = xmlstr & "</格式>"
'        sqlStr = "insert into PRN_format (moduleID,FormatXml) values('accUpprn','" & xmlstr & "');"
'        On Error GoTo Error1
'        con.BeginTrans
'        con.Execute sqlStr
'        con.CommitTrans
        Dim i As Integer
        For i = 0 To 14
            If m_fields(i).fshow Then
                Select Case i
                    Case 0
                        sSizeList = 10 * 20 & ","
                        sposList = "右,"
                    Case 1, 2, 3, 4, 7, 10, 11, 12, 13, 14
                        sSizeList = sSizeList & 40 * 20 & ","
                        sposList = "中,"
                    Case 5, 6, 9
                        sSizeList = sSizeList & 8 * 20 & ","
                        sposList = "中,"
                     Case 8
                        sSizeList = sSizeList & 15 * 20 & ","
                        sposList = "右,"
                End Select
            End If
        Next
        sSizeList = left(sSizeList, Len(sSizeList) - 1)
        sposList = left(sposList, Len(sposList) - 1)
        xmlstr = "<?xml version='1.0' standalone='yes' ?>"
        xmlstr = xmlstr & "<格式>"
        xmlstr = xmlstr & "<打印设置 打印范围='全部' 页码范围='1-1' 打印份数='1' 压缩='是' 多任务强制分页='否' />"
        xmlstr = xmlstr & "<纸张设置 纸张类型='9' 纸张大小='2100,2970' 打印方向='纵向' 页边距='300,200,200,200' />"
        xmlstr = xmlstr & "<页眉 对齐方式='左' 左顶点='0,0' 宽='0' 高='100' 字体名='楷体_GB2312' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "<标题 对齐方式='中' 左顶点='0,200' 宽='0' 高='300' 字体名='黑体' 字体大小='24' 颜色='#000000' 粗体='是' 斜体='否' 打印='是' /> "
        xmlstr = xmlstr & "<表头 对齐方式='左' 左顶点='0,500' 宽='1600' 高='300' 字体名='宋体' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是'>"
        xmlstr = xmlstr & "<字段 打印='是' 名字='日期' 对齐方式='左' 左顶点='1100,500' 宽='800' 高='200' 字体名='黑体' 字体大小='16' 颜色='#000000' 粗体='否' 斜体='否' 标题宽度='0' 下标线='否' />"
        'xmlstr = xmlstr & "<字段 打印='是' 名字='生成单据名称' 对齐方式='右' 左顶点='1200,650' 宽='600' 高='140' />"
        xmlstr = xmlstr & "</表头>"
        xmlstr = xmlstr & "<表体 左顶点='0,800' 宽='0' 高='0' 固定行数='0' 列宽='" & sSizeList & "'>"
        '250,220,350,350,300,400,200'>"
'        xmlstr = xmlstr & "<表体头 对齐方式='左,左,左,左,左,左,左' 边框风格='0' 边框宽度='2' 行高='140' 字体名='黑体' 字体大小='14' 颜色='#000000' 粗体='是' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "<表体行 对齐方式='" & sposList & "' 边框风格='783' 边框宽度='2' 行高='0' 字体名='Times New Roman' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "<表体尾 对齐方式='中' 边框风格='0' 边框宽度='2' 行高='140' 字体名='黑体' 字体大小='14' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "</表体>"
'        xmlstr = xmlstr & "<表尾 对齐方式='左' 左顶点='0,1800' 宽='1600' 高='200' 字体名='新宋体' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是'>"
'        xmlstr = xmlstr & "<字段 打印='是' 名字='操作员' 对齐方式='左' 左顶点='50,1800' 宽='500' 高='200' 字体名='' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 标题宽度='0' 下标线='否' />"
'        xmlstr = xmlstr & "<字段 打印='是' 名字='操作日期' 对齐方式='右' 左顶点='800,1800' 宽='600' 高='150' 字体名='' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 标题宽度='0' 下标线='否' />"
'        xmlstr = xmlstr & "</表尾>"
        xmlstr = xmlstr & "<页脚 对齐方式='右' 左顶点='0,2400' 宽='0' 高='170' 字体名='楷体_GB2312' 字体大小='10' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "</格式>"

'    End If
    If PrnDom.loadXML(Trim(xmlstr)) Then
        PrnDom.Save App.Path & "\taccInfoStyle.xml"
    Else
       initStyleXml = False
    End If
    initStyleXml = True
    
'    rs.Close
'    Set rs = Nothing
    Set PrnDom = Nothing
    Exit Function
Error1:
    initStyleXml = False
'    con.RollbackTrans
'    rs.Close
'    Set rs = Nothing
    Set PrnDom = Nothing
End Function

Private Sub loadstatic()
    Me.Icon = LoadResPicture(109, vbResIcon)
    ImageList1.ListImages.Add , "print", LoadResPicture(314, vbResBitmap)
    ImageList1.ListImages.Add , "preview", LoadResPicture(312, vbResBitmap)
    ImageList1.ListImages.Add , "output", LoadResPicture(263, vbResBitmap)
    ImageList1.ListImages.Add , "refresh", LoadResPicture(154, vbResBitmap)
    ImageList1.ListImages.Add , "find", LoadResPicture(331, vbResBitmap)
    ImageList1.ListImages.Add , "fields", LoadResPicture(102, vbResBitmap)
    ImageList1.ListImages.Add , "help", LoadResPicture(396, vbResBitmap)
    ImageList1.ListImages.Add , "exit", LoadResPicture(1118, vbResBitmap)
    
    With tlbTool
        .Buttons("print").Caption = "打印"
        .Buttons("print").Image = "print"
        .Buttons("print").ToolTipText = "Ctrl+p"
        
        .Buttons("preview").Caption = "预览"
        .Buttons("preview").Image = "preview"
        .Buttons("preview").ToolTipText = "Alt+V"
        
        .Buttons("output").Caption = "输出"
        .Buttons("output").Image = "output"
        .Buttons("output").ToolTipText = "Ctrl+O"
        
        .Buttons("refresh").Caption = "刷新"
        .Buttons("refresh").Image = "refresh"
        .Buttons("refresh").ToolTipText = "Ctrl+R"
        
        .Buttons("find").Caption = "查询"
        .Buttons("find").Image = "find"
        .Buttons("find").ToolTipText = "F3"
        
        .Buttons("fields").Caption = "栏目"
        .Buttons("fields").Image = "fields"
        .Buttons("fields").ToolTipText = "Ctrl+L"
        
        .Buttons("help").Caption = "帮助"
        .Buttons("help").Image = "help"
        .Buttons("help").ToolTipText = "F1"
        
        .Buttons("exit").Caption = "退出"
        .Buttons("exit").Image = "exit"
        .Buttons("exit").ToolTipText = "Ctrl+F4"
    End With
End Sub

Private Sub createtrestyle()
    
    Me.treStyle.Nodes.Add , , "K0", "个人"
    Me.treStyle.Nodes.Add , , "K1", "部门"
    Me.treStyle.Nodes.Add , , "K2", "银行"
    Me.treStyle.Nodes.Add , , "K3", "客户"
    Me.treStyle.Nodes.Add , , "K4", "供应商"
    Me.treStyle.Nodes.Add , , "K5", "项目"
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    Me.treStyle.Indentation = 300
    
    Dim rs As New ADODB.Recordset
    Dim sqlstr As String
    Dim i As Integer, RecordCount As Long
    
    On Error GoTo Error0
    
    sqlstr = "select accunit_id,cunitcode,cunitname,itype from fd_accunit"
    rs.Open sqlstr, con, adOpenDynamic
    If rs.EOF Or rs.BOF Then GoTo Error0
    'RecordCount = rs.RecordCount
    
    While Not (rs.EOF Or rs.BOF)
        Me.treStyle.Nodes.Add "K" & rs("itype"), tvwChild, "K" & rs("accunit_id"), "【" & rs("cunitcode") & "】" & rs("cunitname")
        rs.MoveNext
    Wend
    
    rs.Close
    
    sqlstr = "select accdef_id,accunit_id,caccid,caccname,bdestroy from fd_accdef"
    rs.Open sqlstr, con, adOpenDynamic
    If rs.EOF Or rs.BOF Then GoTo Error0
    'RecordCount = rs.RecordCount
    
    '加账户名称
    While Not (rs.EOF Or rs.BOF)
        If m_ShowDestroy = 2 Then '已销户
            If rs("Bdestroy") = True Then
                Me.treStyle.Nodes.Add "K" & rs("accunit_id"), tvwChild, "K" & rs("accdef_id"), "【" & rs("accdef_code") & "】" & rs("caccname")
            End If
        ElseIf m_ShowDestroy = 3 Then '未销户
            If rs("bdestroy") = False Then
                Me.treStyle.Nodes.Add "K" & rs("accunit_id"), tvwChild, "K" & rs("accdef_id"), "【" & rs("caccid") & "】" & rs("caccname")
            End If
        Else
            Me.treStyle.Nodes.Add "K" & rs("accunit_id"), tvwChild, "K" & rs("accdef_id"), "【" & rs("caccid") & "】" & rs("caccname")
        End If
        rs.MoveNext
    Wend
Error0:
    For i = 1 To treStyle.Nodes.count
        If treStyle.Nodes(i).children > 0 Then
            treStyle.Nodes(i).Image = 1
       Else
            treStyle.Nodes(i).Image = 3
        End If
    Next
    NodeKey = ""
    Me.treStyle.Nodes("K0").Selected = False
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing

End Sub