黑色海岸线论坛 - Powered by Discuz! Board

标题: [公告]技术区5.1比赛作品发表专帖 [打印本页]

作者: x86 时间: 2005-5-11 19:06 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: wxf 时间: 2005-5-11 19:24 标题: [公告]技术区5.1比赛作品发表专帖

作者: 漫天樱舞 时间: 2005-5-13 18:24 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:19 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:20 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:22 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:23 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:25 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:26 标题: [公告]技术区5.1比赛作品发表专帖

报损单

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

作者: 漫天樱舞 时间: 2005-5-15 21:26 标题: [公告]技术区5.1比赛作品发表专帖

仓库

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

作者: 漫天樱舞 时间: 2005-5-15 21:28 标题: [公告]技术区5.1比赛作品发表专帖

查询 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

作者: 漫天樱舞 时间: 2005-5-15 21:29 标题: [公告]技术区5.1比赛作品发表专帖

出库单

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

作者: 漫天樱舞 时间: 2005-5-15 21:30 标题: [公告]技术区5.1比赛作品发表专帖

打印月盘点

作者: 漫天樱舞 时间: 2005-5-15 21:32 标题: [公告]技术区5.1比赛作品发表专帖

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

作者: 漫天樱舞 时间: 2005-5-15 21:33 标题: [公告]技术区5.1比赛作品发表专帖

单据查询 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

作者: 漫天樱舞 时间: 2005-5-15 21:33 标题: [公告]技术区5.1比赛作品发表专帖

调拔单

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

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 = 1000
DataGrid1.Columns(9).width = 800
DataGrid1.Columns(10).width = 800
DataGrid1.Columns(11).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.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
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

作者: 漫天樱舞 时间: 2005-5-15 21:34 标题: [公告]技术区5.1比赛作品发表专帖

高级查询 Option Explicit Private pretext As String ';上一次sql语句 Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString Adodc1.Visible = False SQL.Text = "select * from " 表单.Text = "货物信息" SQL.SelStart = Len(SQL.Text) End Sub Private Sub Form_Resize() DataGrid1.width = Me.width - 440 DataGrid1.Height = Me.Height - Picture1.Height - 600 End Sub Private Sub 表单_GotFocus() 字段.Clear End Sub Private Sub 撤消字符_Click() SQL.Text = pretext End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "高级查询" End Sub Private Sub 添加表单字符_Click() pretext = SQL.Text SQL.Text = left$(SQL.Text, SQL.SelStart) + 表单.Text + Right$(SQL.Text, Len(SQL.Text) - SQL.SelStart) End Sub Private Sub 添加到自定义查询_Click() Dim f As New 自定义查询管理 f.SQL.Text = SQL.Text f.Show vbModal Unload f fMainForm.更新自定义查询菜单 End Sub Private Sub 添加字段字符_Click() pretext = SQL.Text SQL.Text = left$(SQL.Text, SQL.SelStart) + 字段.Text + Right$(SQL.Text, Len(SQL.Text) - SQL.SelStart) End Sub Private Sub 执行查询_Click() Dim s As String s = SQL.Text s = LCase(s) If s = "" Then MsgBox "请填写SQL语句!": Exit Sub If InStr(1, s, "update") <> 0 _ Or InStr(1, s, "delete") <> 0 _ Or InStr(1, s, "create") <> 0 _ Or InStr(1, s, "alter") <> 0 _ Or InStr(1, s, "drop") <> 0 _ Then MsgBox "SQL语句包含不安全的语句!": Exit Sub On Error Resume Next Adodc1.RecordSource = SQL.Text 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) * 250 Next End Sub Private Sub 字段_GotFocus() If 表单.Text = "货物信息" Then 字段.AddItem "编号" 字段.AddItem "货物名称" 字段.AddItem "货物类别" 字段.AddItem "货物规格" 字段.AddItem "入库单价" 字段.AddItem "出库单价" 字段.AddItem "计量单位" 字段.AddItem "最低限量" 字段.AddItem "最高限量" 字段.AddItem "备注" ElseIf 表单.Text = "货物类别" Then 字段.AddItem "类别名称" 字段.AddItem "增值税" ElseIf 表单.Text = "职员信息" Then 字段.AddItem "编号" 字段.AddItem "姓名" 字段.AddItem "性别" 字段.AddItem "头衔" 字段.AddItem "电话号码" 字段.AddItem "手机" 字段.AddItem "通迅地址" 字段.AddItem "邮政编码" 字段.AddItem "备注" ElseIf 表单.Text = "公司信息" Then 字段.AddItem "编号" 字段.AddItem "公司名称" 字段.AddItem "地址" 字段.AddItem "城市" 字段.AddItem "省份" 字段.AddItem "邮政编码" 字段.AddItem "国家" 字段.AddItem "电话号码" 字段.AddItem "电子邮件" 字段.AddItem "传真号码" 字段.AddItem "开户银行" 字段.AddItem "银行帐号" 字段.AddItem "业务描述" ElseIf 表单.Text = "供应商" Then 字段.AddItem "编号" 字段.AddItem "供应商名称" 字段.AddItem "联系人姓名" 字段.AddItem "联系人职称" 字段.AddItem "地址" 字段.AddItem "城市" 字段.AddItem "邮政编码" 字段.AddItem "省份" 字段.AddItem "国家" 字段.AddItem "电话号码" 字段.AddItem "传真号码" 字段.AddItem "电子邮件" 字段.AddItem "开户银行" 字段.AddItem "银行帐号" 字段.AddItem "业务描述" ElseIf 表单.Text = "客户" Then 字段.AddItem "编号" 字段.AddItem "客户名称" 字段.AddItem "联系人" 字段.AddItem "电话号码" 字段.AddItem "手机" 字段.AddItem "传真号码" 字段.AddItem "通迅地址" 字段.AddItem "邮政编码" 字段.AddItem "开户银行" 字段.AddItem "银行帐号" 字段.AddItem "备注" ElseIf 表单.Text = "库存状况" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "库存数量" 字段.AddItem "仓库编号" ElseIf 表单.Text = "仓库" Then 字段.AddItem "编号" 字段.AddItem "仓库名称" 字段.AddItem "仓库地点" 字段.AddItem "保管员编号" 字段.AddItem "备注" ElseIf 表单.Text = "入库单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "入库时间" 字段.AddItem "入库单价" 字段.AddItem "计量单位" 字段.AddItem "入库数量" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "出库单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "出库时间" 字段.AddItem "出库单价" 字段.AddItem "出库数量" 字段.AddItem "金额" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "借入单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "借入时间" 字段.AddItem "借入单价" 字段.AddItem "借入数量" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "借出单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "借出时间" 字段.AddItem "借出单价" 字段.AddItem "借出数量" 字段.AddItem "供应商编号" 字段.AddItem "仓库编号" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "调拔单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "调拔时间" 字段.AddItem "调拔单价" 字段.AddItem "调拔数量" 字段.AddItem "原仓库编号" 字段.AddItem "目标仓库编号" 字段.AddItem "备注" ElseIf 表单.Text = "报损单" Then 字段.AddItem "编号" 字段.AddItem "货物编号" 字段.AddItem "经办人编号" 字段.AddItem "入库时间" 字段.AddItem "报损数量" 字段.AddItem "定单状况" 字段.AddItem "备注" ElseIf 表单.Text = "盘点单" Then 字段.AddItem "编号" 字段.AddItem "仓库编号" 字段.AddItem "经办人编号" 字段.AddItem "盘点时间" ElseIf 表单.Text = "用户管理" Then 字段.AddItem "编号" 字段.AddItem "用户名" 字段.AddItem "用户密码" 字段.AddItem "用户权限" ElseIf 表单.Text = "系统日志" Then 字段.AddItem "编号" 字段.AddItem "用户名" 字段.AddItem "操作时间" 字段.AddItem "操作内容" End If End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:36 标题: [公告]技术区5.1比赛作品发表专帖

公司信息

Option Explicit
Private Sub Form_Load()
Adodc1.ConnectionString = DataConnectString

Set 公司名称.DataSource = Adodc1
Set 地址.DataSource = Adodc1
Set 城市.DataSource = Adodc1
Set 省份.DataSource = Adodc1
Set 国家.DataSource = Adodc1
Set 邮政编码.DataSource = Adodc1
Set 电话号码.DataSource = Adodc1
Set 电子邮件.DataSource = Adodc1
Set 传真号码.DataSource = Adodc1
Set 开户银行.DataSource = Adodc1
Set 银行帐号.DataSource = Adodc1
Set 业务描述.DataSource = Adodc1

Adodc1.Refresh
Adodc1.Visible = False

End Sub
Private Sub Form_Unload(Cancel As Integer)
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.update

';写入系统日志
fMainForm.WriteLog ("查看或修改了公司信息")
End Sub
Private Sub 业务描述_Change()
End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:36 标题: [公告]技术区5.1比赛作品发表专帖

供应商
Private m_IsAdd As Boolean
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(0).width = 500
DataGrid1.Columns(1).width = 1300
DataGrid1.Columns(2).width = 1000
DataGrid1.Columns(3).width = 1000
DataGrid1.Columns(4).width = 1000
DataGrid1.Columns(5).width = 1000
DataGrid1.Columns(6).width = 1000
DataGrid1.Columns(7).width = 1000
DataGrid1.Columns(8).width = 1000
DataGrid1.Columns(9).width = 1000
DataGrid1.Columns(10).width = 1000
DataGrid1.Columns(11).width = 1000
DataGrid1.Columns(12).width = 1000
DataGrid1.Columns(13).width = 1000
DataGrid1.Columns(14).width = 1000

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 DataGrid1_AfterDelete()
';写入系统日志
fMainForm.WriteLog ("删除供应商")
End Sub
Private Sub DataGrid1_AfterUpdate()
';写入系统日志
fMainForm.WriteLog ("更新供应商")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)

';判断是否其它表单用了待删除的职员编号
Dim code As String
Dim rs As String
code = DataGrid1.Columns(0).Text

rs = ""
rs = rs + "select 经办人编号 from 入库单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 借入单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 借出单 where 经办人编号=" + Str(code)
fMainForm.m_checkado.RecordSource = rs
fMainForm.m_checkado.Refresh
If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
      MsgBox "其它表单用了此供应商信息,不能删除!", vbExclamation
      Cancel = True
End If

End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)

On Error Resume Next
Dim caption As String
caption = DataGrid1.Columns(ColIndex).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
Adodc1.Visible = False

initdatagrid1

End Sub
Private Sub DataGrid1_OnAddNew()
DataGrid1.Columns(0).Locked = 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

作者: 漫天樱舞 时间: 2005-5-15 21:37 标题: [公告]技术区5.1比赛作品发表专帖

货物出入统计

Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(8) As Long
Private order(8) As Boolean
Option Explicit
Private Sub initdatagrid1()
DataGrid1.Columns(0).width = 500
DataGrid1.Columns(1).width = 1600
DataGrid1.Columns(2).width = 800
DataGrid1.Columns(3).width = 800
DataGrid1.Columns(4).width = 800
DataGrid1.Columns(5).width = 800
DataGrid1.Columns(6).width = 800
DataGrid1.Columns(7).width = 800
DataGrid1.Columns(8).width = 800

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 DataGrid1_HeadClick(ByVal ColIndex As Integer)
If ColIndex > 1 Then Exit Sub
On Error Resume Next
Dim caption As String
caption = DataGrid1.Columns(ColIndex).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
Adodc1.Visible = False

Adodc2.ConnectionString = DataConnectString
Set DataCombo1.RowSource = Adodc2
DataCombo1.ListField = "仓库名称"
Adodc2.Refresh
Adodc2.Visible = False

T出入时间.Text = "无限制"

进行统计_Click

End Sub

Private Sub Form_Unload(Cancel As Integer)
SQL = ""
End Sub

Private Sub 打印_Click(Index As Integer)
End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:38 标题: [公告]技术区5.1比赛作品发表专帖

货物信息

Private m_IsAdd1 As Boolean
Private m_IsAdd2 As Boolean
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 InitDataGrid2()
DataGrid2.Columns(0).Locked = True ';编号
DataGrid2.Columns(2).Locked = True ';类别编号
DataGrid2.Columns(0).width = 500
DataGrid2.Columns(1).width = 1500
DataGrid2.Columns(2).width = 800
DataGrid2.Columns(3).width = 1200
DataGrid2.Columns(4).width = 800
DataGrid2.Columns(5).width = 800
DataGrid2.Columns(6).width = 800
DataGrid2.Columns(7).width = 1200

If Adodc2.Recordset.RecordCount > 0 Then
      Adodc2.Recordset.MoveLast
      货物编号.Text = Adodc2.Recordset.Fields("编号").Value + 1
      Adodc2.Recordset.MoveFirst
Else
      货物编号.Text = 1
End If

End Sub
Private Sub SaveInit()

startcol = DataGrid2.SelStartCol
endcol = DataGrid2.SelEndCol
col = DataGrid2.LeftCol
row = DataGrid2.row

rowheight = DataGrid2.rowheight

Dim i As Integer
For i = 0 To DataGrid2.Columns.count - 1
      colwidth(i) = DataGrid2.Columns(i).width
Next

End Sub
Private Sub ResumeInit()

DataGrid2.SelStartCol = startcol
DataGrid2.SelEndCol = endcol
DataGrid2.Scroll col, row

DataGrid2.rowheight = rowheight

Dim i As Integer
For i = 0 To DataGrid2.Columns.count - 1
      DataGrid2.Columns(i).width = colwidth(i)
Next

End Sub
Private Sub initdatagrid1()
DataGrid1.Columns(0).Locked = True

DataGrid1.Columns(0).width = 1200
DataGrid1.Columns(1).width = 1000

DataGrid1.AllowRowSizing = False
DataGrid1.Columns(0).AllowSizing = False
DataGrid1.Columns(1).AllowSizing = False

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 Adodc2_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

On Error Resume Next
Adodc2.caption = Adodc2.Recordset.Fields("货物名称").Value

End Sub
Private Sub DataGrid1_AfterDelete()
  ';写入系统日志
fMainForm.WriteLog ("删除货物类别")
End Sub
Private Sub DataGrid1_AfterInsert()
';写入系统日志
fMainForm.WriteLog ("增加货物类别")
End Sub
Private Sub DataGrid1_AfterUpdate()
';写入系统日志
fMainForm.WriteLog ("更新货物类别")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)

On Error Resume Next

';判断是否其它表单用了待删除的货物类别
Dim name As String
Dim rs As String
name = DataGrid1.Columns(0).Text

rs = "select 货物信息.编号 from 货物信息,货物类别"
rs = rs + " Where 货物信息.货物类别=';": rs = rs + name: rs = rs + "';"

fMainForm.m_checkado.RecordSource = rs
fMainForm.m_checkado.Refresh
If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
      MsgBox "其它表单用了此货物类别信息,不能删除!", vbExclamation
      Cancel = True
End If

End Sub
Private Sub DataGrid1_OnAddNew()
DataGrid1.Columns(0).Locked = False
m_IsAdd1 = True

End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)

If m_IsAdd1 = False Then
      DataGrid1.Columns(0).Locked = True
Else
      m_IsAdd1 = False
End If

End Sub
Private Sub DataGrid2_AfterColUpdate(ByVal ColIndex As Integer)
If ColIndex = 0 Then DataGrid2.Columns(2).Value = 货物类别.Text

End Sub

Private Sub DataGrid2_AfterDelete()
   ';写入系统日志
fMainForm.WriteLog ("删除货物")
End Sub
Private Sub DataGrid2_AfterUpdate()
  ';写入系统日志
fMainForm.WriteLog ("更新货物")
End Sub
Private Sub DataGrid2_BeforeDelete(Cancel As Integer)
   On Error Resume Next
';判断是否其它表单用了待删除的货物编号
Dim code As String
Dim rs As String
code = DataGrid2.Columns(0).Text

rs = ""
rs = rs + "select 货物编号 from 入库单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 出库单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 借入单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 借出单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 调拔单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 报损单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 库存状况 where 货物编号=" + Str(code)

fMainForm.m_checkado.RecordSource = rs
fMainForm.m_checkado.Refresh
If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
      MsgBox "其它表单用了此货物信息,不能删除!", vbExclamation
      Cancel = True
End If

End Sub
Private Sub DataGrid2_HeadClick(ByVal ColIndex As Integer)

On Error Resume Next
Dim caption As String
caption = DataGrid2.Columns(ColIndex).caption

If caption = "存放仓库" Then caption = "仓库名称"

Adodc2.RecordSource = SQL + " order by " + caption

order(ColIndex) = True - order(ColIndex)

If order(ColIndex) = True Then
      Adodc2.RecordSource = Adodc2.RecordSource + " ASC"
Else
      Adodc2.RecordSource = Adodc2.RecordSource + " DESC"
End If

SaveInit
Adodc2.Refresh
ResumeInit

End Sub
Private Sub DataGrid2_OnAddNew()
DataGrid2.Columns(0).Locked = False
m_IsAdd2 = True

End Sub

Private Sub DataGrid2_RowColChange(LastRow As Variant, ByVal LastCol As Integer)

If m_IsAdd2 = False Then
      DataGrid2.Columns(0).Locked = True
Else
      m_IsAdd2 = False
End If

End Sub
Private Sub Form_Load()
';初始化货物类别
Adodc1.ConnectionString = DataConnectString
Set DataGrid1.DataSource = Adodc1
Adodc1.Refresh
';Adodc1.Visible = False
initdatagrid1

';初始化货物信息
Adodc2.ConnectionString = DataConnectString
SQL = Adodc2.RecordSource
Set DataGrid2.DataSource = Adodc2
Adodc2.Refresh
';Adodc2.Visible = False
';设置DataGrid2属性
InitDataGrid2
';增加新货物控件
Set 货物类别.DataSource = Adodc1
货物类别.DataField = "类别名称"

End Sub
Private Sub 更换类别_Click()
DataGrid2.Columns(2).Value = 货物类别.Text
   ';写入系统日志
fMainForm.WriteLog ("更新货物类别")

End Sub
Private Sub 货物类别_GotFocus()
货物类别.Enabled = False
End Sub
Private Sub 货物类别_LostFocus()
货物类别.Enabled = True
End Sub
Private Sub 删除货物_Click()
On Error Resume Next
';判断是否其它表单用了待删除的货物编号
Dim code As String
Dim rs As String
code = DataGrid2.Columns(0).Text

rs = ""
rs = rs + "select 货物编号 from 入库单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 出库单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 借入单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 借出单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 调拔单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 报损单 where 货物编号=" + Str(code): rs = rs + " union "
rs = rs + "select 货物编号 from 库存状况 where 货物编号=" + Str(code)
fMainForm.m_checkado.RecordSource = rs
fMainForm.m_checkado.Refresh

If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
      MsgBox "其它表单用了此货物信息,不能删除!", vbExclamation
Else
      fMainForm.m_checkado.RecordSource = "select * from 货物信息 where 编号=" + DataGrid2.Columns(0).Text
      fMainForm.m_checkado.Refresh
      fMainForm.m_checkado.Recordset.Delete

      SaveInit
      Adodc2.Refresh
      ResumeInit

      ';写入系统日志
      fMainForm.WriteLog ("删除货物")

End If

End Sub
Private Sub 增加新货物_Click()
If 货物编号.Text = "" Then MsgBox "请填写货物编号!", vbQuestion: Exit Sub
If 货物名称.Text = "" Then MsgBox "请填写货物名称!", vbQuestion: Exit Sub
If 最低限量.Text = "" Then MsgBox "请填写最低限量!", vbQuestion: Exit Sub
If 最高限量.Text = "" Then MsgBox "请填写最高限量!", vbQuestion: Exit Sub
If 计量单位.Text = "" Then MsgBox "请填写计量单位!", vbQuestion: Exit Sub

On Error Resume Next

SaveInit

Adodc2.Recordset.AddNew
Adodc2.Recordset.Fields("编号") = 货物编号.Text
Adodc2.Recordset.Fields("货物名称") = 货物名称.Text
Adodc2.Recordset.Fields("货物类别") = DataGrid1.Columns(0).Text
Adodc2.Recordset.Fields("货物规格") = 货物规格.Text
Adodc2.Recordset.Fields("计量单位") = 计量单位.Text
Adodc2.Recordset.Fields("最低限量") = 最低限量.Text
Adodc2.Recordset.Fields("最高限量") = 最高限量.Text
Adodc2.Recordset.Fields("备注") = 备注.Text

Adodc2.Recordset.update
Adodc2.Recordset.Requery

Adodc2.Refresh
ResumeInit

货物编号.Text = 货物编号.Text + 1

   ';写入系统日志
fMainForm.WriteLog ("增加新货物")

End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:39 标题: [公告]技术区5.1比赛作品发表专帖

借出单

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 = "供应商名称"
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(10).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(10).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
';库存不足
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

作者: 漫天樱舞 时间: 2005-5-15 21:41 标题: [公告]技术区5.1比赛作品发表专帖

借入单

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 = "供应商名称"
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(10).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 库存数量 from 库存状况 where 货物编号=" + 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
';更新库存状况
If num2 - num1 > 0 Then
      fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
      fMainForm.m_checkado.Recordset.update
Else ';如果库存为零清空
      fMainForm.m_checkado.Recordset.Delete
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(10).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) + " and 仓库编号=" + Str(code2)
fMainForm.m_checkado.Refresh

';当前库存数量num2
num2 = fMainForm.m_checkado.Recordset.Fields("库存数量").Value
';库存不足
If num2 < num1 Then
      MsgBox "库存不足,库存量为" + Str(num2) + ",需求量为" + Str(num1) + "."
      Exit Sub
Else
';更新库存状况
      If num2 - num1 > 0 Then
         fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
         fMainForm.m_checkado.Recordset.update
      Else ';如果库存为零清空
         fMainForm.m_checkado.Recordset.Delete
      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

作者: 漫天樱舞 时间: 2005-5-15 21:41 标题: [公告]技术区5.1比赛作品发表专帖

客户

Private m_IsAdd As Boolean
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(0).width = 500
DataGrid1.Columns(1).width = 1200
DataGrid1.Columns(2).width = 600
DataGrid1.Columns(3).width = 800
DataGrid1.Columns(4).width = 1000
DataGrid1.Columns(5).width = 1000
DataGrid1.Columns(6).width = 1000
DataGrid1.Columns(7).width = 1000
DataGrid1.Columns(8).width = 1000
DataGrid1.Columns(9).width = 1000
DataGrid1.Columns(10).width = 1000

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 DataGrid1_AfterDelete()
';写入系统日志
fMainForm.WriteLog ("删除客户")
End Sub
Private Sub DataGrid1_AfterInsert()
';写入系统日志
fMainForm.WriteLog ("增加客户")
End Sub
Private Sub DataGrid1_AfterUpdate()
';写入系统日志
fMainForm.WriteLog ("更新客户")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)
On Error Resume Next

';判断是否其它表单用了待删除的客户编号
Dim code As String
Dim rs As String
code = DataGrid1.Columns(0).Text

rs = ""
rs = rs + "select 经办人编号 from 出库单 where 经办人编号=" + Str(code)

fMainForm.m_checkado.RecordSource = rs
fMainForm.m_checkado.Refresh
If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
      MsgBox "其它表单用了此客户信息,不能删除!", vbExclamation
      Cancel = True
End If

End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)

On Error Resume Next
Dim caption As String
caption = DataGrid1.Columns(ColIndex).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
Adodc1.Visible = False

initdatagrid1

End Sub
Private Sub DataGrid1_OnAddNew()
DataGrid1.Columns(0).Locked = 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

作者: 漫天樱舞 时间: 2005-5-15 21:43 标题: [公告]技术区5.1比赛作品发表专帖

库存查询 Private SQL As String Private 仓库编号 As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 500 DataGrid1.Columns(1).width = 800 DataGrid1.Columns(2).width = 800 DataGrid1.Columns(3).width = 800 DataGrid1.Columns(4).width = 800 DataGrid1.Columns(5).width = 800 DataGrid1.Columns(6).width = 800 DataGrid1.Columns(7).width = 800 DataGrid1.Columns(8).width = 800 DataGrid1.Columns(9).width = 0 End Sub Private Sub updatecolumns() 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 DataCombo1_Change() Option1.Value = False Option2.Value = False Option3.Value = False End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString SQL = Adodc1.RecordSource Adodc1.Visible = False Adodc2.ConnectionString = DataConnectString Set DataCombo1.RowSource = Adodc2 DataCombo1.ListField = "仓库名称" Adodc2.Refresh Adodc2.Visible = False T库存数量.Text = "无限制" End Sub Private Sub Option1_Click() update End Sub Private Sub update() If DataCombo1.Text = "" Then MsgBox "请选择仓库名称!" Exit Sub End If On Error GoTo quit ';获取仓库编号 fMainForm.m_checkado.RecordSource = "select 编号 from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value If Option1.Value = True Then Adodc1.RecordSource = "select * from 货物信息 where 编号 not in (select 货物编号 from 库存状况 where 仓库编号=" + 仓库编号 + ")" Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh updatecolumns ElseIf Option2.Value = True Then Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,货物信息.计量单位,库存状况.库存数量,货物信息.最低限量,仓库.仓库名称 as 存放仓库,货物信息.备注 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号 and 库存数量<=货物信息.最低限量 and 库存状况.仓库编号=" + 仓库编号 Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh updatecolumns ElseIf Option3.Value = True Then Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,货物信息.货物类别,货物信息.货物规格,货物信息.计量单位,库存状况.库存数量,货物信息.最高限量,仓库.仓库名称 as 存放仓库,货物信息.备注 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号 and 库存数量>=货物信息.最高限量 and 库存状况.仓库编号=" + 仓库编号 Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh updatecolumns End If quit: End Sub Private Sub Option2_Click() update End Sub Private Sub Option3_Click() update 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.result1 <> "" Then 货物类别.Text = sel.result1 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 DataCombo1.Text = "" Then MsgBox "请选择仓库名称!" Exit Sub End If On Error GoTo quit ';获取仓库编号 fMainForm.m_checkado.RecordSource = "select 编号 from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value Dim s As String s = SQL ';处理s ';加上仓库编号 s = s + " and 库存状况.仓库编号=" + 仓库编号 If 货物名称.Text <> "" Then s = s + " and 货物信息.货物名称 like ';%" + 货物名称.Text + "%';" End If If 货物类别.Text <> "" Then s = s + " and 货物信息.货物类别 like ';%" + 货物类别.Text + "%';" End If If 货物规格.Text <> "" Then s = s + " and 货物信息.货物规格 like ';%" + 货物规格.Text + "%';" End If If T库存数量.Text <> "无限制" And 库存数量.Text <> "" Then s = s + " and 库存状况.库存数量" + T库存数量.Text + 库存数量.Text End If Adodc1.RecordSource = s Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh initdatagrid1 quit: End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:44 标题: [公告]技术区5.1比赛作品发表专帖

库存状况 Dim SQL As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 800 DataGrid1.Columns(1).width = 800 DataGrid1.Columns(2).width = 800 DataGrid1.Columns(3).width = 800 DataGrid1.Columns(4).width = 1000 DataGrid1.Columns(5).width = 800 DataGrid1.Columns(6).width = 800 DataGrid1.Columns(7).width = 800 DataGrid1.Columns(8).width = 800 DataGrid1.Columns(9).width = 800 End Sub Private Sub DataCombo1_Change() 限定仓库.Value = 0 End Sub Private Sub DataGrid1_Click() 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 update() If 限定仓库.Value = 1 And DataCombo1.Text = "" Then MsgBox "请选择仓库!": Exit Sub Dim 仓库编号 As String On Error Resume Next ';获取仓库编号 fMainForm.m_checkado.RecordSource = "select 编号 from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value If 限定仓库.Value = 1 And DataCombo1.Text <> "" Then Adodc1.RecordSource = SQL + " and 库存状况.仓库编号=" + 仓库编号 Else Adodc1.RecordSource = SQL End If Adodc1.Refresh initdatagrid1 End Sub Private Sub 限定仓库_Click() update End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:44 标题: [公告]技术区5.1比赛作品发表专帖

权限选择

Public Purview As Long
Option Explicit

Private Sub Form_Resize()

';初始化各checkbox
Dim i As Integer

For i = 16 To 0 Step -1
      If GetBit(Purview, i + 1) = 0 Then
         Check(16 - i).Value = 0
      Else
         Check(16 - i).Value = 1
      End If
Next

End Sub
Private Sub 取消_Click()
Unload Me
End Sub
Private Sub 全部选中_Click()
Dim i As Integer

For i = 0 To 16
      If Check(i).Enabled = True Then Check(i).Value = 1
Next

End Sub
Private Sub 修改权限_Click()

Dim i As Integer
Dim s As String
s = ""

For i = 16 To 0 Step -1
      s = s + LTrim(Str(Check(i).Value))
Next

Purview = GetBits(s, 17)

Unload Me

End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:45 标题: [公告]技术区5.1比赛作品发表专帖

入库单

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 库存数量 from 库存状况 where 货物编号=" + 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
';更新库存状况
If num2 - num1 > 0 Then
      fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
      fMainForm.m_checkado.Recordset.update
Else ';如果库存为零清空
      fMainForm.m_checkado.Recordset.Delete
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) + " and 仓库编号=" + Str(code2)
fMainForm.m_checkado.Refresh

';当前库存数量num2
num2 = fMainForm.m_checkado.Recordset.Fields("库存数量").Value
';库存不足
If num2 < num1 Then
      MsgBox "库存不足,库存量为" + Str(num2) + ",需求量为" + Str(num1) + "."
      Exit Sub
Else
';更新库存状况
      If num2 - num1 > 0 Then
         fMainForm.m_checkado.Recordset.Fields("库存数量").Value = num2 - num1
         fMainForm.m_checkado.Recordset.update
      Else ';如果库存为零清空
         fMainForm.m_checkado.Recordset.Delete
      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

作者: 漫天樱舞 时间: 2005-5-15 21:46 标题: [公告]技术区5.1比赛作品发表专帖

数据清除

Option Explicit
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub OKButton_Click()
If MsgBox("建议您备份数据库,您备分数据库吗?", vbYesNo Or vbQuestion) = vbYes Then

      On Error GoTo failure

      With dlgCommonDialog
            .DialogTitle = "数据库备份为.."
            .ShowSave

            If Len(.filename) = 0 Then Exit Sub

            If BackupData(DataPath, .filename) = 1 Then
               MsgBox "备份成功!"
            Else
failure:
               MsgBox "备份失败!"
            End If
      End With
Else
      If MsgBox("您确信要清除吗?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
End If

On Error Resume Next
If 所有单据.Value = 1 Then
   ';删除入库单
      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
End If

If 库存状况.Value = 1 Then
      ';删除库存状况
      fMainForm.m_checkado.RecordSource = "select * from 库存状况"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 盘点单据.Value = 1 Then
      ';删除盘点单
      fMainForm.m_checkado.RecordSource = "select * from 盘点单"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 客户信息.Value = 1 Then
      ';删除客户
      fMainForm.m_checkado.RecordSource = "select * from 客户"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 供应商信息.Value = 1 Then
      ';删除供应商
      fMainForm.m_checkado.RecordSource = "select * from 供应商"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 货物信息.Value = 1 Then
      ';删除货物信息
      fMainForm.m_checkado.RecordSource = "select * from 货物信息"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 货物类别.Value = 1 Then
      ';删除货物类别
      fMainForm.m_checkado.RecordSource = "select * from 货物类别"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 仓库信息.Value = 1 Then
      ';删除仓库
      fMainForm.m_checkado.RecordSource = "select * from 仓库"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 职员信息.Value = 1 Then
      ';删除职员信息
      fMainForm.m_checkado.RecordSource = "select * from 职员信息"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 公司信息.Value = 1 Then
      ';删除公司信息,不能删除，全部置空即可
      fMainForm.m_checkado.RecordSource = "select * from 公司信息"
      fMainForm.m_checkado.Refresh
      fMainForm.m_checkado.Recordset.Fields("公司名称").Value = ""
      fMainForm.m_checkado.Recordset.Fields("地址").Value = ""
      fMainForm.m_checkado.Recordset.Fields("城市").Value = ""
      fMainForm.m_checkado.Recordset.Fields("省份").Value = ""
      fMainForm.m_checkado.Recordset.Fields("国家").Value = ""
      fMainForm.m_checkado.Recordset.Fields("邮政编码").Value = ""
      fMainForm.m_checkado.Recordset.Fields("电话号码").Value = ""
      fMainForm.m_checkado.Recordset.Fields("电子邮件").Value = ""
      fMainForm.m_checkado.Recordset.Fields("传真号码").Value = ""
      fMainForm.m_checkado.Recordset.Fields("开户银行").Value = ""
      fMainForm.m_checkado.Recordset.Fields("银行帐号").Value = ""
      fMainForm.m_checkado.Recordset.Fields("业务描述").Value = ""

      fMainForm.m_checkado.Recordset.update
      fMainForm.m_checkado.Refresh
End If

If 系统日志.Value = 1 Then
   ';删除系统日志
      fMainForm.m_checkado.RecordSource = "select * from 系统日志"
      fMainForm.m_checkado.Refresh
      DeleteRecordData fMainForm.m_checkado.Recordset
End If

If 用户管理.Value = 1 Then
      ';删除用户管理
      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

End If

Unload Me

MsgBox "数据清除成功!"
   ';写入系统日志
fMainForm.WriteLog ("进行数据清除")

End Sub
Private Sub 仓库信息_Click()

If 仓库信息.Value = 1 Then
      所有单据.Enabled = False
      盘点单据.Enabled = False
Else
      所有单据.Enabled = True
      盘点单据.Enabled = False
End If

所有单据.Value = 1
盘点单据.Value = 1

End Sub
Private Sub 供应商信息_Click()

If 供应商信息.Value = 1 Then
      所有单据.Enabled = False
Else
      所有单据.Enabled = True
End If

所有单据.Value = 1

End Sub
Private Sub 货物类别_Click()

If 货物类别.Value = 1 Then
      所有单据.Enabled = False
      货物信息.Enabled = False
Else
      所有单据.Enabled = True
      货物信息.Enabled = True
End If

所有单据.Value = 1
货物信息.Value = 1

End Sub
Private Sub 货物信息_Click()

If 货物信息.Value = 1 Then
      所有单据.Enabled = False
Else
      所有单据.Enabled = True
End If

所有单据.Value = 1

End Sub
Private Sub 客户信息_Click()

If 客户信息.Value = 1 Then
      所有单据.Enabled = False
Else
      所有单据.Enabled = True
End If

所有单据.Value = 1

End Sub

Private Sub 用户管理_Click()

If 用户管理.Value = 1 Then
      系统日志.Enabled = False
Else
      系统日志.Enabled = True
End If

系统日志.Value = 1

End Sub
Private Sub 职员信息_Click()
If 职员信息.Value = 1 Then
      所有单据.Enabled = False
      仓库信息.Enabled = False
      盘点单据.Enabled = False
Else
      所有单据.Enabled = True
      仓库信息.Enabled = True
      盘点单据.Enabled = True
End If

所有单据.Value = 1
仓库信息.Value = 1
盘点单据.Value = 1

End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:47 标题: [公告]技术区5.1比赛作品发表专帖

数据选择 Public title As String Public result1 As String Public result2 As String Option Explicit Private Sub CancelButton_Click() result1 = "" result2 = "" Unload Me End Sub Private Sub Form_Load() Adodc1.Visible = False End Sub Private Sub Form_Resize() On Error Resume Next Adodc1.ConnectionString = DataConnectString Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Me.caption = title 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 + 1000 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 OKButton_Click() On Error Resume Next result1 = DataGrid1.Columns(0).Text result2 = DataGrid1.Columns(1).Text Unload Me End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:47 标题: [公告]技术区5.1比赛作品发表专帖

系统日志 Dim SQL As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 1000 DataGrid1.Columns(1).width = 1800 DataGrid1.Columns(2).width = 2200 End Sub Private Sub Check1_Click() update End Sub Private Sub Check2_Click() update End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString SQL = Adodc1.RecordSource Set DataGrid1.DataSource = Adodc1 Adodc1.Visible = False Option1.Value = True End Sub Private Sub Option1_Click() update End Sub Private Sub Option2_Click() update End Sub Private Sub Option3_Click() update End Sub Private Sub Option4_Click() update End Sub Private Sub update() On Error GoTo quit Dim s As String s = SQL + " where true" If Check1.Value = 1 And 用户名.Text <> "" Then s = s + " and 用户名 like ';%" + 用户名.Text + "%';" End If If Check2.Value = 1 And 操作内容.Text <> "" Then s = s + " and 操作内容 like ';%" + 操作内容.Text + "%';" End If Dim t As Date t = Date If Option1.Value = True Then ElseIf Option2.Value = True Then t = DateAdd("d", -3, t) ElseIf Option3.Value = True Then t = DateAdd("d", -7, t) End If If Option4.Value = False Then s = s + " and 操作时间>=" + "#" + Str(t) + " 0:0:0#" End If s = s + " order by 操作时间 desc" Adodc1.RecordSource = s Adodc1.Refresh initdatagrid1 quit: End Sub Private Sub 操作内容_Change() Check2.Value = 0 End Sub Private Sub 用户名_Change() Check1.Value = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:48 标题: [公告]技术区5.1比赛作品发表专帖

新增报损单 Private 客户编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 报损单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,报损单.报损时间,报损单.报损单价,货物信息.计量单位,报损单.报损数量,(报损单.报损单价*报损单.报损数量) as 金额,报损单.其它金额,仓库.仓库名称 as 存放仓库,报损单.备注 from 报损单,货物信息,职员信息,仓库 where 货物信息.编号=报损单.货物编号 and 职员信息.编号=报损单.经办人编号 and 仓库.编号=报损单.仓库编号 and 报损单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("报损单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("报损数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("报损时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写报损单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "报损失败,不能报损" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的报损单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,报损时间,报损单价,报损数量,仓库编号,其它金额,备注 from 报损单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("报损时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("报损单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("报损数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增报损单成功!" ';写入系统日志 fMainForm.WriteLog ("新增报损单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印报损单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择报损货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:50 标题: [公告]技术区5.1比赛作品发表专帖

新增出库单 Private 客户编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 客户.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 客户.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 出库单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,出库单.出库时间,出库单.出库单价,货物信息.计量单位,出库单.出库数量,(出库单.出库单价*出库单.出库数量) as 金额,出库单.其它金额,客户.客户名称 as 客户,仓库.仓库名称 as 存放仓库,出库单.备注 from 出库单,货物信息,职员信息,客户,仓库 where 货物信息.编号=出库单.货物编号 and 职员信息.编号=出库单.经办人编号 and 客户.编号=出库单.客户编号 and 仓库.编号=出库单.仓库编号 and 出库单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("出库单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("出库数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 客户.Text = fMainForm.m_checkado.Recordset.Fields("客户").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("出库时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写出库单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "出库失败,不能出库" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的出库单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,出库时间,出库单价,出库数量,客户编号,仓库编号,定单状况,其它金额,备注 from 出库单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("出库时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("出库单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("出库数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("客户编号") = 客户编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增出库单成功!" ';写入系统日志 fMainForm.WriteLog ("新增出库单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印出库单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 客户_Click() If 客户.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,客户名称 from 客户" sel.title = "请选择客户" sel.Show vbModal If sel.result1 <> "" Then 客户编号 = sel.result1 If sel.result2 <> "" Then 客户.Text = sel.result2 Unload sel End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择出库货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 客户_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:51 标题: [公告]技术区5.1比赛作品发表专帖

新增调拔单 Private 原存放仓库编号, 目标存放仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 其它金额.BackColor = bkcolor 目标存放仓库.BackColor = bkcolor 原存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单位.Locked = True 数量.Locked = True 其它金额.Locked = True 原存放仓库.Locked = True 目标存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 调拔单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,调拔单.调拔时间,货物信息.计量单位,调拔单.调拔数量,调拔单.其它金额,仓库.仓库名称 as 原存放仓库,(select 仓库名称 from 仓库 where 编号=调拔单.目标仓库编号) as 目标存放仓库,调拔单.备注 from 调拔单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=调拔单.货物编号 and 职员信息.编号=调拔单.经办人编号 and 仓库.编号=调拔单.原仓库编号 and 调拔单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("调拔数量").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 原存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("原存放仓库").Value 目标存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("目标存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("调拔时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 原存放仓库.Text = "" Then MsgBox "请填写供应商!", vbQuestion: Exit Sub If 目标存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub If 原存放仓库.Text = 目标存放仓库 Then MsgBox "原存放仓库和目标存放仓库不能相同!", vbQuestion: Exit Sub ';检测原仓库********************************************************** On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(原存放仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max1 As String On Error Resume Next max1 = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a1, b1 As Long a1 = 数量.Text: b1 = max1 If a1 > b1 Then MsgBox "调拔失败,不能调拔" + 数量.Text + ",原仓库库存剩余量为" + Str(max1) Exit Sub End If ';检测目标仓库********************************************************** ';得到最高限量max On Error Resume Next Dim max2, use, left As String fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh max2 = fMainForm.m_checkado.Recordset.Fields(0).Value ';得到当前仓库库存量use fMainForm.m_checkado.RecordSource = "select 库存数量 from 货物信息,库存状况 where 货物编号=" + 货物编号 + " and 仓库编号=" + 目标存放仓库编号 fMainForm.m_checkado.Refresh use = 0 On Error GoTo 1: use = fMainForm.m_checkado.Recordset.Fields(0).Value 1: On Error GoTo quit left = max2 - use Dim a2, b2 As Long ';如果超过最高限量 a2 = 数量.Text: b2 = left If a2 > b2 Then MsgBox "调拔失败,不能调拔" + 数量.Text + ",目标仓库剩余限量为" + Str(left) Exit Sub End If ';更新数据库信息********************************************************** ';新增调拔单 (编号,.......) fMainForm.m_checkado.RecordSource = "select * from 调拔单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号").Value = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号").Value = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号").Value = 经办人编号 fMainForm.m_checkado.Recordset.Fields("调拔时间").Value = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("调拔数量").Value = 数量.Text fMainForm.m_checkado.Recordset.Fields("原仓库编号").Value = 原存放仓库编号 fMainForm.m_checkado.Recordset.Fields("目标仓库编号").Value = 目标存放仓库编号 fMainForm.m_checkado.Recordset.Fields("其它金额").Value = 其它金额.Text fMainForm.m_checkado.Recordset.Fields("备注").Value = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';原仓库数量减数量.text (原存放仓库编号,货物编号) fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(原存放仓库编号) fMainForm.m_checkado.Refresh Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';目标仓库数量加数量.text (目标存放仓库编号,货物编号) fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(目标存放仓库编号) fMainForm.m_checkado.Refresh ';如果以存在则更新 If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量") = fMainForm.m_checkado.Recordset.Fields("库存数量") + 数量.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh Else ';如果不存在则创建 ';获取新的库存状况的编号 ncode fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh Dim ncode As String 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("编号").Value = ncode fMainForm.m_checkado.Recordset.Fields("货物编号").Value = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("库存数量").Value = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号").Value = 目标存放仓库编号 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增调拔单成功!" ';写入系统日志 fMainForm.WriteLog ("新增调拔单") GoTo quit2 quit: MsgBox "新增调拔单失败!" quit2: End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 目标存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 原存放仓库_Click() If 原存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择原存放仓库" sel.Show vbModal If sel.result1 <> "" Then 原存放仓库编号 = sel.result1 If sel.result2 <> "" Then 原存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 目标存放仓库_Click() If 目标存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,货物信息.最高限量,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量,(货物信息.最高限量-库存量) as 剩余限量 from 仓库,货物信息 where 货物信息.编号=" + 货物编号.Text Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择目标存放仓库" sel.Show vbModal If sel.result1 <> "" Then 目标存放仓库编号 = sel.result1 If sel.result2 <> "" Then 目标存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印调拔单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择调拔货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 原存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:52 标题: [公告]技术区5.1比赛作品发表专帖

新增借出单 Private 供应商编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 其它金额.BackColor = bkcolor 供应商.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单位.Locked = True 数量.Locked = True 其它金额.Locked = True 供应商.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 借出单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,借出单.借出时间,货物信息.计量单位,借出单.借出数量,借出单.其它金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,借出单.备注 from 借出单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=借出单.货物编号 and 职员信息.编号=借出单.经办人编号 and 供应商.编号=借出单.供应商编号 and 仓库.编号=借出单.仓库编号 and 借出单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("借出数量").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 供应商.Text = fMainForm.m_checkado.Recordset.Fields("供应商").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("借出时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "借出失败,不能借出" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的借出单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,借出时间,借出数量,供应商编号,仓库编号,定单状况,其它金额,备注 from 借出单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("借出时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("借出数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("供应商编号") = 供应商编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增借出单成功!" ';写入系统日志 fMainForm.WriteLog ("新增借出单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印借出单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 供应商_Click() If 供应商.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,供应商名称 from 供应商" sel.title = "请选择供应商" sel.Show vbModal If sel.result1 <> "" Then 供应商编号 = sel.result1 If sel.result2 <> "" Then 供应商.Text = sel.result2 Unload sel End Sub Private Sub 供应商_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择借出货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:52 标题: [公告]技术区5.1比赛作品发表专帖

新增借入单 Private 供应商编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 其它金额.BackColor = bkcolor 供应商.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单位.Locked = True 数量.Locked = True 其它金额.Locked = True 供应商.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 借入单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,借入单.借入时间,货物信息.计量单位,借入单.借入数量,借入单.其它金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,借入单.备注 from 借入单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=借入单.货物编号 and 职员信息.编号=借入单.经办人编号 and 供应商.编号=借入单.供应商编号 and 仓库.编号=借入单.仓库编号 and 借入单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("借入数量").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 供应商.Text = fMainForm.m_checkado.Recordset.Fields("供应商").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("借入时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 供应商.Text = "" Then MsgBox "请填写供应商!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有超过库存限量 Dim max, use, left As String ';得到最高限量max fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh max = fMainForm.m_checkado.Recordset.Fields(0).Value ';得到当前仓库库存量use fMainForm.m_checkado.RecordSource = "select 库存数量 from 货物信息,库存状况 where 货物编号=" + 货物编号 + " and 仓库编号=" + 仓库编号 fMainForm.m_checkado.Refresh use = 0 On Error GoTo 1 use = fMainForm.m_checkado.Recordset.Fields(0).Value 1: On Error GoTo quit left = max - use ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = left If a > b Then MsgBox "借入失败,不能借入" + 数量.Text + ",剩余限量为" + Str(left) Exit Sub End If ';库存量足够 ';开始写入新的借入单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,借入时间,借入数量,供应商编号,仓库编号,定单状况,其它金额,备注 from 借入单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("借入时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("借入数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("供应商编号") = 供应商编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh ';如果已有记录 If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + 数量.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh Else ';获取新的库存状况的编号 ncode fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh Dim ncode As String 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("货物编号") = 货物编号 fMainForm.m_checkado.Recordset.Fields("库存数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增借入单成功!" ';写入系统日志 fMainForm.WriteLog ("新增借入单") GoTo quit2 quit: MsgBox "新增借入单失败!" quit2: End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,货物信息.最高限量,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量,(货物信息.最高限量-库存量) as 剩余限量 from 仓库,货物信息 where 货物信息.编号=" + 货物编号.Text Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 700 PrintForm Me.Height = Me.Height + 700 ';写入系统日志 fMainForm.WriteLog ("打印借入单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 供应商_Click() If 供应商.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,供应商名称 from 供应商" sel.title = "请选择供应商" sel.Show vbModal If sel.result1 <> "" Then 供应商编号 = sel.result1 If sel.result2 <> "" Then 供应商.Text = sel.result2 Unload sel End Sub Private Sub 供应商_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物名称,货物类别,货物规格 from 货物信息" sel.title = "请选择借入货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:53 标题: [公告]技术区5.1比赛作品发表专帖

新增入库单 Private 供应商编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 供应商.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 供应商.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 入库单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,入库单.入库时间,入库单.入库单价,货物信息.计量单位,入库单.入库数量,(入库单.入库单价*入库单.入库数量) as 金额,入库单.其它金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,入库单.备注 from 入库单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=入库单.货物编号 and 职员信息.编号=入库单.经办人编号 and 供应商.编号=入库单.供应商编号 and 仓库.编号=入库单.仓库编号 and 入库单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("入库单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("入库数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 供应商.Text = fMainForm.m_checkado.Recordset.Fields("供应商").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("入库时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写入库单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 供应商.Text = "" Then MsgBox "请填写供应商!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有超过库存限量 Dim max, use, left As String ';得到最高限量max fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh max = fMainForm.m_checkado.Recordset.Fields(0).Value ';得到当前仓库库存量use fMainForm.m_checkado.RecordSource = "select 库存数量 from 货物信息,库存状况 where 货物编号=" + 货物编号 + " and 仓库编号=" + 仓库编号 fMainForm.m_checkado.Refresh use = 0 On Error GoTo 1: use = fMainForm.m_checkado.Recordset.Fields(0).Value 1: On Error GoTo quit left = max - use ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = left If a > b Then MsgBox "入库失败,不能入库" + 数量.Text + ",剩余限量为" + Str(left) Exit Sub End If ';库存量足够 ';开始写入新的入库单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,入库时间,入库单价,入库数量,供应商编号,仓库编号,定单状况,其它金额,备注 from 入库单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("入库时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("入库单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("入库数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("供应商编号") = 供应商编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh ';如果已有记录 If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + 数量.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh Else ';获取新的库存状况的编号 ncode fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh Dim ncode As String 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("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("库存数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增入库单成功!" ';写入系统日志 fMainForm.WriteLog ("新增入库单") GoTo quit2 quit: MsgBox "新增入库单失败!" quit2: End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,货物信息.最高限量,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量,(货物信息.最高限量-库存量) as 剩余限量 from 仓库,货物信息 where 货物信息.编号=" + 货物编号.Text Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印入库单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 供应商_Click() If 供应商.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,供应商名称 from 供应商" sel.title = "请选择供应商" sel.Show vbModal If sel.result1 <> "" Then 供应商编号 = sel.result1 If sel.result2 <> "" Then 供应商.Text = sel.result2 Unload sel End Sub Private Sub 供应商_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物名称,货物类别,货物规格 from 货物信息" sel.title = "请选择入库货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:54 标题: [公告]技术区5.1比赛作品发表专帖

用户管理 Private m_IsAdd As Boolean Private Function ModifyPurview(ByVal d As Long) Dim f As New 权限选择 f.Purview = d If Adodc1.Recordset.Fields("用户名").Value = UserName Then f.Check(16).Enabled = False f.Show vbModal ModifyPurview = f.Purview Unload f End Function Private Sub initdatagrid1() DataGrid1.Columns(0).width = 2000 DataGrid1.Columns(1).width = 1800 DataGrid1.Columns(2).width = 0 DataGrid1.Columns(0).AllowSizing = False DataGrid1.Columns(1).AllowSizing = False DataGrid1.Columns(2).AllowSizing = False DataGrid1.AllowRowSizing = False DataGrid1.Columns(0).Locked = True DataGrid1.Columns(2).Locked = True End Sub Private Sub Form_Load() ';初始化数据源 Adodc1.ConnectionString = DataConnectString Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Adodc1.Visible = False initdatagrid1 End Sub Private Sub DataGrid1_OnAddNew() DataGrid1.Columns(0).Locked = False DataGrid1.Columns(2).Value = 0 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 Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ';写入系统日志 fMainForm.WriteLog ("查看或修改用户管理") End Sub Private Sub Form_Unload(Cancel As Integer) ';检测当前用户名密码是否改变，如果改变则重置它 Dim fit As String ';查找用户名 fit = "用户名=';" fit = fit + UserName + "';" Adodc1.Recordset.Find fit Adodc1.Recordset.MoveFirst Adodc1.Recordset.Find fit ';找不到该用户 On Error GoTo reset If Adodc1.Recordset.EOF <> True Then UserPas = Adodc1.Recordset.Fields("用户密码").Value GoTo quit reset: UserPas = "" quit: End Sub Private Sub 删除用户_Click() On Error Resume Next If Adodc1.Recordset.Fields("用户名").Value = UserName Then MsgBox "不能删除当前登陆用户!": Exit Sub Adodc1.Recordset.Delete Adodc1.Recordset.Requery initdatagrid1 End Sub Private Sub 修改权限_Click() On Error Resume Next Dim l1, l2 As Long On Error GoTo 1 l1 = Adodc1.Recordset.Fields("用户权限").Value GoTo 2 1: l1 = 0 2: l2 = ModifyPurview(l1) If l2 <> l1 Then Adodc1.Recordset.Fields("用户权限").Value = l2 Adodc1.Recordset.update Adodc1.Recordset.Requery initdatagrid1 End If End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:55 标题: [公告]技术区5.1比赛作品发表专帖

月盘点 Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private 仓库编号 As String Private 经办人编号 As String Private m_data(5, 4) As String Private m_otherdata(5) As String Option Explicit Private Sub printdata(i, j) Dim X, Y As Long X = col(j).left / 15 + 5 Y = row(i).Top / 15 TextOut Me.hdc, X, Y, m_data(i, j), Len(m_data(i, j)) End Sub Private Sub printotherdata(i) Dim X, Y As Long If i = 0 Then X = (other1.left + other1.width) / 15 + 5 Y = other1.Top / 15 ElseIf i = 1 Then X = (other2.left + other2.width) / 15 + 5 Y = other2.Top / 15 ElseIf i = 2 Then X = (other3.left + other3.width) / 15 + 5 Y = other3.Top / 15 ElseIf i = 3 Then X = (other4.left + other4.width) / 15 + 5 Y = other4.Top / 15 ElseIf i = 4 Then X = (other5.left + other5.width) / 15 + 5 Y = other5.Top / 15 Else X = (other6.left + other6.width) / 15 + 5 Y = other6.Top / 15 End If TextOut Me.hdc, X, Y, m_otherdata(i), Len(m_otherdata(i)) End Sub Private Sub printalldata() Dim i, j As Integer For i = 0 To 5 For j = 0 To 4 printdata i, j Next j Next i For i = 0 To 5 printotherdata i Next i End Sub Private Function GetMinDate() Dim t As Date t = Date t = DateAdd("m", -1, t) GetMinDate = Str(t) End Function Private Sub ChangeBackColor() Dim bkcolor As Long bkcolor = Me.BackColor 编号.BackColor = bkcolor 日期.BackColor = bkcolor 经办人.BackColor = bkcolor 仓库名称.BackColor = bkcolor 进行月盘点.BackColor = bkcolor 更改背景.BackColor = bkcolor 打印月盘点单.BackColor = bkcolor 保存月盘点.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 仓库名称.Locked = True 经办人.Locked = True End Sub Private Sub Form_Paint() printalldata End Sub Private Sub Form_Resize() ChangeBackColor ';新增盘点单 If 编号.Text = "" Then 日期.Text = Date 打印月盘点单.Visible = False 更改背景.Visible = False ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 盘点单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印盘点单 ';初始化数据 fMainForm.m_checkado.RecordSource = "select 仓库.仓库名称,职员信息.姓名 as 经办人,盘点单.盘点数据,盘点单.盘点时间 from 仓库,职员信息,盘点单 where 仓库.编号=盘点单.仓库编号 and 职员信息.编号=盘点单.经办人编号 and 盘点单.编号=" + 编号.Text + " and 盘点时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then 仓库名称.Text = fMainForm.m_checkado.Recordset.Fields("仓库名称").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value 日期.Text = fMainForm.m_checkado.Recordset.Fields("盘点时间").Value Dim data As String data = fMainForm.m_checkado.Recordset.Fields("盘点数据").Value Dim i, j, n As Long i = 1: n = 1 j = InStr(i, data, ";") While (j <> 0) If n <= 30 Then m_data(n / 5, (n - 1) Mod 5) = Mid(data, i, j - i) Else m_otherdata(n - 31) = Mid(data, i, j - i) End If On Error Resume Next n = n + 1 i = j + 1 j = InStr(i, data, ";") Wend End If 进行月盘点.Visible = False lockcontrol End If End Sub Private Sub 保存月盘点_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 盘点单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast End If fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号").Value = 编号.Text fMainForm.m_checkado.Recordset.Fields("仓库编号").Value = 仓库编号 fMainForm.m_checkado.Recordset.Fields("盘点时间").Value = 日期.Text fMainForm.m_checkado.Recordset.Fields("经办人编号").Value = 经办人编号 Dim data As String Dim i, j As Integer data = "" For j = 0 To 5 For i = 0 To 4 data = data + m_data(j, i) + ";" Next i Next j For i = 0 To 5 data = data + m_otherdata(i) + ";" Next i fMainForm.m_checkado.Recordset.Fields("盘点数据").Value = data fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh MsgBox "月盘点单保存成功!" ';写入系统日志 fMainForm.WriteLog ("新增月盘点") 保存月盘点.Visible = False 更改背景.Visible = True 打印月盘点单.Visible = True End Sub Private Sub 仓库名称_Click() If 仓库名称.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" sel.title = "请选择盘点仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 仓库名称.Text = sel.result2 Unload sel End Sub Private Sub 仓库名称_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印月盘点单_Click() Me.Height = Me.Height - 700 PrintForm Me.Height = Me.Height + 700 ';写入系统日志 fMainForm.WriteLog ("打印月盘点") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With Me.BackColor = CommonDialog1.Color ChangeBackColor End Sub Private Sub 进行月盘点_Click() If 仓库名称.Text = "" Then MsgBox "请填写仓库名称", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人", vbQuestion: Exit Sub On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 盘点单 where 仓库编号=" + 仓库编号 + " and 盘点时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then MsgBox "该仓库本月已盘点!" Exit Sub End If ';进行数据处理 ';入库单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(入库数量) as 入库总量,sum(入库单价*入库数量) as 总金额 from 入库单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 入库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(0, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(0, 2) = fMainForm.m_checkado.Recordset.Fields("入库总量").Value m_data(0, 4) = fMainForm.m_checkado.Recordset.Fields("总金额").Value End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 入库单 where 仓库编号=" + 仓库编号 + " and 入库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(0, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(0, 1) = Str(CLng(Val(m_data(0, 1)) - Val(m_data(0, 0)))) m_data(0, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';出库单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(出库数量) as 出库总量,sum(出库单价*出库数量) as 总金额 from 出库单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 出库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(1, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(1, 2) = fMainForm.m_checkado.Recordset.Fields("出库总量").Value m_data(1, 4) = fMainForm.m_checkado.Recordset.Fields("总金额").Value End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 出库单 where 仓库编号=" + 仓库编号 + " and 出库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(1, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(1, 1) = Str(CLng(Val(m_data(1, 1)) - Val(m_data(1, 0)))) m_data(1, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';借入单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(借入数量) as 借入总量 from 借入单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 借入时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(2, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(2, 2) = fMainForm.m_checkado.Recordset.Fields("借入总量").Value m_data(2, 4) = "" End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 借入单 where 仓库编号=" + 仓库编号 + " and 借入时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(2, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(2, 1) = Str(CLng(Val(m_data(2, 1)) - Val(m_data(2, 0)))) m_data(2, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';借出单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(借出数量) as 借出总量 from 借出单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 借出时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(3, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(3, 2) = fMainForm.m_checkado.Recordset.Fields("借出总量").Value m_data(3, 4) = "" End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 借出单 where 仓库编号=" + 仓库编号 + " and 借出时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(3, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(3, 1) = Str(CLng(Val(m_data(3, 1)) - Val(m_data(3, 0)))) m_data(3, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';调拔单原仓库 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(调拔数量) as 调拔总量 from 调拔单 where 原仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(4, 2) = fMainForm.m_checkado.Recordset.Fields("调拔总量").Value m_data(4, 4) = "" End If fMainForm.m_checkado.RecordSource = "select sum(其它金额) as 其它总金额 from 调拔单 where 原仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 1) = "" m_data(4, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';调拔单目标仓库 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(调拔数量) as 调拔总量 from 调拔单 where 目标仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 0) = LTrim$(Str(CLng(Val(m_data(4, 0)) + Val(fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value)))) m_data(4, 2) = Str(CLng(Val(m_data(4, 2)) - Val(fMainForm.m_checkado.Recordset.Fields("调拔总量").Value))) m_data(4, 4) = "" End If fMainForm.m_checkado.RecordSource = "select sum(其它金额) as 其它总金额 from 调拔单 where 目标仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 1) = "" m_data(4, 3) = Str(CLng(Val(m_data(4, 3)) + Val(fMainForm.m_checkado.Recordset.Fields("其它总金额").Value))) End If ';报损单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(报损数量) as 报损总量,sum(报损单价*报损数量) as 总金额 from 报损单 where 仓库编号=" + 仓库编号 + " and 报损时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(5, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(5, 2) = fMainForm.m_checkado.Recordset.Fields("报损总量").Value m_data(5, 4) = fMainForm.m_checkado.Recordset.Fields("总金额").Value End If fMainForm.m_checkado.RecordSource = "select sum(其它金额) as 其它总金额 from 报损单 where 仓库编号=" + 仓库编号 + " and 报损时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(5, 1) = "" m_data(5, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';其它总计 ';流入，流出总量 On Error Resume Next m_otherdata(0) = Str(CLng(Val(m_data(0, 2)) + Val(m_data(2, 2)))) m_otherdata(3) = Str(CLng(Val(m_data(1, 2)) + Val(m_data(3, 2)))) ';调拔数量为正 On Error Resume Next If m_data(4, 2) > 0 Then m_otherdata(0) = Str(CLng(Val(m_otherdata(0)) + Val(m_data(4, 2)))) Else m_otherdata(3) = Str(CLng(Val(m_otherdata(3)) + Val(m_data(4, 2)))) End If ';流入，流出金额 On Error Resume Next m_otherdata(1) = Str(Val(m_data(0, 3)) + Val(m_data(1, 3)) + Val(m_data(2, 3)) + Val(m_data(3, 3)) + Val(m_data(4, 3)) + Val(m_data(0, 4)) + Val(m_data(5, 4))) m_otherdata(4) = m_data(1, 4) ';平均单价 On Error Resume Next m_otherdata(2) = Str(CLng((Val(m_otherdata(1)) / Val(m_otherdata(0))) * 100) / 100) m_otherdata(5) = Str(CLng((Val(m_otherdata(4)) / Val(m_otherdata(3))) * 100) / 100) ';数据处理完毕 printalldata 进行月盘点.Visible = False 保存月盘点.Visible = True 仓库名称.Locked = True 经办人.Locked = True End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:57 标题: [公告]技术区5.1比赛作品发表专帖

职员操作统计 Private SQL As String Private startcol As Integer Private endcol As Integer Private col, row As Integer Private rowheight As Integer Private colwidth(8) As Long Private order(8) As Boolean Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 500 DataGrid1.Columns(1).width = 1600 DataGrid1.Columns(2).width = 800 DataGrid1.Columns(3).width = 800 DataGrid1.Columns(4).width = 800 DataGrid1.Columns(5).width = 800 DataGrid1.Columns(6).width = 800 DataGrid1.Columns(7).width = 800 DataGrid1.Columns(8).width = 800 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 DataGrid1_HeadClick(ByVal ColIndex As Integer) If ColIndex > 1 Then Exit Sub On Error Resume Next Dim caption As String caption = DataGrid1.Columns(ColIndex).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 Adodc1.Visible = False Adodc2.ConnectionString = DataConnectString Set DataCombo1.RowSource = Adodc2 DataCombo1.ListField = "仓库名称" Adodc2.Refresh Adodc2.Visible = False T出入时间.Text = "无限制" 进行统计_Click End Sub Private Sub Form_Unload(Cancel As Integer) SQL = "" End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "职员操作统计" End Sub Private Sub 进行统计_Click() If 限定仓库.Value = 1 And DataCombo1.Text = "" Then MsgBox "请选择仓库名称!": Exit Sub Dim 仓库编号 As Long 仓库编号 = -1 On Error Resume Next If 限定仓库.Value = 1 And DataCombo1.Text <> "" Then ';初始化仓库编号 fMainForm.m_checkado.RecordSource = "select * from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value End If On Error Resume Next Dim t As String t = Str(出入时间.Year) + "-" + Str(出入时间.Month) + "-" + Str(出入时间.Day) Dim s As String s = "select 编号,姓名," ';入库单 s = s + "(select count(编号) from 入库单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 入库时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 入库次数," ';出库单 s = s + "(select count(编号) from 出库单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 出库时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 出库次数," ';借入单 s = s + "(select count(编号) from 借入单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 借入时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 借入次数," ';借出单 s = s + "(select count(编号) from 借出单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 借出时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 借出次数," ';调拔单 s = s + "(select count(编号) from 调拔单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 调拔时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 原仓库编号=" + Str(仓库编号) End If s = s + ") as 调拔次数," ';报损单 s = s + "(select count(编号) from 报损单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 报损时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 报损次数," ';总次数 s = s + "(入库次数+出库次数+借入次数+借出次数+调拔次数+报损次数) as 总次数" s = s + " from 职员信息" Adodc1.RecordSource = s SaveInit Set DataGrid1.DataSource = Adodc1 ';第一次刷新调用initdatagrid1初始化眉头 If SQL = "" Then Adodc1.Refresh initdatagrid1 Else Adodc1.Refresh ResumeInit End If SQL = s If 零次数.Value = 1 Then Adodc1.Recordset.Filter = "总次数<>0" Else Adodc1.Recordset.Filter = 0 End If End Sub Private Sub 零次数_Click() If 零次数.Value = 1 Then Adodc1.Recordset.Filter = "总次数<>0" Else SaveInit Adodc1.Refresh ResumeInit Adodc1.Recordset.Filter = 0 End If End Sub Private Sub 限定仓库_Click() If 限定仓库.Value = 0 Then DataCombo1.Text = "" End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:57 标题: [公告]技术区5.1比赛作品发表专帖

职员信息

Private m_IsAdd As Boolean
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(0).width = 500
DataGrid1.Columns(1).width = 800
DataGrid1.Columns(2).width = 500
DataGrid1.Columns(3).width = 800
DataGrid1.Columns(4).width = 900
DataGrid1.Columns(5).width = 800
DataGrid1.Columns(6).width = 1000
DataGrid1.Columns(7).width = 800
DataGrid1.Columns(8).width = 800

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 DataGrid1_AfterDelete()
';写入系统日志
fMainForm.WriteLog ("删除职员")
End Sub
Private Sub DataGrid1_AfterInsert()
';写入系统日志
fMainForm.WriteLog ("新增职员")
End Sub
Private Sub DataGrid1_AfterUpdate()
';写入系统日志
fMainForm.WriteLog ("更新职员")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)

On Error Resume Next
';判断是否其它表单用了待删除的职员编号
Dim code As String
Dim rs As String
code = DataGrid1.Columns(0).Text

rs = ""
rs = rs + "select 经办人编号 from 入库单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 出库单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 借入单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 借出单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 调拔单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 经办人编号 from 报损单 where 经办人编号=" + Str(code): rs = rs + " union "
rs = rs + "select 保管员编号 from 仓库 where 保管员编号=" + Str(code)
fMainForm.m_checkado.RecordSource = rs
fMainForm.m_checkado.Refresh
If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
      MsgBox "其它表单用了此职员信息,不能删除!", vbExclamation
      Cancel = True
End If

End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)

On Error Resume Next
Dim caption As String
caption = DataGrid1.Columns(ColIndex).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
Adodc1.Visible = False

initdatagrid1
End Sub
Private Sub DataGrid1_OnAddNew()
DataGrid1.Columns(0).Locked = 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

作者: 漫天樱舞 时间: 2005-5-15 21:58 标题: [公告]技术区5.1比赛作品发表专帖

自定义查询管理
Option Explicit

Private Sub Form_Load()
Adodc1.ConnectionString = DataConnectString
Adodc1.Visible = False

End Sub
Private Sub Form_Resize()
Set DataGrid1.DataSource = Adodc1
Adodc1.Refresh
DataGrid1.Columns(1).width = 0

End Sub
Private Sub 删除自定义查询_Click()
Adodc1.Recordset.Delete
DataGrid1.Columns(1).width = 0

';写入系统日志
fMainForm.WriteLog ("删除自定义查询")

End Sub
Private Sub 增加自定义查询_Click()

If 查询名称.Text = "" Then MsgBox "请填写查询名称!": Exit Sub
If SQL.Text = "" Then MsgBox "请填写查询SQL语句!": Exit Sub

On Error Resume Next
If Adodc1.Recordset.RecordCount >= 8 Then
MsgBox "最多只允许8组自定义查询!"
Exit Sub
End If

Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields("查询名称").Value = 查询名称.Text
Adodc1.Recordset.Fields("SQL语句").Value = SQL.Text
Adodc1.Recordset.update
Adodc1.Recordset.Requery
Adodc1.Refresh

DataGrid1.Columns(1).width = 0

';写入系统日志
fMainForm.WriteLog ("新增自定义查询")

End Sub

作者: 漫天樱舞 时间: 2005-5-15 21:59 标题: [公告]技术区5.1比赛作品发表专帖

[这个贴子最后由漫天樱舞在 2005/05/15 10:01pm 第 1 次编辑] 模块 base.bas Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Declare Function BackupData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long Public Declare Function ResumeData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long Public Declare Function GetBit Lib "storage.dll" (ByVal bit As Long, ByVal Index As Integer) As Integer Public Declare Function GetBits Lib "storage.dll" (ByVal bit As String, ByVal l As Integer) As Long Public Declare Function ShowHelp Lib "storage.dll" (ByVal hwnd As Long, ByVal chmname As String, ByVal htmlname As String) As Long Public Declare Function AddWndMsg Lib "storage.dll" (ByVal hwnd As Long, ByVal msg As Long, ByVal procaddress As Long) As Long Public Declare Function ClearPrintData Lib "FxPrint.dll" () As Integer Public Declare Function SetPrintDataWidth Lib "FxPrint.dll" (ByVal width As Integer) As Integer Public Declare Function AddPrintData Lib "FxPrint.dll" (ByVal data As String) As Integer Public Declare Function ShowPrint Lib "FxPrint.dll" (ByVal title As String) As Integer Public Declare Function SaveToFile Lib "FxPrint.dll" () As Integer Public fMainForm As frmmain ';主窗口句柄 Public DataPath As String ';数据库路径 Public DataConnectString As String ';数据库连接源字符串 Public UserName As String ';用户名 Public UserPas As String ';用户密码 Public Purview As Long ';操作权限 Public 权限类别(16) As Integer ';17种权限类别 Public Function ShowPrintDlg(ByVal ado As Adodc, ByVal title As String) ';清除以前的打印数据 ClearPrintData Dim count As Integer On Error GoTo quit: count = ado.Recordset.Fields.count If count <= 0 Then MsgBox "没有需打印的数据", vbInformation Exit Function End If ';设置打印列宽度 SetPrintDataWidth count ';保存当前位置的状态pos Dim pos As Long pos = ado.Recordset.AbsolutePosition ';移到记录最前面 ado.Recordset.MoveFirst Dim i As Integer ';写入眉头 For i = 0 To count - 1 AddPrintData ado.Recordset.Fields(i).name Next ';写入数据 While ado.Recordset.EOF = False For i = 0 To count - 1 If ado.Recordset.Fields(i).ActualSize > 0 Then AddPrintData ado.Recordset.Fields(i).Value Else AddPrintData "" End If Next ado.Recordset.MoveNext Wend ';恢复以前的记录 ado.Recordset.MoveFirst If pos > 1 Then ado.Recordset.Move pos - 1 ShowPrint title Exit Function quit: MsgBox "没有打印数据或打印数据未初始化!", vbInformation End Function Public Function ShowHelpWnd(Index As Long) If Index = 0 Then ShowHelp fMainForm.hwnd, App.HelpFile, "" Else Dim htmlname As String htmlname = "进销存管理系统.htm/#" Dim v As String v = LTrim(Str(Index)) Dim i As Integer For i = 1 To Len(v) htmlname = htmlname + Mid(v, i, 1) If i <> Len(v) Then htmlname = htmlname + "_" Next ShowHelp fMainForm.hwnd, App.HelpFile, htmlname End If End Function ';屏蔽flash右键弹出菜单 Public Function FlashNoRButton(ByVal hwnd As Long, ByVal msg As Long, ByVal wparam As Long, ByVal lparam As Long) As Long FlashNoRButton = 1 End Function ';删除记录中的所有数据 Public Function DeleteRecordData(Re As Recordset) If Re.RecordCount <= 0 Then Exit Function Re.MoveFirst While Re.EOF = False Re.Delete Re.MoveFirst Wend End Function Sub Main() ';检测是否已运行 If App.PrevInstance Then MsgBox App.title + " 已运行!" End End If ';初始化数据库文件路径 DataPath = App.Path + "\db1.mdb" DataConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DataPath + ";Persist Security Info=False" + ";Jet OLEDB:Database Password=prowind" ';启动起始屏 Frmsplash.Show vbModal ';启动登陆对话框 Dim fLogin As New Frmlogin fLogin.Show vbModal If Not fLogin.OK Then ';登录失败，退出应用程序 End End If Unload fLogin ';启动主窗口 Set fMainForm = New frmmain fMainForm.Show End Sub

作者: 上苍的女子 时间: 2005-5-19 10:44 标题: [公告]技术区5.1比赛作品发表专帖

什么意思啊

作者: 数码鸟 时间: 2005-5-21 13:17 标题: [公告]技术区5.1比赛作品发表专帖

搞什么啊，不是说你们参加后发的文章在这吗好象就一人
上面的MM发的算什么意思啊

作者: chinanic 时间: 2005-5-30 05:44 标题: [公告]技术区5.1比赛作品发表专帖

不是吧VB也行，早知道俺就不回家啦！

作者: xiayu1982 时间: 2005-6-1 09:17 标题: [公告]技术区5.1比赛作品发表专帖

好厉害！可以教教偶吗？

欢迎光临黑色海岸线论坛 (http://bbs.thysea.com/)