frmfind.frm

雨点进销存软件,绝对可以用,大家可以拿来使用

End Sub

Private Sub Tbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
   Case "BtnOpen"
     Call m_Operate_Do_Click(0)
   Case "BtnSave"
     Call m_Operate_Do_Click(1)
   Case "BtnBack"
      Me.Hide
      Load FrmStock
      FrmStock.Show 1
   Case "BtnQuit"
      Call FrmMain.CmdQuit_Click
End Select
End Sub



Private Sub TxtValue_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Or KeyCode = 40 Then
CmdAdd.SetFocus
End If
End Sub

'垂直分割线
Private Sub VImgDrag_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With VImgDrag
        VPicDrag.Move .Left, .Top, .Width, .Height
    End With
    VPicDrag.Visible = True
    VDragFlag = True

End Sub

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

If VDragFlag Then
    sglPos = X + VImgDrag.Left
    
    If sglPos < sglSplitLimit Then
        VPicDrag.Left = sglSplitLimit
    ElseIf sglPos > Me.Width - sglSplitLimit Then
        VPicDrag.Left = Me.Width - sglSplitLimit
    Else
        VPicDrag.Left = sglPos
    End If

End If

End Sub

Private Sub VImgDrag_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Err
VImgDrag.Move VPicDrag.Left, VPicDrag.Top, VPicDrag.Width, VPicDrag.Height
VPicDrag.Visible = False
VDragFlag = False
gWidthRate = VPicDrag.Left / PicMain.Width
Call PicMain_Resize
Err:
End Sub
Private Sub LVViewField_ItemCheck(ByVal Item As MSComctlLib.ListItem)
 On Error GoTo Err

Dim i As Integer
If Item.Checked = True Then
  LVResult.ColumnHeaders.Add , Item.Key, Item.Text
  If CmdExecute.Enabled = True Then
   Call CmdExecute_Click
Else
 Exit Sub
End If
Else
  For i = 1 To LVResult.ColumnHeaders.Count
    If LVResult.ColumnHeaders(i).Key = Item.Key Then LVResult.ColumnHeaders.Remove i
         
        If CmdExecute.Enabled = True Then
           Call CmdExecute_Click
        Else
           Exit Sub
        End If
  Next i

End If

' CmdExecute.Enabled = True

Err:
End Sub

Private Sub Pic3_Resize()
On Error GoTo Err
'Pic3.AutoSize = True
Label8.Move gBorderWidth, gBorderWidth, Pic3.Width - 2 * gBorderWidth
LVResult.Move 0, Label8.Top + Label8.Height + gBorderWidth, Pic3.Width, Pic3.Height - Label8.Top - Label8.Height - 2 * gBorderWidth + 50
Err:
End Sub



Private Sub PicMain_Resize()
On Error GoTo Err
If gWidthRate <= 0 Or gWidthRate >= 1 Then gWidthRate = 0.3
Pic1.Move 0, 0, PicMain.Width * gWidthRate, PicMain.Height
VImgDrag.Move Pic1.Width, 0, gBorderWidth, PicMain.Height
Pic2.Move Pic1.Width + gBorderWidth, 0, PicMain.Width - gBorderWidth - VImgDrag.Left, PicMain.Height
Err:
End Sub

Public Function ConvertOperator(p_String As String) As String
On Error GoTo Err
Select Case Trim(p_String)
   Case "等于"
      ConvertOperator = "="
   Case "不等于"
      ConvertOperator = "<>"
   Case "大于"
      ConvertOperator = ">"
   Case "小于"
      ConvertOperator = "<"
   Case "大于等于"
      ConvertOperator = ">="
   Case "小于等于"
      ConvertOperator = "<="
   Case "包含"
      ConvertOperator = "like"
   Case "不包含"
      ConvertOperator = "not like"
End Select
Exit Function
Err:
   ConvertOperator = ""
End Function

Public Sub FrmInit()

On Error GoTo Err
Dim i As String
Dim m As Integer
m = 0
If CbxFieldName.ListCount > 1 Then
   CbxFieldName.ListIndex = 0
Else
   CbxFieldName.Text = ""
End If

If CbxCon.ListCount > 1 Then
   CbxCon.ListIndex = 0
Else
   CbxCon.Text = ""
End If

If CbxFieldValue.ListCount > 1 Then
   CbxFieldValue.ListIndex = 0
Else
   CbxFieldValue.Text = ""
End If

If CbxTypeCode.ListCount > 1 Then
   CbxTypeCode.ListIndex = 0
End If

'CbxObject.ListIndex = 0

'Set gRst = gDbs.OpenRecordset("select * from archive_type order by type_code")
Set gRst = gDbFish.OpenRecordset("select * from field_name  where field_name_type='5' order by is_boot")
CbxTypeCode.Clear

i = 0
While Not gRst.EOF
i = i + 1
gRst.MoveNext
Wend

ReDim gTypeCode(1 To i) As String
'
'If Not gRst.EOF Then
'
'   gRst.MoveLast
'   gRst.MoveFirst
'    ReDim gTypeCode(1 To gRst.RecordCount) As String
'End If

Set gRst = gDbFish.OpenRecordset("select * from field_name  where field_name_type='5' order by is_boot")

While Not gRst.EOF
   
   CbxTypeCode.AddItem Trim(gRst.Fields("field_Name_ch"))
   gTypeCode(m + 1) = Trim(gRst.Fields("is_boot"))
'   If gRst.AbsolutePosition + 1 > 1 Then Load m_Type_Code_Do(gRst.AbsolutePosition)
'   m_Type_Code_Do(gRst.AbsolutePosition).Visible = True
'   m_Type_Code_Do(gRst.AbsolutePosition).Caption = gRst.Fields("Type_Name")
'   m_Type_Code_Do(0).Checked = True
    m = m + 1
    gRst.MoveNext
Wend

If CbxTypeCode.ListCount > 1 Then CbxTypeCode.ListIndex = 0
'   Call AddViewField(gTypeCode(1))
'   Call AddQueryField(gTypeCode(1), CbxObject.ListIndex)
'End If

Err:

End Sub
''保存,打开查询条件
Private Sub m_Operate_Do_Click(Index As Integer)
Dim tSql As String
Dim tWhereStr As String
Dim i, j As Integer
Dim tTypeCode As String
Dim tFieldName As String '字段名称
Dim t_Dict_Type As String '数据字典
Dim tItem As ListItem
Dim tFieldValue As String
Dim tFileFullName As String
Dim tStr As String
Dim tBool As Boolean
Dim tStrArray(1 To 6) As String

On Error GoTo Err

Select Case Index
   Case 0 '打开
      CmnDlg.CancelError = False
      'CmnDlg.Flags = cdlOFNOverwritePrompt
      CmnDlg.Filter = "定制文件 (*.qry)|*.qry"
      CmnDlg.DialogTitle = "请选择定制的查询文件"
      CmnDlg.ShowOpen
      tFileFullName = CmnDlg.FileName
      If tFileFullName = "" Then Exit Sub

      For i = 0 To LVViewField.ListItems.Count - 1
          LVViewField.ListItems(i + 1).Checked = False
      Next i
      LVCondition.ListItems.Clear
      LVSQL.ListItems.Clear

      Close #2
      Open tFileFullName For Input As #2

      '档案类型
      Line Input #2, tStr
      tBool = False
'      CbxTypeCode.ListIndex = -1
      For i = 0 To CbxTypeCode.ListCount - 1
          If tStr = CbxTypeCode.List(i) Then
             CbxTypeCode.ListIndex = i
             tBool = True
             Exit For
          End If
      Next i
      If tBool = False Then GoTo Err

      '对象类型
      Line Input #2, tStr
'      CbxObject.ListIndex = CInt(tStr)

      Line Input #2, tStr
      Line Input #2, tStr
      Do While tStr <> "显示条件" And Not EOF(2) '显示字段
         For i = 0 To LVViewField.ListItems.Count
            If LVViewField.ListItems(i).Key = tStr Then
               LVViewField.ListItems(i).Checked = True
               Call LVViewField_ItemCheck(LVViewField.ListItems(i))
               Exit For
            End If
         Next i
         Line Input #2, tStr ' 读入一行数据并将其赋予某变量。
      Loop

      Line Input #2, tStr
      Do While tStr <> "条件" 'And Not EOF(2)  '显示字段
         For i = 1 To 6
            Call GetValue(tStrArray(i), CStr(i), tStr)
            If i = 1 Then
               Set tItem = LVCondition.ListItems.Add(, "K" + Format(LVCondition.ListItems.Count + 1, "0000"), tStrArray(i))
            Else
               tItem.SubItems(i - 1) = tStrArray(i)
            End If
         Next i
         Line Input #2, tStr ' 读入一行数据并将其赋予某变量。
      Loop


      Do  '显示字段
         Line Input #2, tStr
         For i = 1 To 6
            Call GetValue(tStrArray(i), CStr(i), tStr)
            If i = 1 Then
               Set tItem = LVSQL.ListItems.Add(, "K" + Format(LVSQL.ListItems.Count + 1, "0000"), tStrArray(i))
            Else
               tItem.SubItems(i - 1) = tStrArray(i)
            End If
         Next i
         Line Input #2, tStr ' 读入一行数据并将其赋予某变量。
      Loop Until EOF(2)
      Close #2
      CmdExecute.Enabled = True
      MsgBox "文件成功导入", vbExclamation, XTTS

   Case 1 '保存
      CmnDlg.CancelError = False
      CmnDlg.Flags = cdlOFNOverwritePrompt
      CmnDlg.Filter = "定制文件 (*.qry)|*.qry"
      CmnDlg.DialogTitle = "请输入保存的文件名"
      CmnDlg.ShowSave
      tFileFullName = CmnDlg.FileName
      If tFileFullName = "" Then Exit Sub

      Close #2
      Open tFileFullName For Output As #2

           Print #2, CbxTypeCode.Text  '档案类型代码
'           Print #2, CStr(CbxObject.ListIndex) '对象

           Print #2, "显示字段"
           For i = 1 To LVViewField.ListItems.Count
               If LVViewField.ListItems(i).Checked = True Then Print #2, LVViewField.ListItems(i).Key
           Next i

           Print #2, "显示条件" '+ CStr(LVCondition.ColumnHeaders.Count)
           'Print #2, LVCondition.ListItems.Count
           For i = 1 To LVCondition.ListItems.Count
              For j = 1 To LVCondition.ColumnHeaders.Count
                 If j = 1 Then
                    tStr = "@" + CStr(j) + LVCondition.ListItems(i).Text
                 Else
                    tStr = tStr + "@" + CStr(j) + LVCondition.ListItems(i).SubItems(j - 1)
                 End If
              Next j
              Print #2, tStr
           Next i

           Print #2, "条件" '+ CStr(LVResult.ColumnHeaders.Count)
           'Print #2, LVResult.ListItems.Count
           For i = 1 To LVSQL.ListItems.Count
              For j = 1 To LVSQL.ColumnHeaders.Count
                 If j = 1 Then
                    tStr = "@" + CStr(j) + LVSQL.ListItems(i).Text
                 Else
                    tStr = tStr + "@" + CStr(j) + LVSQL.ListItems(i).SubItems(j - 1)
                 End If
              Next j
              Print #2, tStr
           Next i
      Close #2
      MsgBox "文件保存成功", vbExclamation, XTTS

      Call SaveEventLog("6016", 0, CbxTypeCode.Text, "", "定制查询文件" + tFileFullName)
End Select
Err:
End Sub