VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form Cask_CaskTag 
   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 = "Cask_CaskTag"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'*    模 塊 名 稱 :打印基本模塊
'*    功 能 描 述 :
'*    程序員姓名  : 張建忠
'*    最后修改人  : 鄒力
'*    最后修改時間: 2001/12/18
'*    備        注:
'*    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(XtCaskInf) & "'")
    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()                          '調入編碼編輯窗體