frmbook.frm

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

            If c = tdbBook.Columns.Count - 1 Then
                strHeaderFormat = strHeaderFormat & "10"
                strHeader = strHeader & tdbBook.Columns(c).Caption
            Else
                strHeaderFormat = strHeaderFormat & "10|"
                strHeader = strHeader & Trim(tdbBook.Columns(c).Caption) & "|"
            End If
        Next c
        
        .cqTable.Content = arr
        .cqTable.LayOut = " Format=" & strHeaderFormat & "" & _
                          " Header=" & strHeader & ""
        
        '采用传句柄方式
        '.cqTable.Hwnd = Me.grdDetail.Hwnd
    End With
        
    With frm
        Set .PrintInfo = p
        '设置重复打印部分
        Call .setRepeat(cp_RepeatView_All)
        '设置表格填充空行
        '.blnEmptyRow = True
        '设置表格最后行拉伸到满页
        '.blnExtenLastCol = True
        '设置表格自动调整列宽到满页
        .blnColumnForPage = True
        '设置汇总高度，视汇总行数而定
        .SubTotal_Height = 600
        '设置页高、页宽、行高及最大页数
        '.MaxRowsPerPage = 10
        '.Row_Height = 300
        .TopHeader_Height = 1
        .SubTotal_Height = 600
        .ParagraphInterRate = 0.4
        .PrintPaperSize = pprEnv9
        '设置打印信息保存位置
        .strPrintInfoName = "图书资料|" & Me.Caption
        
        .FormStart
        .Show vbModal
    End With
    Exit Sub
err:
    MsgBox "打印出错！"
End Sub
Private Sub cmdExit_Click()
  Frame1.Visible = False
End Sub

Private Sub cmdOK_Click()
    Dim intNo As Integer
    Dim sqlstring As String
    Dim rstmp As New ADODB.Recordset
    Dim strQuery(4) As String
   
    
   
    On Error Resume Next
    If chkFields(0).Value = 1 Then '书号
       strQuery(0) = " chrBookNo like '%" & txtFields(0) & "%' and "
    End If
    
    If chkFields(1).Value = 1 Then '书名
       strQuery(1) = " chrBookName like '%" & txtFields(1) & "%' and "
    End If
    '图书类别
    If chkFields(2).Value = 1 Then
       strQuery(2) = " chrBookType like '%" & cmbFields(0) & "%' and "
    End If
    
    '制品类型
    strQuery(3) = " ChrProduceType like '%" & cmbFields(1) & "%' "
    
    
    sqlstring = "SELECT BookData.ChrBookNo, BookData.ChrBookName, " _
        & "BookData.ChrProduceType, BookData.ChrBookType, " _
        & "BookData.ChrAuthoer, BookData.Chrbookconcern, ChrCompanyName, " _
        & "format(BookData.DatPublishDate,'yyyy-mm-dd'), BookData.ChrDegree, " _
        & "BookData.ChrFormat, BookData.ChrBindMode, BookData.DecAgio, " _
        & "BookData.DecPrice, BookData.ChrGHS, ClientData.chrClientName," _
        & "BookData.ChrRemark" _
        & " FROM (BookData LEFT JOIN PublishingCompanyData " _
        & "ON BookData.Chrbookconcern=PublishingCompanyData.chrCompanyNo) " _
        & "LEFT JOIN ClientData ON BookData.ChrGHS=ClientData.chrClientNO where " & strQuery(0) & strQuery(1) & strQuery(2) & strQuery(3)
    
    Set rstmp = New ADODB.Recordset
    rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
    If rstmp.Recordcount = 0 Then
       MsgBox "没有满足该查询条件的图书记录！", vbInformation
    Else
       If chkFields(2).Value <> 1 Then
          Call ShowExpRecord(rstmp, 1)
       Else
          Call ShowExpRecord(rstmp, 0)
       End If
       
    End If
    
'    If rstmp.Recordcount = 0 Then
'       MsgBox "没有满足该查询条件的图书记录！", vbInformation
'    ElseIf rstmp.Recordcount = 1 Then
'       If chkFields(2).Value <> 1 Then
'          Call ShowRecord(rstmp.Fields("ChrProduceType"), 1)
'       Else
'          Call ShowRecord(rstmp.Fields("chrBookType"), 0)
'       End If
'       intNo = X.Find(0, 0, rstmp.Fields("chrBookNo").Value)
'       If intNo <> 0 Then
'         tdbBook.Bookmark = intNo
'       End If
'    Else
'        If chkFields(2).Value <> 1 Then
'          Call ShowRecord(rstmp.Fields("ChrProduceType"), 1)
'       Else
'          Call ShowRecord(rstmp.Fields("chrBookType"), 0)
'       End If
'       intNo = X.Find(0, 0, rstmp.Fields("chrBookNo").Value)
'       If intNo <> 0 Then
'         tdbBook.Bookmark = intNo
'       End If
'    End If
   Call clearAlltxtFields
    Frame1.Visible = False
End Sub

Public Sub CmdSave_Click()
    On Error GoTo SaveErr
    Dim i As Integer
    Dim sqlstring As String
    Dim rsNewTmp As New ADODB.Recordset
    Dim strNull
    
    strNull = Null
    
    Select Case intFormState
      Case modadd
          cN.BeginTrans
          tdbBook.Update
          For i = 0 To X.UpperBound(1)
              If IsVacancy(X(i, 6)) Then '判断出版日期是否为空
                sqlstring = "Insert into BookData " _
                         & " (ChrBookNo,ChrBookName,chrProduceType,chrBookType,chrAuthoer,chrBookConcern,chrDegree,chrFormat,chrBindMode,decAgio,decPrice,chrGHS,chrRemark) values" _
                         & "('" & X(i, 0) & "','" & X(i, 1) & "','" & X(i, 2) & "','" & X(i, 3) & "','" & X(i, 4) & "','" & X(i, 5) & "','" & _
                         IIf(IsVacancy(X(i, 7)), strNull, X(i, 7)) & "','" & IIf(IsVacancy(X(i, 8)), strNull, X(i, 8)) & "','" & IIf(IsVacancy(X(i, 9)), strNull, X(i, 9)) & "'," & X(i, 10) & _
                         "," & X(i, 11) & ",'" & X(i, 12) & "','" & IIf(IsVacancy(X(i, 13)), strNull, X(i, 13)) & "')"
              Else
                sqlstring = "Insert into BookData " _
                           & " (ChrBookNo,ChrBookName,chrProduceType,chrBookType,chrAuthoer,chrBookConcern,datPublishDate,chrDegree,chrFormat,chrBindMode,decAgio,decPrice,chrGHS,chrRemark) values" _
                           & "('" & X(i, 0) & "','" & X(i, 1) & "','" & X(i, 2) & "','" & X(i, 3) & "','" & X(i, 4) & "','" & X(i, 5) & "',#" & IIf(IsVacancy(X(i, 6)), strNull, X(i, 6)) & "#,'" & _
                           IIf(IsVacancy(X(i, 7)), strNull, X(i, 7)) & "','" & IIf(IsVacancy(X(i, 8)), strNull, X(i, 8)) & "','" & IIf(IsVacancy(X(i, 9)), strNull, X(i, 9)) & "'," & X(i, 10) & _
                           "," & X(i, 11) & ",'" & X(i, 12) & "','" & IIf(IsVacancy(X(i, 13)), strNull, X(i, 13)) & "')"
              End If
              cN.Execute (sqlstring)
          Next i
          cN.CommitTrans
      Case modEdit
          
          cN.BeginTrans
          tdbBook.Update
          For i = 0 To X.UpperBound(1)
              If IsVacancy(X(i, 6)) Then '判断出版日期是否为空
                sqlstring = "update BookData " _
                          & " set chrProduceType='" & X(i, 2) & "',chrBookType='" & X(i, 3) & "',chrAuthoer='" & X(i, 4) & "',chrBookConcern='" & X(i, 5) & "',datPublishDate=" & IIf(IsNull(strNull), "1900-01-01", strNull) & _
                          ",chrDegree='" & IIf(IsVacancy(X(i, 7)), strNull, X(i, 7)) & "',chrFormat='" & IIf(IsVacancy(X(i, 8)), strNull, X(i, 8)) & "',chrBindMode='" & IIf(IsVacancy(X(i, 9)), strNull, X(i, 9)) & _
                          "',decAgio=" & Format(X(i, 10), "0.00") & ",decPrice=" & CDbl(X(i, 11)) & ",chrGHS='" & X(i, 12) & _
                          "',chrRemark='" & IIf(IsVacancy(X(i, 13)), strNull, X(i, 13)) & "' where chrBookNo='" & X(i, 0) & "' and chrBookName='" & X(i, 1) & "'"
              Else
                sqlstring = "update BookData " _
                            & " set chrProduceType='" & X(i, 2) & "',chrBookType='" & X(i, 3) & "',chrAuthoer='" & X(i, 4) & "',chrBookConcern='" & X(i, 5) & "',datPublishDate=#" & IIf(IsVacancy(X(i, 6)), strNull, X(i, 6)) & _
                            "#,chrDegree='" & IIf(IsVacancy(X(i, 7)), strNull, X(i, 7)) & "',chrFormat='" & IIf(IsVacancy(X(i, 8)), strNull, X(i, 8)) & "',chrBindMode='" & IIf(IsVacancy(X(i, 9)), strNull, X(i, 9)) & _
                            "',decAgio=" & Format(X(i, 10), "0.00") & ",decPrice=" & CDbl(X(i, 11)) & ",chrGHS='" & X(i, 12) & _
                            "',chrRemark='" & IIf(IsVacancy(X(i, 13)), strNull, X(i, 13)) & "' where chrBookNo='" & X(i, 0) & "' and chrBookName='" & X(i, 1) & "'"
              End If
              cN.Execute (sqlstring)
          Next i
          cN.CommitTrans
      Case Else
        Exit Sub
    End Select
    
    Select Case strParent '判断是否是根目录保存
      Case "图书", "文具", "光盘", "音像" '根目录
        If ShowRecord(strParent, 1) Then
           setFormState (ModNormal)
        End If
      Case Else  '子目录
        If ShowRecord(strParent, 0) Then
           setFormState (ModNormal)
        End If
    End Select
    
    blnIsModified = False
    Exit Sub
SaveErr:
    cN.RollbackTrans
    MsgBox "保存记录出错：" & err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim arrQuery
  Dim i As Integer
  
  Select Case Index
    Case 0 '书号
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & txtFields(0).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(0).Text = arrQuery(0, 0)
             
        End If
    Case 1 '书名
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & txtFields(1).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(1).Text = arrQuery(0, 1)
              
        End If
  End Select
End Sub

Public Sub cmdUndo_Click()
    '询问是否放弃当前内容
    If blnIsModified Then
        If MsgBox("当前修改的内容会丢失。确认要取消吗？", vbOKCancel, "询问") <> vbOK Then Exit Sub
    End If
    clearAll
    setFormState (ModNormal)
    blnIsModified = False
    
End Sub


Private Sub Form_Activate()
  SetToolBar ("1100X11X111X111X1")
End Sub

Private Sub Form_Load()
  Dim File As Node
  Dim Recordcount As Integer
  Dim strNo As String
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
    
  On Error Resume Next

   '制品类型
   sqlstring = "select * from ProduceType order by ChrProduceNo"
   Set rstmp = New ADODB.Recordset
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   cmbFields(1).Text = "图书"
   Do While Not rstmp.EOF
      cmbFields(1).AddItem rstmp.Fields("ChrProduceType")
      rstmp.MoveNext
   Loop
   
   '图书分类
   sqlstring = "select * from BookType order by ChrBookType"
   Set rstmp = New ADODB.Recordset
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   cmbFields(0).Text = "保险"
   Do While Not rstmp.EOF
      cmbFields(0).AddItem rstmp.Fields("ChrBookType")
      rstmp.MoveNext
   Loop
   
  tvwFile.Style = 7 ' Style 1.
  tvwFile.LineStyle = tvwRootLines 'Linestyle 1.
     
  '从制品类型表中查询数据生成树型视图
  sqlstring = "select * from ProduceType order by ChrProduceNo "
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
     
  Do While Not rstmp.EOF
     Select Case rstmp.Fields("chrProduceType").Value
        Case "图书"
           Set File = tvwFile.Nodes.Add(, , "r" & rstmp.Fields("ChrProduceNo"), rstmp.Fields("chrProduceType"), 6, 6)
           File.ForeColor = vbRed
           strNo = rstmp.Fields("ChrProduceNo")
        Case "音像"
           Set File = tvwFile.Nodes.Add(, , "r" & rstmp.Fields("ChrProduceNo"), rstmp.Fields("chrProduceType"), 3, 3)
        Case "光盘"
           Set File = tvwFile.Nodes.Add(, , "r" & rstmp.Fields("ChrProduceNo"), rstmp.Fields("chrProduceType"), 2, 2)