⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmorder.frm

📁 本程序源码是由vb编写的
💻 FRM
📖 第 1 页 / 共 5 页
字号:
   End If

End Sub

Private Sub dtStartDate_Change()
   
   If dtStartDate.Value > dtEndDate Then
      dtEndDate.Value = dtStartDate.Value
   End If

End Sub

Private Sub FocusText1_Change()

    If Trim(FocusText1.Text) <> "" Then
       Command4.Enabled = True
     Else
       Command4.Enabled = False
    End If
     
End Sub

Private Sub FocusText1_KeyPress(KeyAscii As Integer)
   
   If KeyAscii = 13 And Trim(FocusText1.Text) <> "" Then
     If Command4.Enabled = True Then Call Command4_Click
   End If
   
End Sub

Private Sub Form_Load()

    Screen.MousePointer = 11
   '安装项目
    GuestLay = 1
    StartLoad
   '配置网格
    ConfigData
    New_AniCur.AniFileName = App.Path & "\sys\2.ani"
    New_AniCur.SetAniCursor cmdSelectGuest.hwnd
    Screen.MousePointer = 0
   
End Sub

Private Sub Form_Resize()

 If Me.WindowState = 1 Then Exit Sub
 
 On Error Resume Next
 lbStatus.left = Me.Width - lbStatus.Width - 300
 lbStatus.tOp = 150

 picOperator.left = 20
 picOperator.tOp = tbOrder.Height + 40
 picOperator.Width = Me.ScaleWidth - 40
 picOperator.Height = Me.ScaleHeight - tbOrder.Height - 60
 
 With picSelectSuppler
      .Width = Me.ScaleWidth
      .left = 0 - .Width
      .tOp = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
 With picSelectP
      .Width = Me.ScaleWidth
      .left = 0 - .Width
      .tOp = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
 With picBrowser
      .Width = Me.ScaleWidth
      .left = 0 - .Width
      .tOp = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
 
End Sub

Private Sub Form_Unload(Cancel As Integer)

 '御载选择供应商窗体
  If SupplerForm = True Then
     Unload frmSuppler
  End If
  
  New_AniCur.RelaseAniCursor cmdSelectGuest.hwnd
  Set New_AniCur = Nothing
  
End Sub

Private Sub Grid1_EnterCell()
 
  On Error Resume Next
  If txtEdit.Enabled = False Then Exit Sub
     txtEdit.Text = ""
 '如果上一行没有填,下一行将不能继续
  If Grid1.Row > 1 Then
     If Trim(Grid1.TextMatrix(Grid1.Row - 1, 1)) = "" Then
        txtEdit.Visible = False
        cmdSelect.Visible = False
        Exit Sub
     End If
  End If
  
 '编辑窗定位
    txtEdit = ""
    txtEdit.left = (Grid1.left + Grid1.CellLeft) - 10
    txtEdit.tOp = Grid1.tOp + Grid1.CellTop - 10
    txtEdit.Width = Grid1.CellWidth + 20
    cmdSelect.tOp = Grid1.tOp + Grid1.CellTop + 8
    cmdSelect.left = txtEdit.left + (txtEdit.Width - cmdSelect.Width) - 30
    txtEdit.Visible = True
    
 '单位 Lock
  If Grid1.Col = 2 Then
     txtEdit.Locked = True
     Else
     txtEdit.Locked = False
  End If

 '检测行的类型
  If Grid1.Col > 3 And Grid1.Col < 6 + CodeQua Then '货币
     EnterType = 3
     txtEdit.TextType = 有小数点数字
     Else
     EnterType = 1
     txtEdit.TextType = 普通文本类型
  End If
  
'选择UnitID
  If Grid1.Col = 1 Then
     cmdSelect.Visible = True
     Else
     cmdSelect.Visible = False
  End If
      
  If EnterType = 3 Then '货币时更改
     If Trim(Grid1.TextMatrix(Grid1.Row, 1)) <> "" Then
        If Trim(Grid1.TextMatrix(Grid1.Row, Grid1.Col)) = "" Then
           txtEdit.Text = 0
         Else
           txtEdit.Text = Grid1.Text
        End If
      Else
        txtEdit.Text = Grid1.Text
     End If
   Else
     txtEdit.Text = Grid1.Text
  End If
 
  txtEdit.Visible = True
  txtEdit.SetFocus
  
End Sub

Private Sub Grid1_LeaveCell()

  On Error Resume Next
  If txtEdit.Enabled = False Then Exit Sub
 '保留最后一次坐标
  Grid_old.Row = Grid1.Row
  Grid_old.Col = Grid1.Col
  
 If Grid1.Row = 0 Or Grid1.Col = 0 Then Exit Sub
   If Grid_old.Col = 1 Then
     If Trim(txtEdit.Text) = "" Then Exit Sub
       'Search UnitID
        ProductSearch Trim(txtEdit.Text), "Goods"
     If GetProduct.Exsite = False Then
        Exit Sub
      Else
        Dim sErr As Integer, sErrX As Integer
        Dim x As Integer
        For x = 1 To CodeQua + 2
            If Grid1.TextMatrix(Grid1.Row, x + 3) = "" Then
               sErrX = 1
              Else
               sErrX = 0
            End If
            sErr = sErr + sErrX
        Next
       If sErr >= CodeQua + 2 Then
        Grid1.TextMatrix(Grid1.Row, 1) = GetProduct.ID
        Grid1.TextMatrix(Grid1.Row, 2) = GetProduct.Name
        Grid1.TextMatrix(Grid1.Row, 3) = GetProduct.Unit
        For x = 1 To CodeQua
           Grid1.TextMatrix(Grid1.Row, 3 + x) = 0
        Next
        Grid1.TextMatrix(Grid1.Row, 4 + CodeQua) = GetProduct.Price
        Grid1.TextMatrix(Grid1.Row, 5 + CodeQua) = 0
        Exit Sub
       End If
     End If
   End If
 '如果上一行没有填,下一行将不能继续
  If Grid1.Row > 1 Then
     If Trim(Grid1.TextMatrix(Grid1.Row - 1, 1)) = "" Then
        Exit Sub
     End If
  End If

 If EnterType = 3 Then
   If Trim(txtEdit.Text) <> "" Then
      If Trim(Grid1.TextMatrix(Grid1.Row, 1)) = "" Then
         Grid1.Text = ""
        Else
         Grid1.Text = Trim(txtEdit)
      End If
   End If
   Else
   Grid1.Text = Trim(txtEdit)
 End If
 
 If Trim(Grid1.TextMatrix(Grid1.Row, 1)) <> "" Then
   ' 合计
    For x = 1 To CodeQua + 2
     If Trim(Grid1.TextMatrix(Grid1.Row, 3 + x)) = "" Then
        Grid1.TextMatrix(Grid1.Row, 3 + x) = "0"
     End If
     Next
     '光标在数量与单价区时
     If Grid1.Col > 3 And Grid1.Col <> 5 + CodeQua Then '有产品编号时
            cJE = 0
        For x = 1 To CodeQua
            cJE = cJE + CCur(Grid1.TextMatrix(Grid1.Row, 3 + x))
        Next
            Grid1.TextMatrix(Grid1.Row, 5 + CodeQua) = CCur((Grid1.TextMatrix(Grid1.Row, 4 + CodeQua))) * cJE
     ElseIf Grid1.Col > 3 Then
       If CCur(Trim(Grid1.TextMatrix(Grid1.Row, 5 + CodeQua))) >= 0 Then '修改金额时自动修改单价
                cJE = 0
            For x = 1 To CodeQua
                cJE = cJE + CCur(Grid1.TextMatrix(Grid1.Row, 3 + x))
            Next
            Grid1.TextMatrix(Grid1.Row, 4 + CodeQua) = CCur(Grid1.TextMatrix(Grid1.Row, 5 + CodeQua)) / cJE
            Grid1.TextMatrix(Grid1.Row, 5 + CodeQua) = CCur((Grid1.TextMatrix(Grid1.Row, 4 + CodeQua))) * cJE
       End If
     End If
 End If
 
 'Acount Qua and Amo
  AcountThis
  
  txtEdit.Visible = False
  cmdSelect.Visible = False
  txtEdit.Text = ""
   
End Sub

Private Sub Grid1_Scroll()

  Call Grid1_ScrollBar
  txtEdit.Visible = False
  cmdSelect.Visible = False
  
End Sub

Private Sub Grid1_SelChange()

 If txtEdit.Enabled = False Then Exit Sub
    AcountThis
  
End Sub

Private Sub Grid2_DblClick()
   
   If Grid2.Text = "" Then
      Exit Sub
   End If
   If GuestLay = 2 Then
    FormID = "Order100"
    frmOrder.txtUnitID.Text = Grid2.TextMatrix(Grid2.Row, 1)
    frmOrder.lbUnit = Grid2.TextMatrix(Grid2.Row, 2)
    MovePic picSelectSuppler, False, frmOrder, txtUnitID, Grid2
    Exit Sub
   End If
   If GuestLay = 1 Then
      ConfigSuppler "Select * From Suppler Where Class='" & Grid2.Text & "'", False
   End If
   
End Sub

Private Sub Grid2_KeyPress(KeyAscii As Integer)

  If Grid2.Text = "" Then
      Exit Sub
    End If
    
  If KeyAscii = 13 Then
     KeyAscii = 0
   If GuestLay = 2 Then
    frmOrder.txtUnitID.Text = Grid2.TextMatrix(Grid2.Row, 1)
    frmOrder.lbUnit = Grid2.TextMatrix(Grid2.Row, 2)
    MovePic picSelectSuppler, False, frmOrder, txtUnitID, Grid2
    Exit Sub
   End If
   If GuestLay = 1 Then
      ConfigSuppler "Select * From Suppler Where Class='" & Grid2.Text & "'", False
   End If
  End If
  
End Sub

Private Sub Grid3_KeyPress(KeyAscii As Integer)

  If Grid3.Text = "" Then
      Exit Sub
    End If
    
  If KeyAscii = 13 Then
     KeyAscii = 0
   If ProductLay = 2 Then
    frmOrder.txtEdit.Text = Grid3.TextMatrix(Grid3.Row, 1)
    MovePic picSelectP, False, frmOrder, txtEdit, Grid3
    Exit Sub
   End If
   If ProductLay = 1 Then
      ConfigProduct "Select * From Goods Where Class='" & Grid3.Text & "'", False
   End If
  End If

End Sub

Private Sub Grid4_DblClick()

  If Trim(Grid4.Text) = "" Then Exit Sub
     ShowOrder Grid4.Text
     FormID = "Order100"
     If txtUnitID.Enabled = True Then
        tbOrder.Buttons(6).Enabled = True
        tbOrder.Buttons(8).Enabled = True
        tbOrder.Buttons(2).Enabled = True
     End If
        tbOrder.Buttons(4).Enabled = True
        tbOrder.Buttons(1).Enabled = True
        MovePic picBrowser, False, frmOrder, Grid1, Grid4
        txtEdit.Text = Grid1.Text
        
End Sub

Private Sub picBrowser_Resize()
 
  On Error Resume Next
  Grid4.left = 0
  Grid4.tOp = 0
  Grid4.Width = picBrowser.ScaleWidth
  Grid4.Height = picBrowser.ScaleHeight - picTool1.Height - 100
  picTool1.left = 0
  picTool1.tOp = Grid4.Height + 50
  picTool1.Width = Grid4.Width

End Sub

Private Sub picOperator_Resize()

   On Error Resume Next
   Grid1.left = 120
   Grid1.tOp = 1800
   Grid1.Width = picOperator.Width - 300
   Grid1.Height = picOperator.Height - 2400
   Frame1.tOp = picOperator.Height - 650
   Frame1.left = 120
   Frame1.Width = Grid1.Width
   
End Sub

Private Sub picSelectP_Resize()
 
  On Error Resume Next
  Grid3.left = 0
  Grid3.tOp = 0
  Grid3.Width = picSelectP.ScaleWidth
  Grid3.Height = picSelectP.ScaleHeight - Picture1.Height - 100
  Picture1.left = 0
  Picture1.tOp = Grid3.Height + 50
  Picture1.Width = Grid3.Width

End Sub

Private Sub picSelectSuppler_Resize()
 
  On Error Resume Next
  Grid2.left = 0
  Grid2.tOp = 0
  Grid2.Width = picSelectSuppler.ScaleWidth
  Grid2.Height = picSelectSuppler.ScaleHeight - picTool.Height - 100
  picTool.left = 0
  picTool.tOp = Grid2.Height + 50
  picTool.Width = Grid2.Width

End Sub

Private Sub picTool_Resize()

   On Error Resume Next
   cmdExit.left = picTool.Width - cmdExit.Width - 200

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -