[公告]技术区5.1比赛作品发表专帖

请所有参赛者将各自作品以附件的形式上传于此帖。
按照大赛规定，作品征集时间为5.11---5.13 ！
请各位参赛者互相转告，在此跟帖，具体作品要求请参照：
http://www.thysea.com/lb/cgi-bin/topic.cgi?forum=1&topic=4430&show=0
所有上传作品源代码及设计文字版权为各作者所有。

做是做好了～～
附件大小可以传吗？

frmabout

Private Sub cmdOK_Click()
    Unload Me
End Sub
Private Sub Label1_Click()
    ShellExecute 0, "", "http://www.3h-x.com/bbs", "", "", 5
End Sub
Private Sub Label2_Click()
    ShellExecute 0, "", "mailto:zhanlingyangnan@163.com", "", "", 5
End Sub

frmlogin

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Public OK As Boolean
Private Sub Form_Load()
    Dim sBuffer As String
    Dim lSize As Long

    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    If lSize > 0 Then
        txtUserName.Text = left$(sBuffer, lSize)
    Else
        txtUserName.Text = vbNullString
    End If
    ';初始化数据连接
    Data2.DatabaseName = DataPath
    ';数据源为user表单
    Data2.RecordSource = "用户管理"
   
End Sub

Private Sub cmdCancel_Click()
    OK = False
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    ';ToDo: 创建测试密码是否正确
     On Error Resume Next
    ';检查正确密码
    Dim success As Boolean
    success = False
   
    Dim fit As String
    ';查找用户名
    fit = "用户名=';"
    fit = fit + txtUserName.Text + "';"
    Data2.Recordset.FindFirst fit
    ';找不到该用户
    If Data2.Recordset.NoMatch Then
        success = False
        MsgBox "该用户不存在!", vbCritical
        Exit Sub
    Else
        ';找到该用户，但密码错误
        On Error GoTo enter
        Dim OldPas As String
        OldPas = Data2.Recordset.Fields("用户密码").Value
        If OldPas = txtPassword.Text Then
enter:
            success = True
            ';以下三个变量保存以备后用
            UserName = txtUserName.Text ';用户名
            UserPas = txtPassword.Text ';密码
            Purview = Data2.Recordset.Fields("用户权限").Value ';权限
        Else
            success = False
        End If
    End If
    ';如果登陆失败
    If success = False Then
        MsgBox "密码错误，再试一次！", vbExclamation, "登录"
        txtPassword.SetFocus
        txtPassword.SelStart = 0
        txtPassword.SelLength = Len(txtPassword.Text)
        Exit Sub
    Else
        OK = True
        Me.Hide
    End If
   
End Sub

frmlogin Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Public Sub InitPurview() ';初始化17种权限状态 Dim i As Integer For i = 16 To 0 Step -1 If GetBit(Purview, i + 1) = 0 Then 权限类别(16 - i) = 0 Else 权限类别(16 - i) = 1 End If Next End Sub ';根据用户权限来初始化菜单 Private Sub InitMenu() If 权限类别(0) = 0 Then M新增入库单.Enabled = False M新增出库单.Enabled = False M新增借入单.Enabled = False M新增借出单.Enabled = False M新增调拔单.Enabled = False M新增报损单.Enabled = False 新增单据(0).MouseIcon = Picture1.MouseIcon 新增单据(1).MouseIcon = Picture1.MouseIcon 新增单据(2).MouseIcon = Picture1.MouseIcon 新增单据(3).MouseIcon = Picture1.MouseIcon 新增单据(4).MouseIcon = Picture1.MouseIcon 新增单据(5).MouseIcon = Picture1.MouseIcon tbToolBar.Buttons(2).Enabled = False End If If 权限类别(3) = 0 Then M月盘点.Enabled = False tbToolBar.Buttons(4).Enabled = False End If If 权限类别(4) = 0 Then M供应商.Enabled = False 登记新供应商.MouseIcon = Picture1.MouseIcon End If If 权限类别(5) = 0 Then M往来客户.Enabled = False 登记新客户.MouseIcon = Picture1.MouseIcon End If If 权限类别(6) = 0 Then M单据查询.Enabled = False M库存查询.Enabled = False M货物出入统计.Enabled = False M职员操作统计.Enabled = False L货物出入统计.MouseIcon = Picture1.MouseIcon L职员操作统计.MouseIcon = Picture1.MouseIcon L单据查询.MouseIcon = Picture1.MouseIcon L库存查询.MouseIcon = Picture1.MouseIcon tbToolBar.Buttons(5).Enabled = False tbToolBar.Buttons(8).Enabled = False End If If 权限类别(7) = 0 Then M高级查询.Enabled = False 自定义查询.Enabled = False L高级查询.MouseIcon = Picture1.MouseIcon L自定义查询管理.MouseIcon = Picture1.MouseIcon tbToolBar.Buttons(7).Enabled = False End If If 权限类别(8) = 0 Then M打印入库单.Enabled = False M打印出库单.Enabled = False M打印借入单.Enabled = False M打印借出单.Enabled = False M打印调拔单.Enabled = False M打印报损单.Enabled = False M打印月盘点.Enabled = False tbToolBar.Buttons(10).Enabled = False End If If 权限类别(9) = 0 Then M公司信息.Enabled = False 修改公司信息.MouseIcon = Picture1.MouseIcon End If If 权限类别(10) = 0 Then M职员信息.Enabled = False 登记新职员.MouseIcon = Picture1.MouseIcon End If If 权限类别(11) = 0 Then M仓库信息.Enabled = False 创建新仓库.MouseIcon = Picture1.MouseIcon End If If 权限类别(12) = 0 Then M货物信息.Enabled = False 登记新货物.MouseIcon = Picture1.MouseIcon End If If 权限类别(13) = 0 Then M数据清除.Enabled = False M系统初始化.Enabled = False End If If 权限类别(14) = 0 Then M备份数据库.Enabled = False M还原数据库.Enabled = False M还原到昨天数据库.Enabled = False 备份数据库.MouseIcon = Picture1.MouseIcon 还原数据库.MouseIcon = Picture1.MouseIcon End If If 权限类别(15) = 0 Then M查看日志.Enabled = False 查看日志.MouseIcon = Picture1.MouseIcon tbToolBar.Buttons(12).Enabled = False End If If 权限类别(16) = 0 Then mnuUserManage.Enabled = False L用户管理.MouseIcon = Picture1.MouseIcon End If End Sub Public Function WriteLog(inf As String) On Error Resume Next Me.m_checkado.RecordSource = "select * from 系统日志" Me.m_checkado.Refresh If Me.m_checkado.Recordset.RecordCount > 0 Then Me.m_checkado.Recordset.MoveLast End If Me.m_checkado.Recordset.AddNew Me.m_checkado.Recordset.Fields("用户名").Value = UserName Me.m_checkado.Recordset.Fields("操作时间").Value = Date + Time Me.m_checkado.Recordset.Fields("操作内容").Value = inf Me.m_checkado.Recordset.update Me.m_checkado.Refresh End Function Public Sub 更新自定义查询菜单() On Error GoTo quit fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh Dim count As Integer count = fMainForm.m_checkado.Recordset.RecordCount If count >= 1 Then M自定义一.Visible = True M自定义一.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义一.Visible = False End If If count >= 2 Then M自定义二.Visible = True M自定义二.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义二.Visible = False End If If count >= 3 Then M自定义三.Visible = True M自定义三.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义三.Visible = False End If If count >= 4 Then M自定义四.Visible = True M自定义四.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义四.Visible = False End If If count >= 5 Then M自定义五.Visible = True M自定义五.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义五.Visible = False End If If count >= 6 Then M自定义六.Visible = True M自定义六.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义六.Visible = False End If If count >= 7 Then M自定义七.Visible = True M自定义七.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义七.Visible = False End If If count >= 8 Then M自定义八.Visible = True M自定义八.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value If fMainForm.m_checkado.Recordset.EOF = False Then fMainForm.m_checkado.Recordset.MoveNext Else M自定义八.Visible = False End If GoTo quit2 quit: M自定义一.Visible = False M自定义二.Visible = False M自定义三.Visible = False M自定义四.Visible = False M自定义五.Visible = False M自定义六.Visible = False M自定义七.Visible = False M自定义八.Visible = False quit2: End Sub ';还原数据库后初始化各类信息 Private Sub InitAfterResume() ';更改数据库中的用户信息 m_checkado.RecordSource = "select * from 用户管理 where 用户名=';" + UserName + "';" m_checkado.Refresh ';如果已存在记录则更新 If m_checkado.Recordset.RecordCount > 0 Then m_checkado.Recordset.Fields("用户密码").Value = UserPas m_checkado.Recordset.Fields("用户权限").Value = Purview m_checkado.Recordset.update m_checkado.Refresh Else ';新建用户记录 m_checkado.Recordset.AddNew m_checkado.Recordset.Fields("用户名").Value = UserName m_checkado.Recordset.Fields("用户密码").Value = UserPas m_checkado.Recordset.Fields("用户权限").Value = Purview m_checkado.Recordset.update m_checkado.Refresh End If ';更新当前操作用户 操作用户.caption = UserName ';初始化菜单 InitMenu 更新自定义查询菜单 End Sub Private Sub Form_Load() ';初始化m_checkado m_checkado.ConnectionString = DataConnectString m_checkado.Visible = False ';每天首次运行自动备份数据库 fMainForm.m_checkado.RecordSource = "select 操作时间 from 系统日志 order by 操作时间 desc" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveFirst Dim t As String t = fMainForm.m_checkado.Recordset.Fields("操作时间").Value ';如果今天从未有人登陆,备份数据库 If InStr(1, t, Str(Date)) <> 1 Then BackupData DataPath, App.Path + "\everyday.bkp" End If Else BackupData DataPath, App.Path + "\everyday.bkp" End If ';写入系统日志 fMainForm.WriteLog ("登陆系统") ';初始化各种权限类别 InitPurview ';初始化菜单 InitMenu 更新自定义查询菜单 ';加载图片 操作信息.Picture = LoadPicture(App.Path + "\data\ground1.jpg") 软件信息.Picture = LoadPicture(App.Path + "\data\ground2.jpg") ';加载flash ShockwaveFlash1.Movie = App.Path + "\data\logo.swf" ShockwaveFlash1.Menu = False ShockwaveFlash1.Loop = True ShockwaveFlash1.ScaleMode = 1 ';禁止flash右键弹出 Dim hwnd As Long hwnd = GetWindow(软件版权.hwnd, 5) AddWndMsg hwnd, 516, AddressOf FlashNoRButton ';初始化软件信息 当前日期.caption = LTrim(Str(Year(Date))) + "年" + LTrim(Str(Month(Date))) + "月" + LTrim(Str(Day(Date))) + "日" 操作用户.caption = UserName End Sub Private Sub Form_Resize() On Error Resume Next 操作信息.width = Me.width - 软件信息.width End Sub Private Sub Form_Unload(Cancel As Integer) ';写入系统日志 fMainForm.WriteLog ("退出系统") End Sub Private Sub L高级查询_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(7) <> 0 Then M高级查询_Click End Sub Private Sub L用户管理_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(16) <> 0 Then mnuUserManage_Click End Sub Private Sub mnuFileExit_Click() Unload Me End Sub Private Sub mnuModifyPassword_Click() PasModify.Show vbModal End Sub Private Sub mnuUserManage_Click() 用户管理.Show vbModal End Sub Private Sub mnuHelpAbout_Click() frmabout.Show vbModal, Me End Sub Private Sub mnuFilePageSetup_Click() On Error Resume Next With dlgCommonDialog .DialogTitle = "页面设置" .CancelError = True .ShowPrinter End With End Sub Private Sub mnuViewStatusBar_Click() sbStatusBar.Visible = True - sbStatusBar.Visible mnuViewStatusBar.Checked = sbStatusBar.Visible End Sub Private Sub mnuViewToolbar_Click() tbToolBar.Visible = True - tbToolBar.Visible mnuViewToolbar.Checked = tbToolBar.Visible End Sub Private Sub M报损单_Click() 报损单.Show vbModal End Sub Private Sub M备份数据库_Click() On Error GoTo failure With dlgCommonDialog .DialogTitle = "数据库备份为.." .ShowSave If Len(.filename) = 0 Then Exit Sub If BackupData(DataPath, .filename) = 1 Then MsgBox "备份成功!" ';写入系统日志 fMainForm.WriteLog ("备份数据") Else failure: MsgBox "备份失败!" End If End With End Sub Private Sub M查看日志_Click() 系统日志.Show vbModal End Sub Private Sub M打印报损单_Click() Dim f As New 报损单 f.打印报损单.left = f.B新增报损单.left f.打印报损单.Top = f.B新增报损单.Top f.B新增报损单.Visible = False f.删除报损单.Visible = False f.Show vbModal Unload f End Sub Private Sub M打印出库单_Click() Dim f As New 出库单 f.打印出库单.left = f.B新增出库单.left f.打印出库单.Top = f.B新增出库单.Top f.B新增出库单.Visible = False f.删除出库单.Visible = False f.退出出库单.Visible = False f.Show vbModal Unload f End Sub Private Sub M打印调拔单_Click() Dim f As New 调拔单 f.打印调拔单.left = f.B新增调拔单.left f.打印调拔单.Top = f.B新增调拔单.Top f.B新增调拔单.Visible = False f.删除调拔单.Visible = False f.Show vbModal Unload f End Sub Private Sub M打印借出单_Click() Dim f As New 借出单 f.打印借出单.left = f.B新增借出单.left f.打印借出单.Top = f.B新增借出单.Top f.B新增借出单.Visible = False f.删除借出单.Visible = False f.退出借出单.Visible = False f.Show vbModal Unload f End Sub Private Sub M打印借入单_Click() Dim f As New 借入单 f.打印借入单.left = f.B新增借入单.left f.打印借入单.Top = f.B新增借入单.Top f.B新增借入单.Visible = False f.删除借入单.Visible = False f.退出借入单.Visible = False f.Show vbModal Unload f End Sub Private Sub M打印入库单_Click() Dim f As New 入库单 f.打印入库单.left = f.B新增入库单.left f.打印入库单.Top = f.B新增入库单.Top f.B新增入库单.Visible = False f.删除入库单.Visible = False f.退出入库单.Visible = False f.Show vbModal Unload f End Sub Private Sub M打印月盘点_Click() 打印月盘点.Show vbModal End Sub Private Sub M管理查询_Click() 自定义查询管理.Show vbModal 更新自定义查询菜单 End Sub Private Sub M还原到昨天数据库_Click() On Error GoTo failure If MsgBox("还原数据库将导致现在数据库数据丢失,您确信要还原数据库吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub If ResumeData(DataPath, App.Path + "\everyday.bkp") = 1 Then ';初始化还原后的信息 InitAfterResume MsgBox "还原成功!" Else failure: MsgBox "还原失败!" End If End Sub Private Sub M还原数据库_Click() ';On Error GoTo failure With dlgCommonDialog .DialogTitle = "数据库还原于..." .ShowOpen If Len(.filename) = 0 Then Exit Sub If MsgBox("还原数据库将导致现在数据库数据丢失,您确信要还原数据库吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub If ResumeData(DataPath, .filename) = 1 Then ';初始化还原后的信息 InitAfterResume MsgBox "还原成功!" Else failure: MsgBox "还原失败!" End If End With End Sub Private Sub M仓库信息_Click() 仓库.Show vbModal End Sub Private Sub M查看帮助_Click() ShellExecute 0, "", App.Path + "\仓库管理系统.chm", "", "", 5 End Sub Private Sub M出库单_Click() 出库单.Show vbModal End Sub Private Sub M单据查询_Click() 单据查询.Show vbModal End Sub Private Sub M调拔单_Click() 调拔单.Show vbModal End Sub Private Sub M高级查询_Click() 高级查询.Show vbModal End Sub Private Sub M公司信息_Click() 公司信息.Show vbModal End Sub Private Sub M供应商_Click() 供应商.Show vbModal End Sub Private Sub M换用户登陆_Click() ';启动登陆对话框 Dim fLogin As New Frmlogin fLogin.HelpContextID = 2411 fLogin.Show vbModal If Not fLogin.OK Then ';登录失败，退出应用程序 Exit Sub End If Unload fLogin ';启动主窗口 Unload Me Set fMainForm = New frmmain fMainForm.Show End Sub Private Sub M货物出入统计_Click() 货物出入统计.Show vbModal End Sub Private Sub M货物信息_Click() 货物信息.Show vbModal End Sub Private Sub M借出单_Click() 借出单.Show vbModal End Sub Private Sub M借入单_Click() 借入单.Show vbModal End Sub Private Sub M库存查询_Click() 库存查询.Show vbModal End Sub Private Sub M库存状况_Click() 库存状况.Show vbModal End Sub Private Sub M入库单_Click() 入库单.Show vbModal End Sub Private Sub M数据清除_Click() 数据清除.Show vbModal End Sub Private Sub M往来客户_Click() 客户.Show vbModal End Sub Private Sub M系统初始化_Click() If MsgBox("这将删除您所有的数据信息,整个数据库将全部清空,您确信要系统初始化吗?", vbYesNo Or vbExclamation) = vbNo Then Exit Sub On Error Resume Next ';删除入库单 fMainForm.m_checkado.RecordSource = "select * from 入库单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除出库单 fMainForm.m_checkado.RecordSource = "select * from 出库单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除借入单 fMainForm.m_checkado.RecordSource = "select * from 借入单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除借出单 fMainForm.m_checkado.RecordSource = "select * from 借出单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除调拔单 fMainForm.m_checkado.RecordSource = "select * from 调拔单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除报损单 fMainForm.m_checkado.RecordSource = "select * from 报损单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除库存状况 fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除盘点单 fMainForm.m_checkado.RecordSource = "select * from 盘点单" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除客户 fMainForm.m_checkado.RecordSource = "select * from 客户" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除供应商 fMainForm.m_checkado.RecordSource = "select * from 供应商" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除货物信息 fMainForm.m_checkado.RecordSource = "select * from 货物信息" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除货物类别 fMainForm.m_checkado.RecordSource = "select * from 货物类别" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除仓库 fMainForm.m_checkado.RecordSource = "select * from 仓库" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除职员信息 fMainForm.m_checkado.RecordSource = "select * from 职员信息" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除公司信息 fMainForm.m_checkado.RecordSource = "select * from 公司信息" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除系统日志 fMainForm.m_checkado.RecordSource = "select * from 系统日志" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';删除用户管理 fMainForm.m_checkado.RecordSource = "select * from 用户管理" fMainForm.m_checkado.Refresh DeleteRecordData fMainForm.m_checkado.Recordset ';增加一个管理员admin fMainForm.m_checkado.RecordSource = "select * from 用户管理" fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("用户名") = "admin" fMainForm.m_checkado.Recordset.Fields("用户密码") = "" fMainForm.m_checkado.Recordset.Fields("用户权限") = 131071 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更改当前登陆用户信息 UserName = "admin": UserPas = "": Purview = 131071 Dim i As Integer For i = 0 To 16 权限类别(i) = 1 Next MsgBox "系统初始化成功!" End Sub Private Sub M新增报损单_Click() 新增报损单.Show vbModal End Sub Private Sub M新增出库单_Click() 新增出库单.Show vbModal End Sub Private Sub M新增调拔单_Click() 新增调拔单.Show vbModal End Sub Private Sub M新增借出单_Click() 新增借出单.Show vbModal End Sub Private Sub M新增借入单_Click() 新增借入单.Show vbModal End Sub Private Sub M新增入库单_Click() 新增入库单.Show vbModal End Sub Private Sub M月盘点_Click() 月盘点.Show vbModal End Sub Private Sub M职员操作统计_Click() 职员操作统计.Show vbModal End Sub Private Sub M职员信息_Click() 职员信息.Show vbModal End Sub Private Sub M自定义一_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 1 Then Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义二_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 2 Then Dim i As Integer For i = 1 To 1 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义三_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 3 Then Dim i As Integer For i = 1 To 2 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义四_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 4 Then Dim i As Integer For i = 1 To 3 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义五_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 5 Then Dim i As Integer For i = 1 To 4 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义六_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 6 Then Dim i As Integer For i = 1 To 5 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义七_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 7 Then Dim i As Integer For i = 1 To 6 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub M自定义八_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 自定义查询" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount >= 8 Then Dim i As Integer For i = 1 To 7 fMainForm.m_checkado.Recordset.MoveNext Next Dim f As New 查询 f.caption = fMainForm.m_checkado.Recordset.Fields("查询名称").Value f.Adodc1.RecordSource = fMainForm.m_checkado.Recordset.Fields("SQL语句").Value f.Show vbModal Unload f End If End Sub Private Sub Timer1_Timer() If Len(sbStatusBar.Panels(1).Text) < sbStatusBar.Panels(1).width / 80 Then sbStatusBar.Panels(1).Text = " " + sbStatusBar.Panels(1).Text Else sbStatusBar.Panels(1).Text = LTrim(sbStatusBar.Panels(1).Text) End If End Sub Private Sub 备份数据库_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(14) <> 0 Then M备份数据库_Click End Sub Private Sub 操作信息_Resize() Shape1.left = 0 Shape1.width = 操作信息.width Shape2.left = 0 Shape2.width = 操作信息.width End Sub Private Sub 查看库存状况_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub M库存状况_Click End Sub Private Sub 查看日志_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(15) <> 0 Then M查看日志_Click End Sub Private Sub 查询统计_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub End Sub Private Sub 创建新仓库_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(11) <> 0 Then M仓库信息_Click End Sub Private Sub L单据查询_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(6) <> 0 Then M单据查询_Click End Sub Private Sub 登记新供应商_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(4) <> 0 Then M供应商_Click End Sub Private Sub 登记新货物_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(12) <> 0 Then M货物信息_Click End Sub Private Sub 登记新客户_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(5) <> 0 Then M往来客户_Click End Sub Private Sub 登记新职员_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(10) <> 0 Then M职员信息_Click End Sub Private Sub 给作者写信_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub ShellExecute 0, "", "mailto:xgping@vip.163.com", "", "", 5 End Sub Private Sub 更换用户登陆_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub M换用户登陆_Click End Sub Private Sub L货物出入统计_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(6) <> 0 Then M货物出入统计_Click End Sub Private Sub L库存查询_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(6) <> 0 Then M库存查询_Click End Sub Private Sub 还原数据库_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(14) <> 0 Then M还原数据库_Click End Sub Private Sub 新增单据_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(0) = 0 Then Exit Sub Select Case index Case 0: M新增入库单_Click Case 1: M新增出库单_Click Case 2: M新增借入单_Click Case 3: M新增借出单_Click Case 4: M新增调拔单_Click Case 5: M新增报损单_Click End Select End Sub Private Sub 修改公司信息_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(9) <> 0 Then M公司信息_Click End Sub Private Sub 修改密码_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub mnuModifyPassword_Click End Sub Private Sub L职员操作统计_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(6) <> 0 Then M职员操作统计_Click End Sub Private Sub L自定义查询管理_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub If 权限类别(7) <> 0 Then M管理查询_Click End Sub

frmsplash

Private Sub Form_Load()
   
    Image1.Picture = LoadPicture(App.Path + "\data\logo.gif")
   
    Image1.left = 0
    Image1.Top = 0
    Image1.width = Me.width
    Image1.Height = Me.Height
    Image1.Stretch = True
   
End Sub
Private Sub Image1_Click()
End Sub
Private Sub m_Timer_Timer()
    Unload Me
End Sub

pasmodify Private Sub Cancel_Click() Unload Me End Sub Private Sub Modify_Click() If OldPas.Text <> UserPas Then MsgBox "原密码错误!" Exit Sub End If If NewPas1.Text <> NewPas2.Text Then MsgBox "两次密码不一致!" Exit Sub End If On Error Resume Next Dim fit As String ';查找用户名 fit = "用户名=';" fit = fit + UserName + "';" Frmlogin.Data2.Recordset.FindFirst fit ';找不到该用户 If Frmlogin.Data2.Recordset.NoMatch Then Exit Sub Else UserPas = NewPas1.Text ';设置新密码 Frmlogin.Data2.Recordset.Edit Frmlogin.Data2.Recordset.Fields("用户密码").Value = UserPas Frmlogin.Data2.Recordset.update MsgBox "修改成功!" End If Unload Me End Sub

报损单

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean
Option Explicit
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
   
End Sub

Private Sub initdatagrid1()
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1000
    DataGrid1.Columns(2).width = 1000
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 800
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
    DataGrid1.Columns(9).width = 800
    DataGrid1.Columns(10).width = 800
    DataGrid1.Columns(11).width = 800
    DataGrid1.Columns(12).width = 800
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
   
    DataGrid1.rowheight = 270
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("货物名称").Value
   
End Sub

Private Sub B新增报损单_Click()
    新增报损单.Show vbModal
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    If caption = "经办人" Then caption = "姓名"
    If caption = "金额" Then Exit Sub
    If caption = "备注" Then caption = "报损单.备注"
    If caption = "编号" Then caption = "报损单.编号"
    If caption = "存放仓库" Then caption = "仓库名称"
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
   
    initdatagrid1
   
    ';通过权限来初始化控件性质
    If 权限类别(0) = 0 Then B新增报损单.Enabled = False
    If 权限类别(1) = 0 Then DataGrid1.AllowUpdate = False
    If 权限类别(2) = 0 Then 删除报损单.Enabled = False
    If 权限类别(8) = 0 Then 打印报损单.Enabled = False
   
End Sub

Private Sub 打印报损单_Click()
    On Error GoTo quit
    Dim p As New 新增报损单
    p.编号 = DataGrid1.Columns(0).Value
    p.Show vbModal
   
    Unload p
   
quit:
   
End Sub
Private Sub 删除报损单_Click()
    On Error GoTo quit
    Dim code As Long
    code = DataGrid1.Columns(0).Text
    If MsgBox("您确信要删除该报损单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
    On Error Resume Next
    ';更新报损单
    fMainForm.m_checkado.RecordSource = "select * from 报损单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
    fMainForm.m_checkado.Recordset.Delete
    fMainForm.m_checkado.Refresh
        
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
    MsgBox "报损单删除成功!"
   
    ';写入系统日志
    fMainForm.WriteLog ("删除报损单")
quit:
   
End Sub

仓库

Private m_IsAdd As Boolean
Private m_canchange
Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean

Option Explicit
Private Sub initdatagrid1()
    DataGrid1.Columns(0).Locked = True ';编号
    DataGrid1.Columns(3).Locked = True ';保管员
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1200
    DataGrid1.Columns(2).width = 1200
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1600
   
    DataGrid1.rowheight = 270
End Sub
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("仓库名称").Value
   
End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
    If caption = "编号" Then caption = "仓库.编号"
    If caption = "备注" Then caption = "仓库.备注"
    If caption = "保管员" Then caption = "保管员编号"
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid1_SelChange(Cancel As Integer)
   m_canchange = True
      
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
   
    Adodc2.ConnectionString = DataConnectString
    Set DataCombo1.RowSource = Adodc2
    DataCombo1.ListField = "姓名"
    Adodc2.Refresh
    Adodc2.Visible = False
   
    initdatagrid1
   
    m_canchange = True
   
End Sub
Private Sub DataGrid1_OnAddNew()
    DataGrid1.Columns(0).Locked = False
    m_canchange = False
    m_IsAdd = True
  
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   
    If m_IsAdd = False Then
        DataGrid1.Columns(0).Locked = True
    Else
        m_IsAdd = False
    End If
   
End Sub

Private Sub 更换保管员_Click()
   
    If m_canchange = False Then Exit Sub
   
    On Error Resume Next
   
    If DataCombo1.Text = "" Then
        MsgBox "请选择新的保管员!"
    Else
         fMainForm.m_checkado.RecordSource = "select 编号 from 职员信息 where 姓名=';" + DataCombo1.Text + "';"
         fMainForm.m_checkado.Refresh
         Dim code As String
         ';更新的职员编号code
         code = fMainForm.m_checkado.Recordset.Fields("编号")
         
         fMainForm.m_checkado.RecordSource = "select 编号,保管员编号 from 仓库 where 编号=" + DataGrid1.Columns(0).Text
         fMainForm.m_checkado.Refresh
         fMainForm.m_checkado.Recordset.Fields("保管员编号") = code
         fMainForm.m_checkado.Recordset.update
         fMainForm.m_checkado.Refresh
        
         SaveInit
         Adodc1.Refresh
         ResumeInit
         
        ';写入系统日志
        fMainForm.WriteLog ("更换保管员")
    End If
   
End Sub
Private Sub 删除_Click()
   
    On Error GoTo quit
    ';判断是否其它表单用了待删除的仓库编号
    Dim code As String
    Dim rs As String
    code = DataGrid1.Columns(0).Text
   
    rs = "select 仓库.编号 from 仓库,入库单,出库单,借入单,借出单,调拔单,报损单,库存状况"
    rs = rs + " Where 入库单.仓库编号=": rs = rs + code
    rs = rs + " or 出库单.仓库编号=": rs = rs + code
    rs = rs + " or 借入单.仓库编号=": rs = rs + code
    rs = rs + " or 借出单.仓库编号=": rs = rs + code
    rs = rs + " or 库存状况.仓库编号=": rs = rs + code
    rs = rs + " or 报损单.仓库编号=": rs = rs + code
    rs = rs + " or 调拔单.原仓库编号=": rs = rs + code
    rs = rs + " or 调拔单.目标仓库编号=": rs = rs + code
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此仓库信息,不能删除!", vbExclamation
    Else
        rs = "select * from 仓库 where 仓库.编号="
        rs = rs + code
        
        fMainForm.m_checkado.RecordSource = rs
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Delete
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        
        ';写入系统日志
        fMainForm.WriteLog ("删除仓库")
        
    End If
   
quit:
End Sub
Private Sub 新增仓库_Click()
   
    If 仓库名称.Text = "" Then MsgBox "请填写仓库名称!": Exit Sub
    If 仓库地点.Text = "" Then MsgBox "请填写仓库地点!": Exit Sub
    If DataCombo1.Text = "" Then MsgBox "请选择保管员!": Exit Sub
   
    On Error GoTo quit
   
    fMainForm.m_checkado.RecordSource = "select 编号 from 职员信息 where 姓名=';" + DataCombo1.Text + "';"
    fMainForm.m_checkado.Refresh
    Dim code1, code2 As String
    ';更新的职员编号code
    code2 = fMainForm.m_checkado.Recordset.Fields("编号")
   
    fMainForm.m_checkado.RecordSource = "select * from 仓库"
    fMainForm.m_checkado.Refresh
   
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        fMainForm.m_checkado.Recordset.MoveLast
        code1 = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1
    Else
        code1 = 1
    End If
   
    fMainForm.m_checkado.Recordset.AddNew
    fMainForm.m_checkado.Recordset.Fields("编号").Value = code1
    fMainForm.m_checkado.Recordset.Fields("仓库名称").Value = 仓库名称.Text
    fMainForm.m_checkado.Recordset.Fields("仓库地点").Value = 仓库地点.Text
    fMainForm.m_checkado.Recordset.Fields("保管员编号").Value = code2
    fMainForm.m_checkado.Recordset.Fields("备注").Value = 备注.Text
    fMainForm.m_checkado.Recordset.update
    fMainForm.m_checkado.Refresh
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
    ';写入系统日志
    fMainForm.WriteLog ("新增仓库")
quit:
End Sub

查询 Option Explicit Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString Adodc1.Visible = False End Sub Private Sub Form_Resize() On Error Resume Next Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Dim d As Integer Dim inttype As Integer If DataGrid1.Columns.count <= 2 Then d = 600 Else d = 50 End If Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 DataGrid1.Columns(i).width = Len(DataGrid1.Columns(i).caption) * d inttype = Adodc1.Recordset.Fields(i).Type Select Case inttype Case dbBoolean DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbByte DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbInteger DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbLong DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 500 Case dbCurrency DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbSingle DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 600 Case dbDouble DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 700 Case dbDate DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 800 Case dbText DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 900 Case dbLongBinary DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbMemo DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case dbGUID DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 Case Else DataGrid1.Columns(i).width = DataGrid1.Columns(i).width + 1000 End Select Next End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "查询结果" End Sub

出库单

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean
Option Explicit
Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
    DataGrid1.Columns(11).Locked = True
    DataGrid1.Columns(12).Locked = True
   
End Sub

Private Sub initdatagrid1()
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 1000
    DataGrid1.Columns(2).width = 1000
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(4).width = 1000
    DataGrid1.Columns(5).width = 1000
    DataGrid1.Columns(6).width = 800
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
    DataGrid1.Columns(9).width = 800
    DataGrid1.Columns(10).width = 800
    DataGrid1.Columns(11).width = 800
    DataGrid1.Columns(12).width = 800
    DataGrid1.Columns(13).width = 800
    DataGrid1.Columns(14).width = 800
   
    DataGrid1.Columns(0).Locked = True
    DataGrid1.Columns(1).Locked = True
    DataGrid1.Columns(2).Locked = True
    DataGrid1.Columns(3).Locked = True
    DataGrid1.Columns(4).Locked = True
    DataGrid1.Columns(6).Locked = True
    DataGrid1.Columns(7).Locked = True
    DataGrid1.Columns(8).Locked = True
    DataGrid1.Columns(9).Locked = True
    DataGrid1.Columns(10).Locked = True
    DataGrid1.Columns(11).Locked = True
    DataGrid1.Columns(12).Locked = True
   
    DataGrid1.rowheight = 270
End Sub
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
   
    On Error Resume Next
    Adodc1.caption = Adodc1.Recordset.Fields("货物名称").Value
   
End Sub

Private Sub B新增出库单_Click()
    新增出库单.Show vbModal
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    If caption = "经办人" Then caption = "姓名"
    If caption = "金额" Then Exit Sub
    If caption = "备注" Then caption = "出库单.备注"
    If caption = "编号" Then caption = "出库单.编号"
    If caption = "客户" Then caption = "客户名称"
    If caption = "存放仓库" Then caption = "仓库名称"
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
   
    initdatagrid1
   
     ';通过权限来初始化控件性质
    If 权限类别(0) = 0 Then B新增出库单.Enabled = False
    If 权限类别(1) = 0 Then DataGrid1.AllowUpdate = False
    If 权限类别(2) = 0 Then
        退出出库单.Enabled = False
        删除出库单.Enabled = False
    End If
    If 权限类别(8) = 0 Then 打印出库单.Enabled = False
   
End Sub

Private Sub 打印出库单_Click()
    On Error GoTo quit
    Dim p As New 新增出库单
    p.编号 = DataGrid1.Columns(0).Value
    p.Show vbModal
   
    Unload p
   
quit:
   
End Sub
Private Sub 删除出库单_Click()
    On Error GoTo quit
    If DataGrid1.Columns(12).Text = "已退出" Then GoTo con
    If MsgBox("建议用[退出出库单],而不要直接删除,以免数据丢失.您确信要删除该出库单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
con:
   
    On Error Resume Next
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
   
    fMainForm.m_checkado.RecordSource = "select 货物编号,出库数量,仓库编号 from 出库单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("出库数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    ';如果是已退出出库单则直接删除
    If DataGrid1.Columns(12).Text = "已退出" Then
        If MsgBox("您确信要删除该出库退出单吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
   
        fMainForm.m_checkado.RecordSource = "select * from 出库单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Delete
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        Exit Sub
    End If
   
    fMainForm.m_checkado.RecordSource = "select (货物信息.最高限量-库存数量) as 剩余量 from 库存状况,货物信息 where 货物信息.编号=库存状况.货物编号 and 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("剩余量").Value
    ';库存不足
    If num2 < num1 Then
        If MsgBox("库存超额,库存最大剩余限量为" + Str(num2) + ",入库量为" + Str(num1) + "," + "要忽略它并强制删除吗?", vbQuestion Or vbYesNo) = vbNo Then Exit Sub
    End If
   
    ';更新库存状况
    fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    ';如果已有记录则更新
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
         If num2 - num1 > 0 Then ';剩余限量够
              fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num1
              fMainForm.m_checkado.Recordset.update
         Else
              fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num2
              fMainForm.m_checkado.Recordset.update
         End If
    Else ';没有记录开始创建
         fMainForm.m_checkado.RecordSource = "select * from 库存状况"
         fMainForm.m_checkado.Refresh
            
         ';移到记录最后
         Dim ncode As Long
         If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
              fMainForm.m_checkado.Recordset.MoveLast
              ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1
         Else
              ncode = 1
         End If
            
         fMainForm.m_checkado.Recordset.AddNew
            
         fMainForm.m_checkado.Recordset.Fields("编号") = ncode
         fMainForm.m_checkado.Recordset.Fields("货物编号") = code1
         fMainForm.m_checkado.Recordset.Fields("仓库编号") = code2
         If num2 > num1 Then
             fMainForm.m_checkado.Recordset.Fields("库存数量") = num1
         Else
             fMainForm.m_checkado.Recordset.Fields("库存数量") = num2
         End If
            
         fMainForm.m_checkado.Recordset.update
    End If
    fMainForm.m_checkado.Refresh
        
    ';更新出库单
    fMainForm.m_checkado.RecordSource = "select * from 出库单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
    fMainForm.m_checkado.Recordset.Delete
    fMainForm.m_checkado.Refresh
        
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
    MsgBox "出库单删除成功!"
   
    ';写入系统日志
    fMainForm.WriteLog ("删除出库单")
quit:
   
End Sub
Private Sub 退出出库单_Click()
    On Error GoTo quit
    Dim code, code1, code2 As Long
    code = DataGrid1.Columns(0).Text
    If DataGrid1.Columns(12).Text = "已退出" Then
        MsgBox "该出库单已退出!"
        Exit Sub
    End If
   
    On Error Resume Next
   
    fMainForm.m_checkado.RecordSource = "select 货物编号,出库数量,仓库编号 from 出库单 where 编号=" + Str(code)
    fMainForm.m_checkado.Refresh
   
    Dim num1, num2 As Long
    code1 = fMainForm.m_checkado.Recordset.Fields("货物编号").Value
    num1 = fMainForm.m_checkado.Recordset.Fields("出库数量").Value
    code2 = fMainForm.m_checkado.Recordset.Fields("仓库编号").Value
   
    fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + Str(code1)
    fMainForm.m_checkado.Refresh
    num2 = fMainForm.m_checkado.Recordset.Fields("最高限量").Value
   
    fMainForm.m_checkado.RecordSource = "select 库存数量 from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
    fMainForm.m_checkado.Refresh
   
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        num2 = num2 - fMainForm.m_checkado.Recordset.Fields("库存数量").Value
    End If
   
    ';当前库存数量num2
    num2 = fMainForm.m_checkado.Recordset.Fields("剩余量").Value
    ';库存不足
    If num2 < num1 Then
        MsgBox "库存超额,库存最大剩余限量为" + Str(num2) + ",入库量为" + Str(num1) + "."
        Exit Sub
    Else
   
    ';更新库存状况
        fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + Str(code1) + " and 仓库编号=" + Str(code2)
        fMainForm.m_checkado.Refresh
   
        ';如果已有记录则更新
        If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
            If num2 - num1 > 0 Then ';剩余限量够
                fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num1
                fMainForm.m_checkado.Recordset.update
            Else
                fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + num2
                fMainForm.m_checkado.Recordset.update
            End If
        Else ';没有记录开始创建
            fMainForm.m_checkado.RecordSource = "select * from 库存状况"
            fMainForm.m_checkado.Refresh
            
            ';移到记录最后
            Dim ncode As Long
            If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
                fMainForm.m_checkado.Recordset.MoveLast
                ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1
            Else
                ncode = 1
            End If
            
            fMainForm.m_checkado.Recordset.AddNew
            
            fMainForm.m_checkado.Recordset.Fields("编号") = ncode
            fMainForm.m_checkado.Recordset.Fields("货物编号") = code1
            fMainForm.m_checkado.Recordset.Fields("仓库编号") = code2
            If num2 > num1 Then
                fMainForm.m_checkado.Recordset.Fields("库存数量") = num1
            Else
                fMainForm.m_checkado.Recordset.Fields("库存数量") = num2
            End If
            
            fMainForm.m_checkado.Recordset.update
        End If
        fMainForm.m_checkado.Refresh
        
        
    ';更新出库单
        fMainForm.m_checkado.RecordSource = "select * from 出库单 where 编号=" + Str(code)
        fMainForm.m_checkado.Refresh
        fMainForm.m_checkado.Recordset.Fields("定单状况") = "已退出"
        fMainForm.m_checkado.Recordset.update
        fMainForm.m_checkado.Refresh
        
        SaveInit
        Adodc1.Refresh
        ResumeInit
        
        MsgBox "出库单退出成功!"
        
        ';写入系统日志
        fMainForm.WriteLog ("退出出库单")
    End If
   
quit:
   
End Sub

打印月盘点

Private SQL As String
Option Explicit
Private Sub initdatagrid1()
   
    DataGrid1.Columns(1).Visible = False
    DataGrid1.Columns(4).Visible = False
   
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(2).width = 1300
    DataGrid1.Columns(3).width = 1000
    DataGrid1.Columns(5).width = 1100
   
End Sub
Private Sub DataCombo1_Change()
   
    Adodc1.RecordSource = SQL + " and 仓库.仓库名称=';" + DataCombo1.Text + "';"
    Adodc1.Refresh
    initdatagrid1
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
    Adodc1.Visible = False
   
    Adodc2.ConnectionString = DataConnectString
    Set DataCombo1.RowSource = Adodc2
    DataCombo1.ListField = "仓库名称"
    Adodc2.Refresh
    Adodc2.Visible = False
    initdatagrid1
End Sub
Private Sub 打印_Click()
   
    Dim f As New 月盘点
    f.编号 = DataGrid1.Columns("编号").Value
    f.Show vbModal
    Unload f
   
     ';写入系统日志
    fMainForm.WriteLog ("打印盘点单")
   
End Sub

单据查询 Option Explicit Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString Adodc1.Visible = False 制单时间.Year = Year(Date) 制单时间.Month = Month(Date) 制单时间.Day = Day(Date) T制单时间.Text = "无限制" T货物数量.Text = "无限制" T其它金额.Text = "无限制" End Sub Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single) End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "单据查询" End Sub Private Sub 货物名称_DblClick() On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物名称,货物类别,货物规格 from 货物信息" sel.title = "请选择货物名称" sel.Show vbModal If sel.result2 <> "" Then 货物名称.Text = sel.result2 Unload sel End Sub Private Sub 经办人_DblClick() On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 执行查询_Click() If 单据名称.Text = "" Then MsgBox "请选择单据名称!": Exit Sub Dim SQL As String Dim 前缀 As String Dim t As String SQL = "" On Error GoTo quit t = Str(制单时间.Year) + "-" + Str(制单时间.Month) + "-" + Str(制单时间.Day) If 单据名称.Text = "入库单" Then SQL = "select 入库单.编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,职员信息.姓名 as 经办人,入库单.入库时间,入库单.入库单价,货物信息.计量单位,入库单.入库数量,(入库单.入库单价*入库单.入库数量) as 金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,入库单.定单状况,入库单.其它金额,入库单.备注 from 入库单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=入库单.货物编号 and 职员信息.编号=入库单.经办人编号 and 供应商.编号=入库单.供应商编号 and 仓库.编号=入库单.仓库编号" 前缀 = "入库" ElseIf 单据名称.Text = "出库单" Then SQL = "select 出库单.编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,职员信息.姓名 as 经办人,出库单.出库时间,出库单.出库单价,货物信息.计量单位,出库单.出库数量,(出库单.出库单价*出库单.出库数量) as 金额,客户.客户名称 as 客户,仓库.仓库名称 as 存放仓库,出库单.定单状况,出库单.其它金额,出库单.备注 from 出库单,货物信息,职员信息,客户,仓库 where 货物信息.编号=出库单.货物编号 and 职员信息.编号=出库单.经办人编号 and 客户.编号=出库单.经办人编号 and 仓库.编号=出库单.仓库编号" 前缀 = "出库" ElseIf 单据名称.Text = "借入单" Then SQL = "select 借入单.编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,职员信息.姓名 as 经办人,借入单.借入时间,货物信息.计量单位,借入单.借入数量,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,借入单.定单状况,借入单.其它金额,借入单.备注 from 借入单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=借入单.货物编号 and 职员信息.编号=借入单.经办人编号 and 供应商.编号=借入单.供应商编号 and 仓库.编号=借入单.仓库编号" 前缀 = "借入" ElseIf 单据名称.Text = "借出单" Then SQL = "select 借出单.编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,职员信息.姓名 as 经办人,借出单.借出时间,货物信息.计量单位,借出单.借出数量,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,借出单.定单状况,借出单.其它金额,借出单.备注 from 借出单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=借出单.货物编号 and 职员信息.编号=借出单.经办人编号 and 供应商.编号=借出单.经办人编号 and 仓库.编号=借出单.仓库编号" 前缀 = "借出" ElseIf 单据名称.Text = "调拔单" Then SQL = "select 调拔单.编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,职员信息.姓名 as 经办人,调拔单.调拔时间,货物信息.计量单位,调拔单.调拔数量,仓库.仓库名称 as 原存放仓库,(select 仓库名称 from 仓库 where 编号=调拔单.目标仓库编号) as 目标仓库,调拔单.其它金额,调拔单.备注 from 调拔单,货物信息,职员信息,仓库 where 货物信息.编号=调拔单.货物编号 and 职员信息.编号=调拔单.经办人编号 and 仓库.编号=调拔单.原仓库编号" 前缀 = "调拔" ElseIf 单据名称.Text = "报损单" Then SQL = "select 报损单.编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,职员信息.姓名 as 经办人,报损单.报损时间,报损单.报损单价,货物信息.计量单位,报损单.报损数量,(报损单.报损单价*报损单.报损数量) as 金额,仓库.仓库名称 as 存放仓库,报损单.其它金额,报损单.备注 from 报损单,货物信息,职员信息,仓库 where 货物信息.编号=报损单.货物编号 and 职员信息.编号=报损单.经办人编号 and 仓库.编号=报损单.仓库编号" 前缀 = "报损" End If If SQL <> "" Then If T制单时间.Text <> "无限制" Then SQL = SQL + " and " + 前缀 + "时间" + T制单时间.Text + "#" + t + "#" End If If 经办人.Text <> "" Then SQL = SQL + " and 职员信息.姓名 like " + "';%" + 经办人.Text + "%';" End If If 货物名称.Text <> "" Then SQL = SQL + " and 货物信息.货物名称 like " + "';%" + 货物名称.Text + "%';" End If If T货物数量.Text <> "无限制" And 货物数量.Text <> "" Then SQL = SQL + " and " + 前缀 + "单." + 前缀 + "数量" + T货物数量.Text + 货物数量.Text End If If T其它金额.Text <> "无限制" And 其它金额.Text <> "" Then SQL = SQL + " and 其它金额" + T其它金额.Text + 其它金额.Text End If If 单据备注.Text <> "" Then SQL = SQL + " and " + 前缀 + "单.备注 like " + "';%" + 单据备注.Text + "%';" End If Adodc1.RecordSource = SQL Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 DataGrid1.Columns(i).width = Len(DataGrid1.Columns(i).caption) * 200 Next End If quit: End Sub