frmphclothmx.frm

这是用Visual Basic6开发的大型喷绘业务管理系统,数据库采用Access数据库

Private Sub Form_Load()
   rgn1 = 0
   n = 0
   Dim Ma As Dat
   Show
   Open App.Path & "\base.dat" For Random As #1 Len = Len(Ma)
   Do While Not EOF(1)
      n = n + 1
      Get #1, n, Ma
      If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
      If rgn1 <> 0 Then
            rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
            CombineRgn rgn1, rgn1, rgn2, 2
                  '释放系统资源
            DeleteObject rgn2
      End If
  Loop
'关闭文件
    Close #1
    SetWindowRgn hwnd, rgn1, True
    DeleteObject rgn1
    ''''''''''连接远程数据库SQL server''''
     ''''''''''连接远程数据库SQL SERVER''''
    On Error GoTo errmsg
    
    Set env = rdoEnvironments(0)
    env.CursorDriver = rdUseOdbc
    d_conn = "uid=sa;pwd=;driver={SQL SERVER};SERVER=ntserver;database=phdatabase;"
    Set cn = env.OpenConnection(dsname:="odbc_api_demo", Prompt:="rdodriverprompt", ReadOnly:=False, Connect:=d_conn)

    ''''''''''
    Combo1.AddItem "外"
    Combo1.AddItem "内"
    MSFlex1.BackColorBkg = RGB(255, 255, 255)
    MSFlex1.BackColorFixed = RGB(238, 236, 218)
    sql = "select  distinct 供应商  from  Clothtable"
    Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
    If result.RowCount <> 0 Then
       Do While Not result.EOF()
          Combo2.AddItem Trim(result("供应商"))
          result.MoveNext
       Loop
    End If
    '''''''''电子表格布置'''''
    MSFlex1.Cols = 7
    MSFlex1.FormatString = "^ 布料号 |^     布料名称     |^   进货日期   |^ 初始长度 |^ 使用长度 |^ 剩余长度 |^     供应厂商    "
errmsg:
    
    If Err.Number <> 0 Then
       'MsgBox Err.Number & ":" & Err.Source & "和" & Err.Description
       Exit Sub
    End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       mX = X
       mY = Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       frmPHClothMX.Move frmPHClothMX.Left - mX + X, frmPHClothMX.Top - mY + Y
    End If
    Picture5.Cls
    Picture6.Cls
    Picture7.Cls
End Sub

Private Sub Form_Paint()
      '''''商品编号'''
    jframe.danum = 3
    jframe.rtop = 50
    jframe.rleft = 35
    jframe.rright = 659
    jframe.rbottom = 97
    jframe.ddraw frmPHClothMX
    ''''''''
    jframe.danum = 3
    jframe.rtop = 102
    jframe.rleft = 35
    jframe.rright = 659
    jframe.rbottom = 370
    jframe.ddraw frmPHClothMX
    '''
    jframe.danum = 3
    jframe.rtop = 375
    jframe.rleft = 35
    jframe.rright = 659
    jframe.rbottom = 420
    jframe.ddraw frmPHClothMX
End Sub

Private Sub Image1_Click()
    Unload Me
End Sub

Private Sub Image2_Click()
    frmPHClothMX.WindowState = 1
End Sub

Private Sub Picture5_Click()
    On Error GoTo errmsg
    ''''''''单一布料号查询'''''''
    If Trim(Text1.Text) <> "" And Trim(Text2.Text) = "" And Trim(Combo1.Text) = "" And Trim(Text3.Text) = "" And Trim(Combo2.Text) = "" Then
       sql = "select  *  from  JTPRtable   where  布料号  like '%" & Trim(Text1.Text) & "%'"
       Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
       If result.RowCount <> 0 Then
          result.MoveLast
          MSFlex1.Rows = result.RowCount + 2
          result.MoveFirst
       End If
       If result.RowCount <> 0 Then
          i = 1
          Do While Not result.EOF()
             MSFlex1.TextArray(i * MSFlex1.Cols) = Trim(result("布料号"))
             result.MoveNext
              i = i + 1
          Loop
       End If
       '''''''''查询布料库''''''''''
       For i = 1 To MSFlex1.Rows - 2
           sql = "select *  from  Clothtable  where   布料编号='" & Trim(MSFlex1.TextArray(i * MSFlex1.Cols)) & "'"
           Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
           If result.RowCount <> 0 Then
              MSFlex1.TextArray(i * MSFlex1.Cols + 1) = Trim(result("布料名称"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 2) = Trim(result("日期"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 6) = Trim(result("供应商"))
           End If
       Next i
       '''''查询机台库''''''''
       For i = 1 To MSFlex1.Rows - 2
           sql = "select *  from  JTPRtable  where   布料号='" & Trim(MSFlex1.TextArray(i * MSFlex1.Cols)) & "'"
           Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
           If result.RowCount <> 0 Then
              MSFlex1.TextArray(i * MSFlex1.Cols + 3) = Trim(result("原有长度"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 4) = Trim(result("实际用布长度"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 5) = Trim(result("剩余长度"))
           End If
       Next i
       ''''''''计算合计''''''''''
       HJlength = 0
       HJYlength = 0
       HJLeftLength = 0
       For i = 1 To MSFlex1.Rows - 2
           HJlength = HJlength + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 3))
           HJYlength = HJYlength + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 4))
           HJLeftLength = HJLeftLength + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 5))
       Next i
       MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols) = "合计:"
       MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 3) = HJlength
       MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 4) = HJYlength
       MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 5) = HJLeftLength
    End If
     ''''''''单一幅宽查询'''''''
    If Trim(Text1.Text) = "" And Trim(Text2.Text) <> "" And Trim(Combo1.Text) = "" And Trim(Text3.Text) = "" And Trim(Combo2.Text) = "" Then
       sql = "select  *  from  JTPRtable   where  布料号='" & Trim(Text1.Text) & "'"
       Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
       If result.RowCount <> 0 Then
          result.MoveLast
          MSFlex1.Rows = result.RowCount + 2
          result.MoveFirst
       End If
       If result.RowCount <> 0 Then
          i = 1
          Do While Not result.EOF()
             MSFlex1.TextArray(i * MSFlex1.Cols) = Trim(result("布料号"))
             result.MoveNext
              i = i + 1
          Loop
       End If
       '''''''''查询布料库''''''''''
       For i = 1 To MSFlex1.Rows - 2
           sql = "select *  from  Clothtable  where   布料编号='" & Trim(MSFlex1.TextArray(i * MSFlex1.Cols)) & "'"
           Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
           If result.RowCount <> 0 Then
              MSFlex1.TextArray(i * MSFlex1.Cols + 1) = Trim(result("布料名称"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 2) = Trim(result("日期"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 6) = Trim(result("供应商"))
           End If
       Next i
       '''''查询机台库''''''''
       For i = 1 To MSFlex1.Rows - 2
           sql = "select *  from  JTPRtable  where   布料号='" & Trim(MSFlex1.TextArray(i * MSFlex1.Cols)) & "'"
           Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
           If result.RowCount <> 0 Then
              MSFlex1.TextArray(i * MSFlex1.Cols + 3) = Trim(result("原有长度"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 4) = Trim(result("实际用布长度"))
              MSFlex1.TextArray(i * MSFlex1.Cols + 5) = Trim(result("剩余长度"))
           End If
       Next i
    End If
errmsg:
    If Err.Number <> 0 Then
       If Text1.Text <> "" Then
       End If
    End If
End Sub

Private Sub Picture5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture6.Cls
    Picture7.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 65
    jframe.rbottom = 29
    jframe.ddrawc Picture5
End Sub

Private Sub Picture6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture5.Cls
    Picture7.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 65
    jframe.rbottom = 29
    jframe.ddrawc Picture6
End Sub

Private Sub Picture7_Click()
    Unload Me
End Sub

Private Sub Picture7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture6.Cls
    Picture5.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 65
    jframe.rbottom = 29
    jframe.ddrawc Picture7
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub