frmfactory.frm

企业ERP系统 采用VB+SQL2000实现。 有客户合约

    Case "cmdRefurbish":
        FillMshf1 "select * from tBasicFactory where status=0"
    Case "cmdRecycle":
        FillMshf1 "select * from tBasicFactory where status=1"
        bRecycle = True
    Case "cmdUnDelete":
        Call UnDelete
    Case "cmdExport":
        Dim strFile As String
        frmMain.CDFile.ShowOpen
        strFile = frmMain.CDFile.FileName
        If strFile = "" Then Exit Sub
        ExportExcel MSHF1, strFile
    End Select
    
End Sub
Private Function FormatQuery() As String
    FormatQuery = "select * from tBasicFactory where status=0 and"
    If Trim$(txtAllName.Text) <> "" Then
        FormatQuery = FormatQuery & " and FactoryAllName='" & txtAllName.Text & "'"
    End If
     If Trim$(txtFactoryName) <> "" Then
        FormatQuery = FormatQuery & " and FactoryName" & objDatabase.FormatLikeSQL(Trim(txtFactoryName.Text))
    End If
    If Trim$(txtAddress) <> "" Then
        FormatQuery = FormatQuery & " and FactoryAddress" & objDatabase.FormatLikeSQL(txtAddress.Text)
    End If
     If Trim$(Tel) <> "" Then
        FormatQuery = FormatQuery & " and tel" & objDatabase.FormatLikeSQL(Trim(Tel))
    End If
    If Trim$(Fax) <> "" Then
        FormatQuery = FormatQuery & " and Fax" & objDatabase.FormatLikeSQL(Fax)
    End If
    If Trim$(SurCharge) <> "" Then
        FormatQuery = FormatQuery & " and SurCharge" & objDatabase.FormatLikeSQL(SurCharge)
    End If
End Function
Public Sub FillMshf1(ByVal strSql As String)
   Dim rs As ADODB.Recordset
   Dim lngrow As Long
      Screen.MousePointer = vbHourglass
      On Error GoTo errLabel
      Set rs = New ADODB.Recordset
      With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        Set .ActiveConnection = Cn
      End With
      rs.Open strSql
      With MSHF1
          .Redraw = False
          .Rows = 2
          '.FixedRows = 2
          .Cols = 12
          '.FixedCols = 3
          .Clear
          '初始化
         .WordWrap = False
         .TextMatrix(0, 0) = "序号"
         .TextMatrix(0, 1) = "工廠簡稱"
         .ColWidth(1) = 1500
         .TextMatrix(0, 2) = "工廠全稱"
         .ColWidth(2) = 2500
         .TextMatrix(0, 3) = "電話"
         .ColWidth(3) = 1500
         .TextMatrix(0, 4) = "傳真"
         .ColWidth(4) = 1500
         .TextMatrix(0, 5) = "聯繫人"
         .ColWidth(5) = 1500
         .TextMatrix(0, 6) = "付加費"
         .ColWidth(6) = 1500
         .TextMatrix(0, 7) = "備註"
         .ColWidth(7) = 2500
         .TextMatrix(0, 8) = "工廠地址"
         .ColWidth(8) = 2500
         .TextMatrix(0, 9) = "填寫人"
         .ColWidth(9) = 1500
         .TextMatrix(0, 10) = "填入日期"
         .ColWidth(10) = 1500
         .TextMatrix(0, 11) = ""
         .ColWidth(11) = 0
         .ColWidth(0) = 600
         '.....................................................
         .Rows = rs.RecordCount + 2
         On Error Resume Next
         For lngrow = 2 To rs.RecordCount + 1
                .TextMatrix(lngrow, 0) = lngrow - 1
                .TextMatrix(lngrow, 1) = Trim$(NullValue(rs.Fields!FactoryName))
                .TextMatrix(lngrow, 2) = Trim$(NullValue(rs.Fields!FactoryAllName))
                .TextMatrix(lngrow, 3) = Trim$(NullValue(rs.Fields!Tel))
                .TextMatrix(lngrow, 4) = Trim$(NullValue(rs.Fields!Fax))
                .TextMatrix(lngrow, 5) = Trim$(NullValue(rs.Fields!Linkman))
                .TextMatrix(lngrow, 6) = Trim$(NullValue(rs.Fields!SurCharge))
                .TextMatrix(lngrow, 7) = Trim$(NullValue(rs.Fields!Remark))
                .TextMatrix(lngrow, 8) = Trim$(NullValue(rs.Fields!FactoryAddress))
                .TextMatrix(lngrow, 9) = Trim$(NullValue(rs.Fields!UpdateOperator))
                .TextMatrix(lngrow, 10) = Trim$(NullValue(rs.Fields!UpdateDate))
                .TextMatrix(lngrow, 11) = Trim$(NullValue(rs.Fields!ID))
                rs.MoveNext
          Next
          lngrow = 0
          .TextMatrix(1, 0) = "总计"
          .TextMatrix(1, 1) = .Rows - 2
           SetItemBackColor MSHF1
          .Redraw = True
      End With
      rs.Close
remClear:
    Set rs = Nothing
    Screen.MousePointer = vbDefault
    Exit Sub
errLabel:
    On Error Resume Next
    MSHF1.Redraw = True
    GoTo remClear
End Sub

Private Sub cmdCancel_Click()
     fraFind.Visible = False
End Sub

Private Sub CmdFind_Click()
     FillMshf1 FormatQuery
     fraFind.Visible = False
End Sub

Private Sub cmdFindAll_Click()
   FillMshf1 ("select * from tBasicFactory where status=0")
   fraFind.Visible = False
End Sub

Private Sub Form_Load()
    '设置窗口大小
    FormInit Me, True
    SetObjectWH Frame1
    SetObjectWH MSHF1
    FillMshf1 ("select * from tBasicFactory where status=0")
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdUnDelete").Enabled = False
    bRecycle = False
    Me.Caption = "加工廠信息"
    HookWheel Me.hwnd
End Sub
'增加加工廠
Private Sub NewOperatorInf()
    frmBasicFactoryInfo.newItem = True
    frmBasicFactoryInfo.InitInfo ""
    frmBasicFactoryInfo.Show vbModal
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdUnDelete").Enabled = False
End Sub

'编辑加工廠
Private Sub EditOperatorInf()
    frmBasicFactoryInfo.newItem = False
    If lngrow = 1 Then Exit Sub
    frmBasicFactoryInfo.InitInfo MSHF1.TextMatrix(lngrow, 2)
    frmBasicFactoryInfo.Show vbModal
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdUnDelete").Enabled = False
End Sub
Private Sub UnDelete()
    Dim strSql As String
    If lngrow > MSHF1.Rows - 1 Then Exit Sub
    If lngrow <= 1 Then
        MsgBox "请选中一条要恢復的记录！", vbExclamation, "提示"
        Exit Sub
    End If
        On Error GoTo errHandle
    
    If MsgBox("确定要恢復嗎？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "Update tBasicFactory set status=0 where FactoryAllName='" & MSHF1.TextMatrix(lngrow, 2) & "'"
        objDatabase.ExecCmd strSql
        MsgBox "恢復成功!", vbInformation, "提示"
    End If
    FillMshf1 ("select * from tBasicFactory where status=1")
    ActiveBar21.Bands("toolbar").Tools.item("cmdUnDelete").Enabled = False
    bRecycle = False
    Exit Sub
errHandle:

   objDatabase.DatabaseError
End Sub

'删除加工廠
Private Sub DelOperatorInf()
        Dim strSql As String
    
    If lngrow > MSHF1.Rows - 1 Then Exit Sub
    If lngrow <= 1 Then
        MsgBox "请选中一条要删除的记录！", vbExclamation, "提示"
        Exit Sub
    End If
        On Error GoTo errHandle
    
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "Update tBasicFactory set status=1 where FactoryAllName='" & MSHF1.TextMatrix(lngrow, 2) & "'"
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
    FillMshf1 ("select * from tBasicFactory where status=0")
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
    Exit Sub
errHandle:

   objDatabase.DatabaseError
    
End Sub



Private Sub MSHF1_Click()
    lngrow = Val(MSHF1.row)
    If lngrow = 1 Then
        MSHF1.Sort = 1
    Else
       MSHF1.row = lngrow
        MSHF1.col = 0
        MSHF1.ColSel = MSHF1.Cols - 1
        If bRecycle = False Then
                ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = True
                ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = True
        Else
                ActiveBar21.Bands("toolbar").Tools.item("cmdUnDelete").Enabled = True
        End If
    End If
End Sub

Private Sub MSHF1_DblClick()
   EditOperatorInf
End Sub