📄 系统_通用编码参照.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form XT_TybmczFrm
BorderStyle = 3 'Fixed Dialog
Caption = "通用编码参照表"
ClientHeight = 6000
ClientLeft = 45
ClientTop = 330
ClientWidth = 6435
Icon = "系统_通用编码参照.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6000
ScaleWidth = 6435
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CheckBox Chk_Blur
Caption = "模糊定位"
Height = 255
Left = 5340
TabIndex = 8
Top = 180
Width = 1035
End
Begin VB.Timer Timer1
Interval = 1
Left = 120
Top = 90
End
Begin MSFlexGridLib.MSFlexGrid CzxsGrid
Height = 4905
Left = 60
TabIndex = 0
Top = 540
Width = 6315
_ExtentX = 11139
_ExtentY = 8652
_Version = 393216
FocusRect = 0
End
Begin VB.CommandButton Gridsz
Caption = "恢复默认格式"
Height = 300
Index = 1
Left = 1410
TabIndex = 7
Top = 5580
Width = 1335
End
Begin VB.CommandButton Gridsz
Caption = "保存表格格式"
Height = 300
Index = 0
Left = 30
TabIndex = 6
Top = 5580
Width = 1335
End
Begin VB.TextBox CodeText
Height = 300
Left = 1080
TabIndex = 1
Top = 150
Width = 4035
End
Begin VB.CommandButton Bjcommand
Caption = "编辑(&E)"
Height = 300
Left = 5250
TabIndex = 4
Top = 5580
Width = 1120
End
Begin VB.CommandButton QxCommand
Cancel = -1 'True
Caption = "取消(&C)"
Height = 300
Left = 4110
TabIndex = 3
Top = 5580
Width = 1120
End
Begin VB.CommandButton QdCommand
Caption = "确定(&O)"
Default = -1 'True
Height = 300
Left = 2970
TabIndex = 2
Top = 5580
Width = 1120
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "编码或名称:"
Height = 180
Index = 0
Left = 90
TabIndex = 5
Top = 210
Width = 990
End
End
Attribute VB_Name = "XT_TybmczFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'* 模 块 名 称 :打印基本模块
'* 功 能 描 述 :
'* 程序员姓名 : 张建忠
'* 最后修改人 : 张建忠
'* 最后修改时间: 2001/11/13
'* 备 注:
'* Xtcdcs 用来传递用户输入内容; xtbmczdm 用来传递所选编码参照
'* xtfhcs 用来返回用户所选编码; xtfhcsfz 用来返回用户所选名称;
'******************************************************************
Dim Cznr As String '网格首次进入查找内容
Dim Bmzdsyh As String '编码字段索引号
Dim Mczdsyh As String '名称字段索引号
Dim Sqlstr As String '查询语句
Dim Bmczdmte As String '所选编码参照代码
'以下为固定使用变量
Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
Dim GridCode As String '显示网格网格代码
Dim GridInf() As Variant '整个网格设置信息
Dim Tsxx As String '系统提示信息
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim GridBoolean() As Boolean '网格列信息(布尔型)
Dim GridStr() As String '网格列信息(字符型)
Dim GridInt() As Integer '网格列信息(整型)
Dim Szzls As Integer '数组总列数(网格列数-1)
Private Sub CodeText_Change() '用户可模糊定位编码或名称信息
Dim DwRow As Long
Dim Lng_BmCol As Long
Dim Lng_McCol As Long
On Error Resume Next
Lng_BmCol = Sydz(Bmzdsyh, GridStr(), Szzls)
Lng_McCol = Sydz(Mczdsyh, GridStr(), Szzls)
Cznr = Trim(CodeText.Text)
With CzxsGrid
'按编码定位(按前几位精确匹配定位)
For DwRow = .FixedRows To .Rows - 1
If Mid(.TextMatrix(DwRow, Lng_BmCol), 1, Len(Cznr)) = Cznr Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
Next DwRow
'按名称定位(支持按前几位精确匹配定位和模糊匹配定位两种)
For DwRow = .FixedRows To .Rows - 1
If Chk_Blur.Value = 0 Then
If Mid(.TextMatrix(DwRow, Lng_McCol), 1, Len(Cznr)) = Cznr Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
Else
If InStr(1, .TextMatrix(DwRow, Lng_McCol), Cznr) <> 0 Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
End If
Next DwRow
'按拼音码定位(支持按前几位精确匹配定位和模糊匹配定位两种)
For DwRow = .FixedRows To .Rows - 1
If Chk_Blur.Value = 0 Then
If Mid(GetPY(.TextMatrix(DwRow, Lng_McCol)), 1, Len(Cznr)) = UCase(Cznr) Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
Else
If InStr(1, GetPY(.TextMatrix(DwRow, Lng_McCol)), UCase(Cznr)) <> 0 Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
End If
Next DwRow
End With
End Sub
Private Sub CzxsGrid_GotFocus()
SendKeys "{LEFT}", True
End Sub
Private Sub Form_Load()
' On Error GoTo Cwcl
'接收通用参照编码
Bmczdmte = Xtbmczdm
Xtbmczdm = ""
'读入编码参照数据
Call Drbmczsx
'调 入 网 格
Call Sub_ShowGrid(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Szzls = CzxsGrid.Cols - 1
Bmzd = GridStr(Sydz(Bmzdsyh, GridStr(), Szzls), 4)
Mczd = GridStr(Sydz(Mczdsyh, GridStr(), Szzls), 4)
'填 充 网 格
CzxsGrid.Redraw = False '为了加快显示速度
Call bmtcwg
CzxsGrid.Redraw = True
Exit Sub
Cwcl:
Tsxx = "此字段编码参照调入时出现错误!"
Call Xtxxts(Tsxx, 0, 4)
Unload Me
Exit Sub
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
'填充定位文本框,同时定位
CodeText.Text = Trim(Xtcdcs)
'首次让帮助网格得到焦点
CzxsGrid.SetFocus
End Sub
Private Sub bmtcwg() '查询内容填充网格,并模糊定位用户录入信息
Dim Coljsq As Long
Sqlstr = Replace(Sqlstr, "@", "'" & Trim(Xtcdcs) & "%'")
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With Cxnrrec
If .EOF And .BOF Then
Exit Sub
Else
.MoveLast
CzxsGrid.Rows = CzxsGrid.FixedRows
CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
.MoveFirst
End If
jsqte = CzxsGrid.FixedRows
Do While Not .EOF
If jsqte >= CzxsGrid.Rows Then
CzxsGrid.AddItem ""
End If
For Coljsq = Qslz To CzxsGrid.Cols - 1
If GridBoolean(Coljsq, 6) Then
If .Fields(GridStr(Coljsq, 4)) Then
CzxsGrid.TextMatrix(jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = True
End If
Else
CzxsGrid.TextMatrix(jsqte, Sydz(GridStr(Coljsq, 1), GridStr(), Szzls)) = Trim(.Fields(GridStr(Coljsq, 4)) & "")
End If
Next Coljsq
CzxsGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
End Sub
Private Sub CzxsGrid_Click() '单击网格固定行某列按此列排序(字符型)
With CzxsGrid
If .MouseRow <= .FixedRows - 1 Then
.Col = .MouseCol
.Sort = flexSortStringAscending
End If
End With
End Sub
Private Sub CzxsGrid_DblClick() '用户双击网格返回当前选中编码
Call Fhxzbm
End Sub
Private Sub Form_Unload(Cancel As Integer) '退出
Set Cxnrrec = Nothing
End Sub
Private Sub Gridsz_Click(Index As Integer)
Select Case Index
Case 0 '保存表格格式
Call Bcwggs1(CzxsGrid, GridCode)
Case 1 '恢复默认格式
Call Hfmrgs1(CzxsGrid, GridCode)
End Select
End Sub
Private Sub QdCommand_Click() '确 定
Call Fhxzbm
End Sub
Private Sub QxCommand_Click() '取 消
Xtfhcs = ""
Xtfhcsfz = ""
Unload Me
End Sub
Private Sub Bjcommand_Click() '调入编码编辑窗体
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -