这个问题好大!!!

dullbenben 2001-09-18 09:08:46
后台数据库我已经通过主窗体连接,没有问题,就是记录不显示在窗体上,这是怎么一回事??????


Option Explicit

Const Row_Num = 50 '方格总列数
Const Col_Num = 7 '方格总行数
Const High = 350 '方格高度

Const GridCol_0 = 0 '存储格第0行
Const GridCol_1 = 1 '存储格第1行
Const GridCol_2 = 2 '存储格第2行
Const GridCol_3 = 3 '存储格第3行
Const GridCol_4 = 4 '存储格第4行
Const GridCol_5 = 5 '存储格第5行
Const GridCol_6 = 6 '存储格第6行


Dim grid(Row_Num - 1, Col_Num) '对应MSFlexgrid方格的阵列
Dim AddRecord, ModifyRecord As Boolean '新增状态标志
Dim Position As Variant '记录
Dim modify(Row_Num - 1) As Integer '记录那些资料列被修改过

Dim Row_Top, Row_Down As Integer '记录光标选取的起始列和
Dim MouseMove As Boolean '记录光标使用的情况

Private Sub Command1_Click() '搜寻钮
Dim s As String

On Error GoTo CommandError '输入产品编号

s = InputBox("请输入产品编号", "搜寻产品编号", "1")

If s <> "" Then '输入产品编号不为空白?
s = "prd_no=" & "'" & s & "'" '搜寻字符串
rs1.MoveFirst
rs1.Find (s) '搜寻记录

If Not rs1.EOF Then '找到
'将目前记录移至MSFlexGrid在画面上的第一列方格
MSFlexGrid1.TopRow = rs1.AbsolutePosition
Else '找不到
MsgBox "目前没有该项产品编号", vbOKOnly + vbExclamation, ""
End If
End If

Exit Sub

CommandError:
MsgBox Err.Description

End Sub

Private Sub Command2_Click() '新增钮
On Error GoTo CommandError

AddRecord = True '改变窗体为新增状态
SaveCancel '储存&取消按钮模式

Position = MSFlexGrid1.TopRow '记录目前记录显示画面的第一列位置
MSFlexGrid1.TopRow = rs1.RecordCount + 1 '将空白一列移至最上方
MSFlexGrid1.Col = 1 '设定作用保存格在第一行
MSFlexGrid1.Row = MSFlexGrid1.TopRow '设定作用保存格在显示画面的第一列位置
NextPosition MSFlexGrid1.Row, MSFlexGrid1.Col '移动文本框

Exit Sub

CommandError:
MsgBox Err.Description

End Sub

Private Sub Command3_Click() '修改钮
Dim i As Integer

On Error GoTo CommandError
'初始化资料列被修改的阵列
For i = 1 To rs1.RecordCount
modify(i) = 0
Next

ModifyRecord = True '改变表单为修改状态
SaveCancel '储存&取消按钮模式

Exit Sub

CommandError:
MsgBox Err.Description

End Sub

Private Sub Command4_Click() '删除钮
Dim DelRecord, i, tmp As Integer
Dim sql As String

On Error GoTo CommandError

DelRecord = MsgBox("确定删除这批记录吗?", vbQuestion + vbYesNo, "删除记录")

If DelRecord = vbYes Then '判断操作者是否按下“是”钮
On Error GoTo DelError '若选取grid时,由下往上选取时,Row_Top与Row_Down需交换
If Row_Top > Row_Down Then
tmp = Row_Top
Row_Top = Row_Down
Row_Down = tmp
End If

cn.BeginTrans '变动开始
For i = Row_Top To Row_Down '对选取的数据列,由上而下
If grid(i, GridCol_0) <> "" Then '选取的数据列是否为空白

Read_Io_Detail i
If rs2![RecCount] > 0 Then
MsgBox "目前出货单尚有第" & i & " 列的产品数据,因此该列数据暂不接受删除的动作", vbOKOnly + vbCritical, "删除警告信息"
Else
sql = "DELETE FROM product WHERE prd_no=" & "'" & grid(i, GridCol_0) & "'"
cn.Execute sql
End If
End If
Next
cn.CommitTrans '变动结束

On Error GoTo CommandError

rs1.Requery '重新排序
If rs1.RecordCount > 0 Then
rs1.MoveFirst '移动记录指针至第一笔
End If

DisplayRecord '显示记录数据内容
Initial_Button

rs2.Close '关闭Recordset
Set rs2 = Nothing '将rs2控件变量从实际的Recordset控件里分里开来
End If


Exit Sub

CommandError:
MsgBox Err.Description

Exit Sub

DelError:
cn.RollbackTrans '恢复变动
MsgBox Err.Description
End Sub

Private Sub Command5_Click() '保存钮
Dim i As Integer

On Error GoTo SaveError

Text1.Visible = False '消除文本框显示

If AddRecord = True Then '是否在新增状态

On Error GoTo SaveAdd_ModifyError

For i = rs1.RecordCount + 1 To Row_Num - 1 '将新增加、部分写入数据库
'每一列的第1行是否为空白
If grid(i, GridCol_1) <> "" Then

cn.BeginTrans '变动开始
rs1.AddNew '增加一笔空白记录
WriteRecord i '将窗体显示登录至记录上
rs1.Update '将记录写入数据库

cn.CommitTrans '变动结束

End If
Next

rs1.Requery '重新排序
DisplayRecord '重新显示
AddRecord = False '目前窗体不在新增状态
ElseIf ModifyRecord = True Then '是否在修改状态
On Error GoTo SaveAdd_ModifyError

rs1.MoveFirst '先移至第一笔记录

For i = 1 To rs1.RecordCount '将修改部分写入数据库
'确认那一列被更改过,且第1行不为空白,才需修改
If modify(i) = 1 And grid(i, GridCol_1) <> "" Then

cn.BeginTrans '变动开始
WriteRecord i '将窗体显示登录至记录上
rs1.Update '将记录写入数据库
cn.CommitTrans '变动结束

End If

rs1.MoveNext '换至下一笔记录
Next

ModifyRecord = False '改变目前窗体为原始状态

End If

Initial_Button '按钮原始模式

Exit Sub

SaveError:
MsgBox Err.Description

Exit Sub

SaveAdd_ModifyError:
cn.RollbackTrans
MsgBox Err.Description
End Sub

Private Sub Command6_Click() '取消钮
On Error GoTo CommandError

Text1.Visible = False '消除文本框Text1显示

If rs1.RecordCount > 0 Then '数据记是否有记录?
rs1.MoveFirst '移至第一笔记录
DisplayRecord '显示记录数据内容
Else '没有记录
MSFlexGrid1.Clear '清除grid的显示内容
Setgrid_Head '设定表格表头
ClearDisplay '清除相对应的grid数组内容
End If

If AddRecord = True Then '是否为新增状态
MSFlexGrid1.TopRow = Position '恢复原始画面
End If

AddRecord = False '改变目前窗体为原始状态
ModifyRecord = False '改变目前表单为原始状态

Initial_Button '按钮原始模式

Exit Sub

CommandError:
MsgBox Err.Description

End Sub

Private Sub Command7_Click() '结束钮
On Error GoTo CommandError

rs1.Close '关闭Recordset
Set rs1 = Nothing '将rs1控件变量从实际的Recordset控件里分离开来

MainForm.Enabled = True '待命主窗体(MainForm)
Unload Form2 '关闭产品基本数据窗体

Exit Sub

CommandError:
MsgBox Err.Description

End Sub

Private Sub Form_Load() '窗体载入
Dim sql As String

On Error GoTo LoadError '读取产品数据表Record数据

Read_Recordset '读取RecordSet

Setgrid '设定列表格式
Setgrid_Head '设定列表表头
'是否有记录数据
If rs1.RecordCount > 0 Then
DisplayRecord '显示记录数据内容
Else
MsgBox "目前没有任何产品数据", vbExclamation + vbOKOnly, ""
ClearDisplay '清除画面显示
End If

AddRecord = False '目前表单不在新增状态
ModifyRecord = False '目前表单不在修改状态

Initial_Button '按钮原始模式

Exit Sub

LoadError:
MsgBox Err.Description
End Sub

Public Sub Read_Recordset() '读取记录
Set rs1 = New Recordset
rs1.CursorLocation = adUseClient '数据指针在Client端
'使用SQL语法,打开产品基本数据
rs1.Open "SELECT * FROM product ORDER BY prd_no", cn, adOpenDynamic, adLockOptimistic, adCmdText
End Sub

Public Sub Setgrid() '设定列表格式
Dim i As Integer

On Error GoTo SetError

MSFlexGrid1.ScrollBars = 3 '有垂直,水平滚动条
MSFlexGrid1.Rows = Row_Num '方格总列数
MSFlexGrid1.Cols = Col_Num '方格总列数
For i = 0 To Row_Num - 1
MSFlexGrid1.RowHeight(i) = High '方格总高度
Next
MSFlexGrid1.ColWidth(0) = 1500 '第0行行宽
MSFlexGrid1.ColWidth(1) = 2000 '第1行行宽
MSFlexGrid1.ColWidth(2) = 800 '第2行行宽
MSFlexGrid1.ColWidth(3) = 1500 '第3行行宽
MSFlexGrid1.ColWidth(4) = 1500 '第4行行宽
MSFlexGrid1.ColWidth(5) = 1500 '第5行行宽
MSFlexGrid1.ColWidth(6) = 1500 '第6行行宽

Exit Sub

SetError:
MsgBox Err.Description
End Sub

Public Sub Setgrid_Head() '设定表格表头
On Error GoTo SetError

MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "产品编号"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "产品名称"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "单位"
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "产品进价"
MSFlexGrid1.Col = 4
MSFlexGrid1.Text = "产品售价"
MSFlexGrid1.Col = 5
MSFlexGrid1.Text = "初期存量"
MSFlexGrid1.Col = 6
MSFlexGrid1.Text = "目前存量"

Exit Sub

SetError:
MsgBox Err.Description
End Sub


Public Sub ClearDisplay() '清除相对grid内容的数组
Dim i, j As Integer

For i = 1 To Row_Num - 1
For j = 0 To Col_Num - 1
grid(i, j) = "" 'gird内容清除为空白
Next
Next
End Sub

Public Sub DisplayRecord() '显示记录数据内容
Dim Gridrow, i As Integer

On Error GoTo DisplayError

ClearDisplay '清除相对grid表格的数组内容

MSFlexGrid1.Clear '清除grid的显示内容
Setgrid_Head 'grid的标题设定

Gridrow = 0 '表格列数指针设定为零

Do Until rs1.EOF '是否至数据表尾端
Gridrow = Gridrow + 1
MSFlexGrid1.Row = Gridrow '设定目前保存格列数

For i = 0 To Col_Num - 1
MSFlexGrid1.Col = i '设定目前保存格列数
'读取目前数据记录至目前保存格
If Not IsNull(rs1.Fields(i)) Then MSFlexGrid1.Text = rs1.Fields(i) Else
MSFlexGrid1.Text = ""
grid(Gridrow, i) = rs1.Fields(i) '读取目前数据表记录至对应的数组

Next
rs1.MoveNext '移动数据表记录指针至下一笔记录

Loop

Exit Sub

DisplayError:
MsgBox Err.Description

End Sub

Public Sub WriteRecord(r As Integer) '写数据至Buffer
Dim i As Integer

MSFlexGrid1.Row = r '换至第r行

For i = GridCol_1 To GridCol_6 '从第1行至第6行
MSFlexGrid1.Col = i '移动至第i行
'将第行的保存格数据输入至记录
If (i >= GridCol_3 And i <= GridCol_6) Then
If MSFlexGrid1.Text = "" Then rs1.Fields(i) = Null Else
rs1.Fields(i) = Val(MSFlexGrid1.Text)
Else

If MSFlexGrid1.Text = "" Then rs1.Fields(i) = Null Else
rs1.Fields(i) = MSFlexGrid1.Text

End If
Next
End Sub

Private Sub MSFlexGrid1_Click() '点选MSFlexGrid的储存格
On Error GoTo GridError
'新增功能下,不准许click旧数据
If AddRecord = True And MSFlexGrid1.Row <= rs1.RecordCount Then
Beep '警告声及信息
MsgBox "新增功能下,不准许选取旧数据", vbOKOnly + vbExclamation, ""
Text1.Visible = False '消除Text1显示
'修改功能下,不准许click新空白列
ElseIf ModifyRecord = True And MSFlexGrid1.Row > rs1.RecordCount Then
Beep
MsgBox "修改功能下,不准许选取新数据", vbOKOnly + vbExclamation, ""
Text1.Visible = False '消除Text1显示
'显示文本框Text1
ElseIf AddRecord = True Or ModifyRecord = True Then
NextPosition MSFlexGrid1.Row, MSFlexGrid1.Col '移动文本框Text1
End If

Exit Sub

GridError:
MsgBox Err.Description

End Sub

Private Sub Text1_Change() '将文字方块内容写至对应储存格
On Error GoTo TextError

'将文字方块内容写至对应储存格和阵列里
MSFlexGrid1.Text = Text1.Text
grid(MSFlexGrid1.Row, MSFlexGrid1.Col) = Text1.Text

If ModifyRecord = True Then '记录那一列记录被修改过
modify(MSFlexGrid1.Row) = 1
End If

Exit Sub

TextError:
MsgBox Err.Description

End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseMove = False '设定鼠标使用情况的初始值
End Sub

Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseMove = True '代表使用者使用鼠标选取了数据列
End Sub

Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MouseMove = True Then
Row_Top = MSFlexGrid1.Row '记录选取范围的左上角列数
Row_Down = MSFlexGrid1.RowSel '记录选取范围的右下角列数
Else '没有移动鼠标选取
Row_Top = 0
Row_Down = 0
End If

End Sub

Public Sub Initial_Button() '原始按键
On Error GoTo InitialError

If rs1.RecordCount > 0 Then

Command1.Enabled = True '搜寻
Command2.Enabled = True '新增
Command3.Enabled = True '修改
Command4.Enabled = True '删除
Command5.Enabled = False '保存
Command6.Enabled = False '取消
Command7.Enabled = True '结束
Else
Command1.Enabled = False '搜寻
Command2.Enabled = True '新增
Command3.Enabled = False '修改
Command4.Enabled = False '删除
Command5.Enabled = False '保存
Command6.Enabled = False '取消
Command7.Enabled = True '结束
End If

Exit Sub
InitialError:
MsgBox Err.Description

End Sub

Public Sub SaveCancel() '保存&取消按钮
Dim i As Integer

On Error GoTo SaveDelError

Command1.Enabled = False '搜寻
Command2.Enabled = False '新增
Command3.Enabled = False '修改
Command4.Enabled = False '删除
Command5.Enabled = True '保存
Command6.Enabled = True '取消
Command7.Enabled = False '结束

Exit Sub

SaveDelError:
MsgBox Err.Description
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer) '按下Enter键的动作
On Error GoTo TextError

If KeyAscii = vbKeyReturn Then '在按下Enter时,决定下个grid的位置
If MSFlexGrid1.Col = GridCol_6 Then '是否未至最后一列?
If (AddRecord = True And MSFlexGrid1.Row < Row_Num - 1) Or (ModifyRecord = True And MSFlexGrid1.Row < rs1.RecordCount) Then
MSFlexGrid1.Row = MSFlexGrid1.Row + 1 '换下一列
MSFlexGrid1.Col = GridCol_1 '换第1行
Else '已超过最后一列
If AddRecord = True And MSFlexGrid1.Row = Row_Num - 1 Then
MSFlexGrid1.TopRow = rs1.RecordCount + 1 '回新增的第一列
ElseIf ModifyRecord = True And MSFlexGrid1.Row = rs1.RecordCount Then
MSFlexGrid1.TopRow = 1 '回修改的第一列
End If
'以目前MSFlexGrid的最上一列为列位置
MSFlexGrid1.Row = MSFlexGrid1.TopRow
MSFlexGrid1.Col = GridCol_1 '换第1行
End If
Else '换下一行
MSFlexGrid1.Col = MSFlexGrid1.Col + 1
End If
KeyAscii = 0
NextPosition MSFlexGrid1.Row, MSFlexGrid1.Col '换下个方格位置
End If

Exit Sub

TextError:
MsgBox Err.Description
End Sub

Private Sub MSFlexGrid1_Scroll() '操作者滚动垂直滚动条
Text1.Visible = False '消除Text1显示
End Sub

Public Sub NextPosition(ByVal r As Integer, ByVal c As Integer) '移动文本框
On Error GoTo NextError

Text1.Width = MSFlexGrid1.CellWidth '宽度
Text1.Height = MSFlexGrid1.CellHeight '高度
Text1.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(c) '左侧
Text1.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(r) '上方
Text1.Text = MSFlexGrid1.Text '将MSFlexGrid目前作用保存格内容放置于文本框
Text1.Visible = True '将文本框显示于画面上
Text1.SetFocus '将光标移至文本框上

Exit Sub

NextError:
MsgBox Err.Description
End Sub

Public Sub Read_Io_Detail(ByVal r As Integer) '读取出货表明细
Dim sql As String

sql = "SELECT Count(io_del_detail.csh_no) As RecCount"
sql = sql & "FROM (io_del_detail INNER JOIN io_del ON io_del_detail.csh_no=io_del.csh_no) INNER JOIN product ON product.prd_no=io_del_detail.prd_no"
sql = sql & "WHERE io_del_detail.prd_no=" & "'" & grid(r, GridCol_0) & "'"

Set rs2 = New Recordset
rs2.CursorLocation = adUseClient '使用Client Cursor启动AbsolutrPosition属性
rs2.Open sql, cn, adOpenStatic, adLockOptimistic, adCmdText

End Sub




...全文
91 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
starbattler 2001-09-18
  • 打赏
  • 举报
回复
多试试!
路是人走平的,问题是人试出来的
yopeng 2001-09-18
  • 打赏
  • 举报
回复
gz
dullbenben 2001-09-18
  • 打赏
  • 举报
回复
rs1已经定义在模块中,你说的另一个问题我要回去试一试,谢了。
newyon 2001-09-18
  • 打赏
  • 举报
回复
Public Sub Read_Recordset() '读取记录
Set rs1 = New Recordset
rs1.CursorLocation = adUseClient '数据指针在Client端
'使用SQL语法,打开产品基本数据
rs1.Open "SELECT * FROM product ORDER BY prd_no", cn, adOpenDynamic, adLockOptimistic, adCmdText
End Sub

rs1在什么地方定义的呢!在上面的程序中好像没有定义啊!
你设断点看一下,rs1到底有没有取回记录集!

还有在DisplayRecord中
为何在If Not IsNull(rs1.Fields(i)) Then MSFlexGrid1.Text = rs1.Fields(i) Else
下一行有这个语句 MSFlexGrid1.Text = ""

有可能就是这句的问题!
建议改成:
If Not IsNull(rs1.Fields(i)) Then
MSFlexGrid1.Text = rs1.Fields(i)
Else
MSFlexGrid1.Text = ""
endif
dullbenben 2001-09-18
  • 打赏
  • 举报
回复
我也不能勉强你。
guest 2001-09-18
  • 打赏
  • 举报
回复
太长了,不想看~~

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧