一、按类别编号
假定有下图所示的一个表，编号根据类别生成，前两位为类别，后三位为顺序号：
这里假定使用的是外部数据源。
服务端的设计
1、在服务端的全局代码中编写代码：
Public flbhs As New Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码：
用OpenQQ实现网络环境下的编号
我们之前介绍的编号方法，在多用户环境下会出现重复，参考：常用编号生成方法
有了Open，我们可以轻松解决这个问题。
以下例子，在实际测试的时候，如果表中已经有不符合规范的编号，请先删除之，否则会影响编号的生成结果
一、按类别编号
假定有下图所示的一个表，编号根据类别生成，前两位为类别，后三位为顺序号：
这里假定使用的是外部数据源。
服务端的设计
1、在服务端的全局代码中编写代码：
Public flbhs As New Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码：
Dim
dt As
DataTable
Dim
cmd As
New SQLCommand
cmd.ConnectionName
= "数据源名称"
cmd.CommandText
= "Select
类别,
Max(编号)
As 编号
From {产品}
Group By 类别"
dt =
cmd.ExecuteReader
flbhs.Clear()
For
Each dr
As DataRow
In dt.DataRows
Dim qz
As String =
dr("类别")
'编号前缀
Dim bh
As String =
dr("编号")
Dim id
As Integer
If bh.Length
= 5 Then
bh =
bh.SubString(2)
If Integer.TryParse(bh,id)
Then
flbhs.Add(qz,
id)
End If
End
If
Next
上述代码在启动项目后，用SQL语句提取每个类别的最大编号，将其整数部分存储在字典flbhs中。
3、在服务端的OpenQQ服务端事件ReceivedMessage中编写代码：
Dim
msg As
String = e.Message
If
msg.StartsWith(":f")
AndAlso msg.EndsWith("f:")
Then
msg = msg.SubString(2,
msg.Length -
4)
If
flbhs.ContainsKey(msg)
Then '如果存在这个类别的编号
flbhs(msg)
=
flbhs(msg) +
1 '将该类别最大编号加1
Else
flbhs.Add(msg,1)
'如果是这个列表的首次编号,则编号等于1
End
If
e.ReturnValue
= flbhs(msg)
'将编号返回给客户端
End
If
客户端的设计
选择客户端项目对应的表，在其DataColChanged事件中加上代码：
If
e.DataCol.Name
= "类别" Then
If e.DataRow.IsNull("类别")
Then
e.DataRow("编号")
= Nothing
Else
If
QQClient.Ready =
False Then
PopMessage("QQClient未启动,无法生成编号!","提示",PopIconEnum.Infomation,5)
Else
Dim
bh As String
= e.DataRow("类别")
Dim rt
As String =
QQClient.SendWait(":f"
& bh
& "f:")
Dim
id As
Integer
If
rt > "" Then
If
Integer.TryParse(rt,id)
Then
e.DataRow("编号")
= bh &
Format(id,"000")
Else
PopMessage("服务器返回错误信息:"
& rt,"提示",PopIconEnum.Infomation,5)
End If
Else
PopMessage("服务器无响应,无法生成编号!","提示",PopIconEnum.Infomation,5)
End If
End If
End If
End
If
二、按月生成编号
假定有个订单表，需要按月自动生成编号，四位年，两位月，最后三位是顺序号，如下图所示：
这里假定使用的是外部数据源。
服务端的设计
1、在服务端的全局代码中编写代码：
Public flbhs As new Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码：
Dim
dt As
DataTable
Dim
cmd As
New
SQLCommand
cmd.ConnectionName
= "数据源名称"
cmd.CommandText
= "Select Year(日期)
As 年,
Month(日期)
As 月,
Max(编号)
as 编号
From {订单}
Group By Year(日期),
Month(日期)"
dt =
cmd.ExecuteReader
flbhs.Clear()
For
Each dr
As DataRow
In dt.DataRows
Dim qz
As String =
dr("年")
& Format(dr("月"),"00")
'编号前缀,4位年,2位月
Dim bh
As String =
dr("编号")
Dim id
As Integer
If bh.Length
= 10 Then
bh =
bh.SubString(7)
If Integer.TryParse(bh,id)
Then
flbhs.Add(qz,
id)
End If
End
If
Next
上述代码在启动项目后，用SQL语句提取现有数据的每月最大编号，将其整数部分存储在字典flbhs中。
3、在服务端的OpenQQ服务端事件ReceivedMessage中编写代码：
Dim
msg As
String = e.Message
If
msg.StartsWith(":p")
AndAlso msg.EndsWith("p:")
Then
msg = msg.SubString(2,
msg.Length -
4)
If
flbhs.ContainsKey(msg)
Then
'如果存在这个月的编号
flbhs(msg)
= flbhs(msg) +
1
'将该月最大编号加1
Else
flbhs.Add(msg,1)
'如果是这个月的首次编号,则编号等于1
End If
e.ReturnValue
= flbhs(msg) '将编号返回给客户端
End
If
客户端的设计
选择客户端项目的订单表，在其DataColChanged事件中加上代码：
If
e.DataCol.Name
= "日期"
Then
If e.DataRow.IsNull("日期")
Then
e.DataRow("编号")
= Nothing
Else
If
QQClient.Ready =
False Then
PopMessage("QQClient未启动,无法生成编号!","提示",PopIconEnum.Infomation,5)
Else
Dim
bh As String
= Format(e.DataRow("日期"),"yyyyMM")
Dim rt
As String =
QQClient.SendWait(":p"
& bh
& "p:")
Dim id
As Integer
If
rt > "" Then
If
Integer.TryParse(rt,id)
Then
e.DataRow("编号")
= bh &
"-" &
Format(id,"000")
Else
PopMessage("服务器返回错误信息:"
& rt,"提示",PopIconEnum.Infomation,5)
End If
Else
PopMessage("服务器无响应,无法生成编号!","提示",PopIconEnum.Infomation,5)
End If
End If
End
If
End
If
三、按日期和类别编号
假定有个表，需要按月自动生成编号，根据工程代码按顺序编号，前4位是工程代码，然后是4位年，2位月，最后4位是顺序号，如下图所示：
其实如果你看懂了前面的例子，这个例子就是多余的，无非就是在服务器端记录每一个前缀的最大序号，遇到客户端申请编号的时候，将最大序号加1，然后返回给客户端。
编程的是千变万化的，但万变不离其宗，基本原理明白了，就可以举一反三，以不变应万变。
接下来我们看看是不是和第一个例子一样。
服务端的设计
1、在服务端的全局代码中编写代码：
Public flbhs As new Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码：
Dim
dt As
DataTable
Dim
cmd As
New
SQLCommand
cmd.ConnectionName
= "数据源名称"
cmd.CommandText
= "Select
工程代码,Year(制单日期)
As 年,
Month(制单日期)
As 月,
Max(单据编号)
as 单据编号
From {工程}
Group By
工程代码,Year(制单日期),
Month(制单日期)"
dt =
cmd.ExecuteReader
flbhs.Clear()
For
Each dr
As DataRow
In dt.DataRows
Dim qz
As String =
dr("工程代码")
& "-"
& dr("年")
& Format(dr("月"),"00")
'编号前缀,4位工程代码,4位年,2位月
Dim bh
As String =
dr("单据编号")
Dim id
As Integer
If bh.Length
= 16
Then
bh =
bh.SubString(12)
If Integer.TryParse(bh,id)
Then
flbhs.Add(qz,
id)
End If
End
If
Next
上述代码除了表名、列名的变化，以及给编号前缀加上工程代码外，真正发生变化的就是两个数字，你可以想想为什么一个由10改为16，一个由7改为12?
3、在服务端的OpenQQ服务端事件ReceivedMessage中编写代码：
Dim
msg As
String = e.Message
If
msg.StartsWith(":g")
AndAlso msg.EndsWith("g:")
Then
msg = msg.SubString(2,
msg.Length -
4)
If
flbhs.ContainsKey(msg)
Then
'如果存在这个月的编号
flbhs(msg)
= flbhs(msg) +
1
'将该月最大编号加1
Else
flbhs.Add(msg,1)
'如果这个月的首次编号,则编号等于1
End
If
e.ReturnValue
= flbhs(msg)
End
If
上述代码没有任何改变。
客户端的设计
选择客户端项目的对应的表，在其DataColChanged事件中加上代码：
Select
e.DataCol.Name
Case
"制单日期","工程代码"
If e.DataRow.IsNull("制单日期")
OrElse e.DataRow.IsNull("工程代码")
Then
e.DataRow("单据编号")
= Nothing
Else
If
QQClient.Ready =
False Then
PopMessage("QQClient未启动,无法生成编号!","提示",PopIconEnum.Infomation,5)
Else
Dim
bh As
String = e.DataRow("工程代码")
& "-"
& Format(e.DataRow("制单日期"),"yyyyMM")
Dim rt
As String =
QQClient.SendWait(":g"
& bh
& "g:")
Dim
id As
Integer
If
rt > ""
Then
If
Integer.TryParse(rt,id)
Then
e.DataRow("单据编号")
= bh &
"-" &
Format(id,"0000")
Else
PopMessage("服务器返回错误信息:"
& rt,"提示",PopIconEnum.Infomation,5)
End
If
Else
PopMessage("服务器无响应,无法生成编号!","提示",PopIconEnum.Infomation,5)
End If
End
If
End
If
End
Select
上述代码除了表名、列名的变化，以及给编号前缀加上工程代码外，唯一发生变化的只是将：
Format(id,"000")
改成了
Format(id,"0000")
因为顺序号原来是3位，现在是4位。