frmfind.frm

一个把自己的东西刻成光盘后自动查询和启动的原代码

      Begin VB.Menu m_Operate_Do 
         Caption         =   "清除全部"
         Index           =   6
      End
   End
   Begin VB.Menu m_Type_Code 
      Caption         =   "档案类型(&T)  "
      Begin VB.Menu m_Type_Code_Do 
         Caption         =   "类型1"
         Index           =   0
      End
   End
   Begin VB.Menu m_Query_Type 
      Caption         =   "查询类型(&Q)  "
      Begin VB.Menu m_Query_Type_Do 
         Caption         =   "文件"
         Checked         =   -1  'True
         Index           =   0
         Shortcut        =   ^F
      End
      Begin VB.Menu m_Query_Type_Do 
         Caption         =   "案卷"
         Index           =   1
         Shortcut        =   ^V
      End
      Begin VB.Menu m_Query_Type_Do 
         Caption         =   "盒"
         Index           =   2
         Shortcut        =   ^B
      End
   End
   Begin VB.Menu mnu_SDI 
      Caption         =   "档案编研(&S)  "
      Visible         =   0   'False
      Begin VB.Menu mnu_SDI_Do 
         Caption         =   "档案备份"
      End
   End
   Begin VB.Menu m_Exit 
      Caption         =   "系统退出(&X)  "
   End
End
Attribute VB_Name = "FrmFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'该窗口需要getvalue全局函数
'该窗口需要frmvolumereg,frmfilereg窗口，也可不要(无法浏览信息)

Public gWidthRate As Single '宽度比例
Public gHeightRate As Single '高度比例
Const gBorderWidth = 80 '控件间距
Const sglSplitLimit = 500
Public VDragFlag As Boolean '垂直拖动标志
Public HDragFlag As Boolean '水平拖动标志
Dim gTypeCode() As String  '全局档案类型数组，对应cbxtypecode中的选项
Dim gQueryField() As String '全局查询字段3维数组，1维对应CbxFieldName中的选项2维对应数据类型3维对应该字段的数据字典

Private Sub CbxFieldName_Change()
On Error GoTo Err
Dim tIndex As Integer

If CbxFieldName.ListCount < 1 Then Exit Sub
tIndex = CbxFieldName.ListIndex + 1

'设置操作符

'有数据字典
If gQueryField(tIndex, 3) <> "0" Then
   
   TxtValue.Visible = False
   CbxFieldValue.Visible = True
   MaskRQ.Visible = False
   
   If CbxCon.ListCount > 0 Then CbxCon.ListIndex = 0 '等于
   
   Set gRst = gDbs.OpenRecordset("select * from system_dict where type=" + gQueryField(tIndex, 3) + " order by code")
   CbxFieldValue.Clear
   While Not gRst.EOF
       CbxFieldValue.AddItem Trim(gRst.Fields("name"))
       CbxFieldValue.ItemData(gRst.AbsolutePosition) = CLng(gRst.Fields("code"))
       gRst.MoveNext
   Wend
   If CbxFieldValue.ListCount >= 1 Then CbxFieldValue.ListIndex = 0
   
   Exit Sub
End If

Select Case gQueryField(tIndex, 2) '字段类型
   Case 1
        TxtValue.Visible = False
        CbxFieldValue.Visible = False
        MaskRQ.Visible = True
        MaskRQ.Text = "????年??月??日"
   Case 2, 3, 4
        TxtValue.Visible = True
        CbxFieldValue.Visible = False
        MaskRQ.Visible = False
        TxtValue.Text = ""
End Select

Err:
End Sub

Private Sub CbxFieldName_Click()
Call CbxFieldName_Change
End Sub

Private Sub CbxObject_Change()
Call CbxTypeCode_Change
End Sub

Private Sub CbxObject_Click()
Call CbxTypeCode_Change
End Sub

Private Sub CbxTypeCode_Change()
On Error GoTo Err
Dim i As Integer

Me.MousePointer = 11

Call AddViewField(gTypeCode(CbxTypeCode.ListIndex + 1), CbxObject.ListIndex)
Call AddQueryField(gTypeCode(CbxTypeCode.ListIndex + 1), CbxObject.ListIndex)
LVResult.ColumnHeaders.Clear
LVCondition.ListItems.Clear
LVSQL.ListItems.Clear
LVResult.ListItems.Clear
OptAndOr(0).Value = False
OptAndOr(1).Value = False

For i = 0 To m_Type_Code_Do.Count - 1
   If i = CbxTypeCode.ListIndex Then
      m_Type_Code_Do(i).Checked = True
   Else
      m_Type_Code_Do(i).Checked = False
   End If
Next i

For i = 0 To m_Query_Type_Do.Count - 1
   If i = CbxObject.ListIndex Then
      m_Query_Type_Do(i).Checked = True
   Else
      m_Query_Type_Do(i).Checked = False
   End If
Next i
Me.MousePointer = 0
Exit Sub
Err:
Me.MousePointer = 0
End Sub

Private Sub CbxTypeCode_Click()
Call CbxTypeCode_Change
End Sub

Private Sub CheckFile_Click()
Dim i As Long
If CheckFile.Value = 1 Then
   LVResult.Checkboxes = True
Else
   LVResult.Checkboxes = False
   For i = 1 To LVResult.ListItems.Count
       LVResult.ListItems(i).Checked = False
   Next i
End If
LVResult.Refresh
DoEvents
End Sub

Private Sub CmdAdd_Click()
On Error GoTo Err
Dim tLCItem As ListItem 'LVCondition
Dim tLSItem As ListItem 'LVSQL

If LVCondition.SelectedItem Is Nothing Then   '在末尾添加
   Set tLCItem = LVCondition.ListItems.Add(, "K" + Format(LVCondition.ListItems.Count + 1, "0000"), "")
   Set tLSItem = LVSQL.ListItems.Add(, "K" + Format(LVCondition.ListItems.Count + 1, "0000"), "")
Else '在指定行后添加
   Set tLCItem = LVCondition.ListItems.Add(LVCondition.SelectedItem.Index, "K" + Format(LVCondition.ListItems.Count + 1, "0000"), "")
   Set tLSItem = LVSQL.ListItems.Add(LVCondition.SelectedItem.Index, "K" + Format(LVCondition.ListItems.Count + 1, "0000"), "")
End If

'条件
If OptAndOr(0).Value = True Then
   tLCItem.SubItems(1) = "并且"
   tLSItem.SubItems(1) = "and"
ElseIf OptAndOr(1).Value = True Then
   tLCItem.SubItems(1) = "或者"
   tLSItem.SubItems(1) = "or"
End If

'字段名
tLSItem.SubItems(2) = gQueryField(CbxFieldName.ListIndex + 1, 1)
tLCItem.SubItems(2) = CbxFieldName.Text
If gQueryField(CbxFieldName.ListIndex + 1, 2) = 1 Then '日期
   tLSItem.SubItems(2) = gQueryField(CbxFieldName.ListIndex + 1, 1)
ElseIf CbxCon.Text = "包含" Then
   tLSItem.SubItems(2) = "find(" + gQueryField(CbxFieldName.ListIndex + 1, 1) + ",'" + TxtValue.Text + "')"
Else
   tLSItem.SubItems(2) = gQueryField(CbxFieldName.ListIndex + 1, 1)
End If


'操作符
tLCItem.SubItems(3) = CbxCon.Text
If CbxCon.Text = "包含" Then
   tLSItem.SubItems(3) = ">"
ElseIf CbxCon.Text = "不包含" Then
   tLSItem.SubItems(3) = "<="
Else
   tLSItem.SubItems(3) = ConvertOperator(CbxCon.Text)
End If
'字段值
If gQueryField(CbxFieldName.ListIndex + 1, 3) <> "0" Then '有数据字典
   tLCItem.SubItems(4) = CbxFieldValue.Text
   If gQueryField(CbxFieldName.ListIndex + 1, 2) = 4 Then '支行或部门
      tLSItem.SubItems(4) = CStr(CbxFieldValue.ItemData(CbxFieldValue.ListIndex))
   Else
      tLSItem.SubItems(4) = "'" + CStr(CbxFieldValue.ItemData(CbxFieldValue.ListIndex)) + "'"
   End If
Else

   If gQueryField(CbxFieldName.ListIndex + 1, 2) = 1 Then '日期
      tLCItem.SubItems(4) = MaskRQ.Text
      tLSItem.SubItems(4) = Convert_Value(MaskRQ.Text, 1, 1, True, True) '"'" + Format(MaskRQ.Text, "yyyy-mm-dd") + "'" '
   Else '字符或数字
      tLCItem.SubItems(4) = TxtValue.Text
      If InStr(1, CbxCon.Text, "包含") <> 0 Then
        'tLSItem.SubItems(4) = Convert_Value("%" + TxtValue.Text + "%", 1, CInt(gQueryField(CbxFieldName.ListIndex + 1, 2)), True, True)
        tLSItem.SubItems(4) = "0"
      Else
        tLSItem.SubItems(4) = Convert_Value(TxtValue.Text, 1, CInt(gQueryField(CbxFieldName.ListIndex + 1, 2)), True, True)
      End If
   End If
End If
OptAndOr(0).Value = True
'LVCondition.SelectedItem.Selected = False
Set LVCondition.SelectedItem = Nothing
'For i = 1 To LVCondition.ListItems.Count
'  LVCondition.ListItems(i).Selected = False
'Next i
Err:
End Sub

Private Sub CmdDel_Click()
On Error GoTo Err
Dim i As Integer
If LVCondition.SelectedItem Is Nothing Then Exit Sub
i = LVCondition.SelectedItem.Index
LVCondition.ListItems.Remove (i)
LVSQL.ListItems.Remove (i)
If LVSQL.ListItems.Count < 1 Then
   OptAndOr(0).Value = False
   OptAndOr(1).Value = False
End If
LVResult.ListItems.Clear
Err:
End Sub

Private Sub CmdDelAll_Click()
LVCondition.ListItems.Clear
LVSQL.ListItems.Clear
OptAndOr(0).Value = False
OptAndOr(1).Value = False
LVResult.ListItems.Clear

End Sub

Private Sub CmdExecute_Click()
Call m_Operate_Do_Click(3)
End Sub

Private Sub CmdLeft_Click()
If LVCondition.SelectedItem Is Nothing Then Exit Sub
If LVCondition.SelectedItem.Text = "(" Then
   LVCondition.SelectedItem.Text = ""
   LVSQL.SelectedItem.Text = ""
Else
   LVCondition.SelectedItem.Text = "("
   LVSQL.SelectedItem.Text = "("
End If
End Sub

Private Sub CmdRight_Click()
If LVCondition.SelectedItem Is Nothing Then Exit Sub
If LVCondition.SelectedItem.SubItems(5) = ")" Then
   LVCondition.SelectedItem.SubItems(5) = ""
   LVSQL.SelectedItem.SubItems(5) = ""
Else
   LVCondition.SelectedItem.SubItems(5) = ")"
   LVSQL.SelectedItem.SubItems(5) = ")"
End If
End Sub

Private Sub CmdSel_Click(Index As Integer)
On Error Resume Next
Dim i As Integer
If LVViewField.ListItems.Count < 1 Then Exit Sub
LVResult.ColumnHeaders.Clear
If Index = 0 Then '全选
   For i = 1 To LVViewField.ListItems.Count
       LVViewField.ListItems(i).Checked = True
       LVResult.ColumnHeaders.Add , LVViewField.ListItems(i).key, LVViewField.ListItems(i).Text
   Next i
ElseIf Index = 1 Then
   For i = 1 To LVViewField.ListItems.Count
       LVViewField.ListItems(i).Checked = False
   Next i
End If
End Sub

Private Sub Form_Load()
Call FrmInit
Call SBarInit
End Sub

Private Sub Form_Resize()
On Error GoTo Err
If Me.WindowState = 1 Then Exit Sub
If Me.Width < 6000 Then
   Me.Width = 6000
ElseIf Me.Height < 4500 Then
   Me.Height = 4500
End If
If gHeightRate <= 0 Or gHeightRate >= 1 Then gHeightRate = 0.6
PicMain.Move 0, Tbar.ButtonHeight, Me.ScaleWidth, Me.ScaleHeight * gHeightRate - Tbar.ButtonHeight
HImgDrag.Move 0, PicMain.Height + PicMain.Top, Me.ScaleWidth, gBorderWidth
Pic3.Move 0, HImgDrag.Top + gBorderWidth, Me.ScaleWidth, Me.ScaleHeight - gBorderWidth - Tbar.ButtonHeight - PicMain.Height - SBar.Height
Err:
End Sub

'水平分割线
Private Sub HImgDrag_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     
    With HImgDrag
        HPicDrag.Move .Left, .Top, .Width, .Height
    End With
    HPicDrag.Visible = True
    HDragFlag = True

End Sub

Private Sub HImgDrag_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sglPos As Single

If HDragFlag Then
    sglPos = Y + HImgDrag.Top
    If sglPos < sglSplitLimit Then
        HPicDrag.Top = sglSplitLimit
    ElseIf sglPos > Me.Width - sglSplitLimit Then
        HPicDrag.Top = Me.Width - sglSplitLimit
    Else
        HPicDrag.Top = sglPos
    End If
End If