frmstorehouseproductman.frm

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

          .ColWidth(3) = 900
          Else
          .TextMatrix(0, 3) = ""
          .ColWidth(3) = 0
          End If
         .TextMatrix(0, 4) = "布名"
          .ColWidth(4) = 900
         .TextMatrix(0, 5) = "英文布名"
          .ColWidth(5) = 2000
         .TextMatrix(0, 6) = "色位"
          .ColWidth(6) = 900
         .TextMatrix(0, 7) = "組織"
          .ColWidth(7) = 1500
         .TextMatrix(0, 8) = "成份類型"
          .ColWidth(8) = 1500
         .TextMatrix(0, 9) = "成份"
          .ColWidth(9) = 900
         .TextMatrix(0, 10) = "拉伸"
          .ColWidth(10) = 900
         .TextMatrix(0, 11) = "紗織"
          .ColWidth(11) = 900
         .TextMatrix(0, 12) = "紗類型"
          .ColWidth(12) = 900
         .TextMatrix(0, 13) = "紗數"
          .ColWidth(13) = 900
         .TextMatrix(0, 14) = "經動"
          .ColWidth(14) = 900
         .TextMatrix(0, 15) = "緯動"
          .ColWidth(15) = 900
         .TextMatrix(0, 16) = "緯"
          .ColWidth(16) = 900
         .TextMatrix(0, 17) = "經"
           .ColWidth(17) = 900
         .TextMatrix(0, 18) = "類型"
          .ColWidth(18) = 900
         .TextMatrix(0, 19) = "坑數"
           .ColWidth(19) = 900
         .TextMatrix(0, 20) = "片數"
          .ColWidth(20) = 900
         .TextMatrix(0, 21) = "成品組織"
          .ColWidth(21) = 2000
         .TextMatrix(0, 22) = "胚組織"
          .ColWidth(22) = 2000
         .TextMatrix(0, 23) = "淨重"
          .ColWidth(23) = 900
         .TextMatrix(0, 24) = "幅寬"
          .ColWidth(24) = 900
         .TextMatrix(0, 25) = "密度" '
          .ColWidth(25) = 900
         .TextMatrix(0, 26) = "整理"
          .ColWidth(27) = 1200
         .TextMatrix(0, 27) = "價格"
          .ColWidth(28) = 900
         .TextMatrix(0, 28) = "單位"
          .ColWidth(29) = 900
         .TextMatrix(0, 29) = "備注"
          .ColWidth(30) = 2500
         .TextMatrix(0, 30) = "擴展一"
          .ColWidth(30) = 2500
         .TextMatrix(0, 31) = "擴展二"
          .ColWidth(31) = 2500
         .TextMatrix(0, 32) = "填寫人"
          .ColWidth(32) = 900
         '.....................................................
         .Rows = rs.RecordCount + 2
         On Error Resume Next
         For lngrow = 2 To rs.RecordCount + 1
                .TextMatrix(lngrow, 0) = lngrow - 1
                .TextMatrix(lngrow, 1) = FormatDateStr((rs.Fields!UpdateDate), "")
                .TextMatrix(lngrow, 2) = rs.Fields!FabricCode
                 If viewFlag = False Then .TextMatrix(lngrow, 3) = NullValue(rs.Fields!OldFabricCode)
                .TextMatrix(lngrow, 4) = Trim$(NullValue(rs.Fields!FabricName))
                .TextMatrix(lngrow, 5) = Trim$(NullValue(rs.Fields!eFabricName))
                .TextMatrix(lngrow, 6) = Trim$(NullValue(rs.Fields!Color))
                .TextMatrix(lngrow, 7) = Trim$(NullValue(rs.Fields!Weave))
                .TextMatrix(lngrow, 8) = Trim$(NullValue(rs.Fields!CompositionType))
                .TextMatrix(lngrow, 9) = Trim$(NullValue(rs.Fields!Composition))
                .TextMatrix(lngrow, 10) = Trim$(NullValue(rs.Fields!Stretch))
                .TextMatrix(lngrow, 11) = Trim$(NullValue(rs.Fields!Yarn))
                .TextMatrix(lngrow, 12) = Trim$(NullValue(rs.Fields!YarnType))
                .TextMatrix(lngrow, 13) = Trim$(NullValue(rs.Fields!YarnCount))
                .TextMatrix(lngrow, 14) = Trim$(NullValue(rs.Fields!WarpOfCon))
                .TextMatrix(lngrow, 15) = Trim$(NullValue(rs.Fields!WeftOfCon))
                .TextMatrix(lngrow, 16) = Trim$(NullValue(rs.Fields!Weft))
                .TextMatrix(lngrow, 17) = Trim$(NullValue(rs.Fields!Warp))
                .TextMatrix(lngrow, 18) = Trim$(NullValue(rs.Fields!FabricType))
                .TextMatrix(lngrow, 19) = Trim$(NullValue(rs.Fields!Wales))
                .TextMatrix(lngrow, 20) = Trim$(NullValue(rs.Fields!Harness))
                .TextMatrix(lngrow, 21) = Trim$(NullValue(rs.Fields!Construstion))
                .TextMatrix(lngrow, 22) = Trim$(NullValue(rs.Fields!Greige))
                .TextMatrix(lngrow, 23) = Trim$(NullValue(rs.Fields!Actualweight))
                .TextMatrix(lngrow, 24) = Trim$(NullValue(rs.Fields!Width))
                .TextMatrix(lngrow, 25) = Trim$(NullValue(rs.Fields!density))
                .TextMatrix(lngrow, 26) = Trim$(NullValue(rs.Fields!Finish))
                .TextMatrix(lngrow, 27) = Trim$(NullValue(rs.Fields!Price))
                .TextMatrix(lngrow, 28) = Trim$(NullValue(rs.Fields!unit))
                .TextMatrix(lngrow, 29) = Trim$(NullValue(rs.Fields!Remarks))
                .TextMatrix(lngrow, 30) = Trim$(NullValue(rs.Fields!remarkEx1))
                .TextMatrix(lngrow, 31) = Trim$(NullValue(rs.Fields!RemarkEx2))
                .TextMatrix(lngrow, 32) = Trim$(NullValue(rs.Fields!UpdateOperator))
                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()
   If viewFlag Then
        FillMshf1 ("select * from tBasicFabric")
   Else: FillMshf1 ("select * from tBasictBasicProduct")
   End If
   fraFind.Visible = False
End Sub
Private Sub Form_Load()
    '设置窗口大小
    FormInit Me, True
    SetObjectWH Frame1
    SetObjectWH MSHF1
    If viewFlag Then
        Me.Caption = "布種布樣" & "      原布信息"
        FillMshf1 ("select * from tBasicFabric")
    Else
        Me.Caption = "布種布樣" & "      成品信息"
        FillMshf1 ("select * from tBasicProduct")
    End If
    comWarpOfCon.AddItem (">=")
    comWarpOfCon.AddItem ("=")
    comWarpOfCon.AddItem ("<=")
    comWarpOfCon.AddItem ("between")
    comWarp.AddItem (">=")
    comWarp.AddItem ("=")
    comWarp.AddItem ("<=")
    comWarp.AddItem ("between")
    comWeftOfCon.AddItem (">=")
    comWeftOfCon.AddItem ("=")
    comWeftOfCon.AddItem ("<=")
    comWeftOfCon.AddItem ("between")
    comWeft.AddItem (">=")
    comWeft.AddItem ("=")
    comWeft.AddItem ("<=")
    comWeft.AddItem ("between")
    comWeight.AddItem (">=")
    comWeight.AddItem ("=")
    comWeight.AddItem ("<=")
    comWeight.AddItem ("between")
    Records.AddItem ("All")
    Records.AddItem ("200")
    Records.AddItem ("500")
    ActiveBar21.Bands("toolbar").Tools.item("storeView").CBAddItem ("成品信息")
    ActiveBar21.Bands("toolbar").Tools.item("storeView").CBAddItem ("原布信息")
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
    InitTitle
    HookWheel Me.hwnd
End Sub
Private Sub InitTitle()
    Label1.item(4).Caption = "布號"
    Label2.item(2).Caption = "布名"
    Label3.item(0).Caption = "類型"
    Label4.item(0).Caption = "坑數"
    Label5.Caption = "成份"
    Label6.item(1).Caption = "紗織"
    Label7.item(2).Caption = "成品組織"
    Label8.Caption = "胚組織"
    Label9.item(1).Caption = "更新日期"
    Label10.item(3).Caption = "至"
    Label12.Caption = "模糊查詢項"
    cmdFindAll.Caption = "全部 &A"
    cmdFind.Caption = "查詢 &F"
    cmdCancel.Caption = "取消 &C"
    Me.Caption = "布種布樣"
End Sub
'增加布種
Private Sub NewOperatorInf()
    frmBasicProduct.newItem = True
    frmBasicProduct.InitInfo ""
    frmBasicProduct.Show vbModal
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
End Sub

'编辑布種
Private Sub EditOperatorInf()
    frmBasicProduct.newItem = False
    If lngrow = 1 Then Exit Sub
    frmBasicProduct.InitInfo MSHF1.TextMatrix(lngrow, 2)
    frmBasicProduct.Show vbModal
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
End Sub

'删除布種
Private Sub DelOperatorInf()
        Dim strSql As String
        Dim rs As New ADODB.Recordset
        Dim rsobj As New ADODB.Recordset
    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
        If viewFlag Then
            strSql = "delete from  tBasicFabric  where FabricCode='" & MSHF1.TextMatrix(lngrow, 2) & "'"
            objDatabase.ExecCmd strSql
            MsgBox "刪除成功!", vbInformation, "提示"
        Else
            rs.Open "select * from tUnBasicProduct", Cn, 1, 3
            rsobj.Open "select * from tBasicProduct where FabricCode='" & MSHF1.TextMatrix(lngrow, 2) & "'", Cn, 1, 3
            rs.AddNew
            rs.Fields!FabricCode = NullValue(rsobj.Fields!FabricCode)
            rs.Fields!OldFabricCode = NullValue(rsobj.Fields!OldFabricCode)
            rs.Fields!FabricName = NullValue(rsobj.Fields!FabricName)
            rs.Fields!eFabricName = NullValue(rsobj.Fields!eFabricName)
            rs.Fields!Color = NullValue(rsobj.Fields!Color)
            rs.Fields!Weave = NullValue(rsobj.Fields!Weave)
            rs.Fields!CompositionType = NullValue(rsobj.Fields!CompositionType)
            rs.Fields!Composition = NullValue(rsobj.Fields!Composition)
            rs.Fields!Stretch = NullValue(rsobj.Fields!Stretch)
            rs.Fields!Yarn = NullValue(rsobj.Fields!Yarn)
            rs.Fields!YarnType = NullValue(rsobj.Fields!YarnType)
            rs.Fields!YarnCount = NullValue(rsobj.Fields!YarnCount)
            rs.Fields!WarpOfCon = NullValue(rsobj.Fields!WarpOfCon)
            rs.Fields!WeftOfCon = NullValue(rsobj.Fields!WeftOfCon)
            rs.Fields!unit = NullValue(rsobj.Fields!unit)
            rs.Fields!Weft = NullValue(rsobj.Fields!Weft)
            rs.Fields!Warp = NullValue(rsobj.Fields!Warp)
            rs.Fields!FabricType = NullValue(rsobj.Fields!FabricType)
            rs.Fields!Wales = NullValue(rsobj.Fields!Wales)
            rs.Fields!Harness = NullValue(rsobj.Fields!Harness)
            rs.Fields!Construstion = NullValue(rsobj.Fields!Construstion)
            rs.Fields!Greige = NullValue(rsobj.Fields!Greige)
            rs.Fields!Actualweight = NullValue(rsobj.Fields!Actualweight)
            rs.Fields!Width = NullValue(rsobj.Fields!Width)
            rs.Fields!density = NullValue(rsobj.Fields!density)
            rs.Fields!Finish = NullValue(rsobj.Fields!Finish)
            rs.Fields!Price = NullValue(rsobj.Fields!Price)
            rs.Fields!Remarks = NullValue(rsobj.Fields!Remarks)
            rs.Fields!remarkEx1 = NullValue(rsobj.Fields!remarkEx1)
            rs.Fields!RemarkEx2 = NullValue(rsobj.Fields!RemarkEx2)
            rs.Fields!UpdateOperator = NullValue(rsobj.Fields!UpdateOperator)
            rs.Fields!UpdateDate = NullValue(rsobj.Fields!UpdateDate)
            rs.Update
            rs.Close
            rsobj.Close
            Set rs = Nothing
            Set rsobj = Nothing
            strSql = "delete from  tBasicProduct  where FabricCode='" & MSHF1.TextMatrix(lngrow, 2) & "'"
            objDatabase.ExecCmd strSql
            MsgBox "刪除成功!", vbInformation, "提示"
        End If
    End If
    FillMshf1 IIf(viewFlag, "select * from tBasicFabric", "select * from tBasicProduct")
    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 Form_Unload(Cancel As Integer)
    UnHookWheel Me.hwnd
End Sub


Private Sub MSHF1_GotFocus()
    Set CtlWheel = MSHF1
End Sub

Private Sub MSHF1_LostFocus()
Set CtlWheel = Nothing
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
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = True
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = True
    End If
End Sub

Private Sub MSHF1_DblClick()
  EditOperatorInf
End Sub