?? 系統_通用編碼參照.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 + -