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

📄 frmmaterin.frm

📁 大学数据库原理的课程设计
💻 FRM
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmMaterIn 
   Caption         =   "入库信息列表"
   ClientHeight    =   6264
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   7836
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6264
   ScaleWidth      =   7836
   WindowState     =   2  'Maximized
   Begin MSFlexGridLib.MSFlexGrid msgList 
      Height          =   5415
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   7575
      _ExtentX        =   13356
      _ExtentY        =   9546
      _Version        =   393216
      Cols            =   4
      FixedCols       =   3
      AllowUserResizing=   1
   End
   Begin VB.Label lblTitle 
      Caption         =   "入  库  物  资  信  息  列  表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   3015
   End
End
Attribute VB_Name = "frmMaterIn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String



Private Sub Form_Load()
    
    ShowTitle
    ShowData
    flagIedit = True
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
        '边界处理
        If Me.ScaleHeight < 10 * lblTitle.Height Then
            
            Exit Sub
        End If
        If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
            
            Exit Sub
        End If
        '控制控件的位置
                
        lblTitle.Top = lblTitle.Height
        lblTitle.Left = (Me.Width - lblTitle.Width) / 2
        
        msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
        msgList.Width = Me.ScaleWidth - 200
        msgList.Left = Me.ScaleLeft + 100
        msgList.Height = Me.ScaleHeight - msgList.Top - 200
    End If
End Sub

Public Sub RecordEdit()
    Dim intCount As Integer
    
    If msgList.Rows > 1 Then
        gintMode = EDIT
        intCount = msgList.Row
        gsSql = " where rkno='" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "'"
        frmMaterIn1.Show 1
        ShowData
        Call MovCursor(intCount, msgList)
    Else
        Call RecordAdd
    End If
End Sub

Public Sub FormClose()
    Unload Me
End Sub

'删除记录
Public Sub RecordDelete()
    Dim sSql As String
    Dim intCount As Integer
    
  On Error GoTo myErr
    
    If msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么?", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = msgList.Row
            
            wksHuaxia.BeginTrans
            
            sSql = "update amsurplus set yeaccount=yeaccount-" & Trim(msgList.TextMatrix(msgList.Row, 7)) & ",yevalue=yevalue-" & Trim(msgList.TextMatrix(msgList.Row, 9)) & " where yeid='" & Trim(msgList.TextMatrix(msgList.Row, 2)) & "'"
            dbHuaxia.Execute sSql, dbSQLPassThrough
            sSql = "delete from " & msTableName & " where rkno='" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "'"
            dbHuaxia.Execute sSql, dbSQLPassThrough
            
            wksHuaxia.CommitTrans
            
            ShowData
            If msgList.Rows > 1 Then
                If intCount = msgList.Rows Then
                    MovCursor msgList.Rows - 1, msgList
                Else
                    MovCursor intCount, msgList
                End If
            End If
        End If
    End If
    
    Exit Sub
    
myErr:
    wksHuaxia.Rollback
    ShowError
End Sub
Public Sub RecordRefresh()
    '设置msSql
    msSql = msSelect & msTableName & " where rkdate>='" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "' and rkdate<='" & Format(Now, "yyyy-mm-dd") & "'" & msOrderBy
        
    '显示数据
    msBarText = "当前数据时间范围:" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "至" & Format(Now, "yyyy-mm-dd")
    sOrder0 = "+ {rkdate}"
    sOrder1 = ""
    
    ShowData
End Sub


Public Sub RecordAdd()
    gintMode = Add
    frmMaterIn1.Show 1
    ShowData
End Sub

Public Sub RecordFind()
    frmMaterIn2.Show 1
    If Trim(frmMaterIn2.sQSql & " ") <> "" Then
        msSql = msSelect & msTableName & " where" & frmMaterIn2.sQSql & msOrderBy
        ShowData
    End If
    Unload frmMaterIn2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    flagIedit = False
    gintImode = 0
End Sub






'显示Grid的内容

Private Sub ShowData()
    
    Dim j As Integer
    Dim i As Integer

  
    Set mrc = ExecuteSQL(txtSQL, MsgText)
        With msgList
        .Rows = 1
        
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 1 To mrc.Fields.Count
                Select Case mrc.Fields(i - 1).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
                End Select
            Next i
            mrc.MoveNext
        Loop
        
          
    End With
    mrc.Close
    
    
End Sub


'显示Grid表头
Private Sub ShowTitle()
    Dim i As Integer
    
    With msgList
        .Cols = 15
        .TextMatrix(0, 1) = ""
        .TextMatrix(0, 2) = "物资编号"
        .TextMatrix(0, 3) = "物资名称"
        .TextMatrix(0, 4) = "规格型号"
        .TextMatrix(0, 5) = "类别"
        .TextMatrix(0, 6) = "计量单位"
        .TextMatrix(0, 7) = "数量"
        .TextMatrix(0, 8) = "单价"
        .TextMatrix(0, 9) = "金额"
        .TextMatrix(0, 10) = "时间"
        .TextMatrix(0, 11) = "经办人"
        .TextMatrix(0, 12) = "保管人"
        .TextMatrix(0, 13) = "仓库"
        .TextMatrix(0, 14) = "备注"
        
        '固定表头
        .FixedRows = 1
                
        '设置各列的对齐方式
        For i = 0 To 6
            .ColAlignment(i) = 0
        Next i
        For i = 7 To 9
            .ColAlignment(i) = 7
        Next i
        For i = 10 To 14
            .ColAlignment(i) = 0
        Next i
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .Col = 0
        .Row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .ColWidth(0) = 300
        .ColWidth(1) = 0
        .ColWidth(2) = 1000
        .ColWidth(3) = 2000
        .ColWidth(4) = 2000
        .ColWidth(5) = 600
        .ColWidth(6) = 1000
        .ColWidth(7) = 600
        .ColWidth(8) = 800
        .ColWidth(9) = 1000
        .ColWidth(10) = 1000
        For i = 11 To 14
            .ColWidth(i) = 1000
        Next i
        .Row = 1
        
    End With
End Sub



Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    '右键弹出
    If Button = 2 And Shift = 0 Then
        PopupMenu fMainForm.menuMaterialin
    End If
    
End Sub


⌨️ 快捷键说明

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