frmfind.frm

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

Dim tLSItem As ListItem 'LVSQL
Dim FieldValue As String
'If TxtValue.Text = "" Then
'   MsgBox "您没有输入查询值，请确认", vbExclamation, "系统提示"
'   Exit Sub
'End If
If TxtValue.Visible = True Then
   If TxtValue.Text = "" Then
      MsgBox "您没有输入查询值，请确认", vbExclamation, "系统提示"
      Exit Sub
    End If
ElseIf CbxFieldValue.Visible = True Then
   If CbxFieldValue.Text = "" Then
      MsgBox "您没有输入查询值，请确认", vbExclamation, "系统提示"
      Exit Sub
   End If
ElseIf MaskRQ.Visible = True Then
   If MaskRQ.Text = "????年??月??日" Then
      MsgBox "您没有输入正确的时间，请确认", vbExclamation, "系统提示"
      Exit Sub
   End If
End If


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

'字段名
tLCItem.SubItems(2) = CbxFieldName.Text
tLSItem.SubItems(2) = gQueryField(CbxFieldName.ListIndex + 1, 1)

'操作符
tLCItem.SubItems(3) = CbxCon.Text
tLSItem.SubItems(3) = ConvertOperator(CbxCon.Text)

'字段值
If gQueryField(CbxFieldName.ListIndex + 1, 3) = 1 Then '有数据字典
   tLCItem.SubItems(4) = CbxFieldValue.Text
   FieldValue = Trim(CbxFieldValue.Text)
   tLSItem.SubItems(4) = "'" + FieldValue + "'"
'   tLSItem.SubItems(4) = "'" + CStr(CbxFieldValue.ItemData(CbxFieldValue.ListIndex)) + "'"
Else

   If gQueryField(CbxFieldName.ListIndex + 1, 2) = 3 Then '日期
      tLCItem.SubItems(4) = MaskRQ.Text
      tLSItem.SubItems(4) = Convert_Value(MaskRQ.Text, 1, 3, True, True)
   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)
      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
CmdExecute.Enabled = True
CmdExecute.SetFocus
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)
Err:
End Sub

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

Private Sub CmdExecute_Click()
Dim tSql As String
Dim tWhereStr As String
Dim i, j As Integer
Dim Num, n 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

LVResult.ListItems.Clear
Call SBarInit

If LVResult.ColumnHeaders.Count < 1 Then
   MsgBox "您没有选中可显示的字段，请重新选择", vbExclamation, XTTS
   Exit Sub
End If

If LVCondition.ListItems.Count < 1 Then
   MsgBox "您没有输入查询条件或是输入的查询条件不正确，请重新输入", vbExclamation, XTTS
   Exit Sub
End If

For i = 1 To LVResult.ColumnHeaders.Count
   Call GetValue(tFieldName, "field_name_en", LVResult.ColumnHeaders(i).Key)
   tSql = tSql + tFieldName + " as " + Trim(LVResult.ColumnHeaders(i).Text) + ","
Next i

If tSql = "" Then
   MsgBox "您没有选择显示的字段或是选择的显示字段不正确，请重新输入", vbExclamation, XTTS
   Exit Sub
End If

tSql = "select " + RemoveString(tSql, ",", 0)

tSql = tSql + " from " + Table_Name + " where "
'tSql = tSql + " ,file_id as id from file_" + gTypeCode(CbxTypeCode.ListIndex + 1) + " where "
LVResult.Tag = "0" '表类型标志

For i = 1 To LVSQL.ListItems.Count
   tWhereStr = tWhereStr + " " + LVSQL.ListItems(i).Text
   For j = 1 To LVSQL.ColumnHeaders.Count - 1
      tWhereStr = tWhereStr + " " + LVSQL.ListItems(i).SubItems(j)
   Next j
   'Debug.Print tWhereStr
Next i

If tWhereStr = "" Then
   MsgBox "您没有输入查询条件或是输入的查询条件不正确，请重新输入", vbExclamation, XTTS
   Exit Sub
End If
tWhereStr = RemoveString(tWhereStr, "and", 0)
tWhereStr = RemoveString(tWhereStr, "or", 0)
tSql = tSql + tWhereStr

Set gRst = gDbFish.OpenRecordset(tSql)
'Set gRst = gDbs.OpenRecordset(tSql + tWhereStr)
If gRst.EOF Then
   MsgBox "没有符合条件的查询结果", vbExclamation, "系统提示"
   CmdExecute.Enabled = False
   Exit Sub '没有结果集
End If



While Not gRst.EOF


        '添加第一列
        Set tListItem = LVResult.ListItems.Add(, , Trim(gRst.Fields(0)))

        '添加其余列
        For n = 2 To LVResult.ColumnHeaders.Count
            tListItem.SubItems(n - 1) = (Trim(gRst.Fields(LVResult.ColumnHeaders(n - 1).Index)))
        Next n
'SBar.Panels(2).Text = "进度：" + Format(gRst.AbsolutePosition / gRst.RecordCount, "0.00%")
gRst.MoveNext
Num = Num + 1
Wend

SBar.Panels(4).Text = "记录数: " + Trim(Num)

Err:
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

'If CmdExecute.Enabled = True Then
'   Call CmdExecute_Click
'Else
' Exit Sub
'End If

End Sub

Private Sub Form_Load()
CmdSel(0).Enabled = False
CmdSel(1).Enabled = False
CmdExecute.Enabled = False
Call FrmInit
Call SBarInit
End Sub

Private Sub Form_Resize()

On Error GoTo Err
If Me.WindowState = 1 Then Exit Sub
If Me.Width < 8000 Then
   Me.Width = 8000
ElseIf Me.Height < 6000 Then
   Me.Height = 6000
End If
If gHeightRate <= 0 Or gHeightRate >= 1 Then gHeightRate = 0.5
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 Form_Unload(Cancel As Integer)
Call FrmMain.CmdQuit_Click
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
End Sub

Private Sub HImgDrag_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
HImgDrag.Move HPicDrag.Left, HPicDrag.Top, HPicDrag.Width, HPicDrag.Height
HPicDrag.Visible = False
HDragFlag = False
gHeightRate = HPicDrag.Top / Me.ScaleHeight
Call Form_Resize
End Sub




Private Sub Pic1_Resize()
On Error GoTo Err
Dim tMinWidth As Single
Dim tMinHeight As Single
If Pic1.Width < 3000 Then
   tMinWidth = 3000
Else
   tMinWidth = Pic1.Width
End If
If Pic1.Height < 2000 Then
   tMinHeight = 2000
Else
   tMinHeight = Pic1.Height
End If
Label1.Move gBorderWidth, gBorderWidth + 120
'Label2.Move gBorderWidth, Label1.Top + 360

CbxTypeCode.Move Label1.Left + Label1.Width + gBorderWidth, gBorderWidth, tMinWidth - (Label1.Left + Label1.Width + 2 * gBorderWidth)
'CbxObject.Move CbxTypeCode.Left, CbxTypeCode.Top + CbxTypeCode.Height + gBorderWidth, CbxTypeCode.Width
'Frame1.Move gBorderWidth, CbxObject.Top + CbxObject.Height + gBorderWidth + 60, tMinWidth - 140, tMinHeight - CbxObject.Top - CbxObject.Height - 200
CmdSel(0).Move gBorderWidth, CbxTypeCode.Top + CbxTypeCode.Height + gBorderWidth + 60
CmdSel(1).Move CmdSel(0).Left + CmdSel(0).Width + gBorderWidth, CmdSel(0).Top

LVViewField.Height = Pic1.Height - (CmdSel(1).Top + CmdSel(1).Height) - 2 * gBorderWidth
LVViewField.Move gBorderWidth, CmdSel(0).Top + CmdSel(0).Height + (Pic1.Height - CmdSel(0).Height - CmdSel(0).Top - LVViewField.Height) / 2, Pic1.Width - 2 * gBorderWidth
Err:
End Sub

Private Sub Pic2_Resize()
On Error GoTo Err
Dim tMinWidth As Single
If Pic2.Width > 6000 Then
   tMinWidth = Pic2.Width
Else
   tMinWidth = 6000
End If
Label3.Move gBorderWidth, gBorderWidth, tMinWidth - 2 * gBorderWidth
Line1.Y1 = Label3.Height + gBorderWidth
Line1.Y2 = Line1.Y1
Line1.X1 = gBorderWidth
Line1.X2 = tMinWidth - gBorderWidth

Pic4.Move gBorderWidth, Line1.Y1 + gBorderWidth, tMinWidth - 2 * gBorderWidth
Pic5.Move 0, 0, 0.3 * Pic4.Width
Pic6.Move Pic5.Width, 0, 0.3 * Pic4.Width
Pic7.Move Pic4.Width * 0.6, 0, 0.4 * Pic4.Width
Label4.Move 3 * gBorderWidth, gBorderWidth, Pic5.Width - 2 * gBorderWidth
Label5.Move 3 * gBorderWidth, gBorderWidth, Pic6.Width - 2 * gBorderWidth
Label6.Move 3 * gBorderWidth, gBorderWidth, Pic7.Width - 2 * gBorderWidth
CbxFieldName.Move 2 * gBorderWidth, Label4.Height + gBorderWidth, Pic5.Width - 4 * gBorderWidth
CbxCon.Move 2 * gBorderWidth, Label4.Height + gBorderWidth, Pic5.Width - 4 * gBorderWidth
CbxFieldName.Move 2 * gBorderWidth, Label5.Height + gBorderWidth, Pic6.Width - 4 * gBorderWidth
CbxFieldValue.Move 2 * gBorderWidth, Label6.Height + gBorderWidth, Pic7.Width - 4 * gBorderWidth
MaskRQ.Move CbxFieldValue.Left, CbxFieldValue.Top, CbxFieldValue.Width, CbxFieldValue.Height
TxtValue.Move CbxFieldValue.Left, CbxFieldValue.Top, CbxFieldValue.Width, CbxFieldValue.Height
'TxtValue.Move 2 * gBorderWidth, Label6.Height + gBorderWidth, Pic7.Width - 4 * gBorderWidth

Line2.Y1 = Pic4.Top + Pic4.Height
Line2.Y2 = Line2.Y1
Line2.X1 = gBorderWidth / 2
Line2.X2 = tMinWidth - 2 * gBorderWidth

PicBtn.Move gBorderWidth, Line2.Y1 + gBorderWidth, tMinWidth - 2 * gBorderWidth, CmdLeft.Height
OptAndOr(0).Move gBorderWidth, (PicBtn.Height - OptAndOr(0).Height) / 2
OptAndOr(1).Move OptAndOr(0).Left + OptAndOr(0).Width + gBorderWidth, (PicBtn.Height - OptAndOr(0).Height) / 2
CmdLeft.Move OptAndOr(1).Left + OptAndOr(1).Width + gBorderWidth, 0
CmdRight.Move CmdLeft.Left + CmdLeft.Width + gBorderWidth, 0

CmdDelAll.Move PicBtn.Width - CmdDelAll.Width - gBorderWidth - 400, 0
CmdDel.Move CmdDelAll.Left - CmdDel.Width - gBorderWidth, 0
CmdAdd.Move CmdDel.Left - CmdDel.Width - gBorderWidth, 0
CmdExecute.Move CmdAdd.Left - CmdAdd.Width - gBorderWidth, 0
LVCondition.Move gBorderWidth, PicBtn.Top + PicBtn.Height + gBorderWidth, PicBtn.Width, Pic2.Height - PicBtn.Top - PicBtn.Height - 2 * gBorderWidth
Err:
End Sub

Public Sub SBarInit()
SBar.Panels(3).Text = "机器名:" + gComputerName