See Chalangable Things-What You Want That You Get

I am Jack From USA and i am trying to give all kind of The Supernatural things.

Tuesday, May 12, 2009

class file here

Option Explicit

Public Function GetRecords(strQuery As String) As ADODB.Recordset
On Error GoTo selectError

Set GetRecords = CN.Execute(strQuery)

Exit Function
selectError:
Set GetRecords = Nothing
End Function

first page

Option Explicit
Dim rs As New ADODB.Recordset

Public Sub Search(strQuery As String)
' Dim i As Integer, iCol As Integer
' cmbUni.Clear
' Dim cClass As New JK
' Set Rs = cClass.GetRecords(strQuery)
' Fg.DataMode = flexDMBound
' Set Fg.DataSource = Rs
'
' If (Rs.EOF And Rs.BOF) Then
' MsgBox "No Record Found", vbInFormation + vbOKOnly, MediMsg
' Uni_C0 = ""
' Uni_C1 = ""
' Uni_C2 = ""
' Uni_C3 = ""
' Exit Sub
' Else
' 'Uni_C0 = ""
' End If
'
' If Rs Is Nothing Then
' MsgBox "No Record Found", vbInFormation + vbOKOnly, MediMsg
' Uni_C0 = ""
' Uni_C1 = ""
' Uni_C3 = ""
' Uni_C2 = ""
' Fg.Rows = 1
' Exit Sub
' Else
' 'Uni_C0 = ""
' End If
'
' For i = 0 To Rs.Fields.Count - 1
' Fg.TextMatrix(0, i) = Rs(i).Name
' cmbUni.AddItem Rs(i).Name
' Fg.AutoSize i, i, True
' Fg.AutoSizeMode = flexAutoSizeColWidth
' Next
'
' cmbUni.Text = Rs.Fields(0).Name
' cmbUni.ItemData(0) = True

Dim i As Integer ', iCol As Integer
cmbUni.Clear
Dim cClass As New JK
Set rs = cClass.GetRecords(strQuery)

'''''''''''Change for Sorting '''''''''''''''

'Fg.DataMode = flexDMBound
Fg.DataMode = flexDMFree
Set Fg.DataSource = rs

'''''''''''Change for Sorting '''''''''''''''

If (rs.EOF And rs.BOF) Then
MsgBox "No Record Found", vbInformation + vbOKOnly, MediMsg
Uni_C0 = ""
Uni_C1 = ""
Uni_C2 = ""
Uni_C3 = ""
Exit Sub
Else
'Uni_C0 = ""
End If

If rs Is Nothing Then
MsgBox "No Record Found", vbInformation + vbOKOnly, MediMsg
Uni_C0 = ""
Uni_C1 = ""
Uni_C3 = ""
Uni_C2 = ""
Fg.Rows = 1
Exit Sub
Else
'Uni_C0 = ""
End If

For i = 0 To rs.Fields.Count - 1
Fg.TextMatrix(0, i) = rs(i).Name
cmbUni.AddItem rs(i).Name
Fg.AutoSize i, i, True
Fg.AutoSizeMode = flexAutoSizeColWidth
Next

cmbUni.Text = rs.Fields(0).Name

'''''''''''Change for Sorting '''''''''''''''
Fg.Select 1, 0, 1, Fg.Cols - 1

Fg.Sort = flexSortGenericAscending

Fg.Select 1, 0
'''''''''''Change for Sorting '''''''''''''''

cmbUni.ItemData(0) = True

End Sub

Private Sub cmbUni_Click()

Dim i As Integer
' txtSearch.SetFocus
'
' If Fg.Rows = 1 Then Exit Sub
' Rs.Filter = ""
'
' For i = 0 To Rs.Fields.Count - 1
' Fg.AutoSize i, i, True
' Fg.AutoSizeMode = flexAutoSizeColWidth
' Next

'''''''''''Change for Sorting '''''''''''''''
txtSearch.Text = ""
'''''''''''Change for Sorting '''''''''''''''
txtSearch.SetFocus

If Fg.Rows = 1 Then Exit Sub

'''''''''''Change for Sorting '''''''''''''''
Fg.DataMode = flexDMFree

Set Fg.DataSource = rs

Fg.Select 1, cmbUni.ListIndex
Fg.Sort = flexSortGenericAscending

'''''''''''Change for Sorting '''''''''''''''

rs.Filter = ""

For i = 0 To rs.Fields.Count - 1
Fg.AutoSize i, i, True
Fg.AutoSizeMode = flexAutoSizeColWidth
Next

'''''''''''Change for Sorting '''''''''''''''
If Trim$(txtSearch.Text) <> "" Then
cmdFilter_Click
End If

'''''''''''Change for Sorting '''''''''''''''

End Sub

Private Sub cmbUni_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub cmdFilter_Click()
Dim i As Integer
On Error Resume Next

If rs.Fields(cmbUni.Text).Type = adInteger Or rs.Fields(cmbUni.Text).Type = adCurrency Then
rs.Filter = "[" & cmbUni.Text & "] like " & Trim$(Fg.TextMatrix(Fg.RowSel, cmbUni.Index)) & ""
Else

If rs.Fields(cmbUni.Text).Type = 7 Then
rs.Filter = "[" & cmbUni.Text & "] like #" & txtSearch.Text & "#"
Else
rs.Filter = "[" & cmbUni.Text & "] like '" & Trim$(Fg.TextMatrix(Fg.RowSel, IIf((cmbUni.ListIndex = -1), 0, cmbUni.ListIndex))) & "*'"
End If
End If

For i = 0 To Fg.Cols - 1
Fg.AutoSize i, i, True
Fg.AutoSizeMode = flexAutoSizeColWidth
Next

End Sub

Private Sub Fg_DblClick()
Dim i%

If FgClick <> True Then
If Fg.Rows <= 1 Then
Uni_C0 = ""
Uni_C1 = ""
Uni_C2 = ""
Uni_C3 = ""
Unload Me
Exit Sub
End If

For i = 0 To Fg.Cols - 1

Select Case i

Case 0
Uni_C0 = Fg.TextMatrix(Fg.RowSel, 0)

Case 1
Uni_C1 = Fg.TextMatrix(Fg.RowSel, 1)

Case 2
Uni_C2 = Fg.TextMatrix(Fg.RowSel, 2)

Case 3
Uni_C3 = Fg.TextMatrix(Fg.RowSel, 3)

End Select

Next

Unload Me
Else
Me.Hide
End If

End Sub

Private Sub Fg_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then Fg_DblClick
End Sub

Private Sub Fg_KeyUp(KeyCode As Integer, _
Shift As Integer)
' If KeyCode = 39 Then
' If Not (Fg.Col = Fg.Cols - 1) Then
' Fg.ShowCell Fg.RowSel, Fg.ColSel
' End If
'
' ElseIf KeyCode = 37 Then
' If Not Fg.Col < 0 Then
' Fg.ShowCell Fg.RowSel, Fg.ColSel
' End If
' End If
End Sub

Private Sub Form_Initialize()
Me.Width = 5310
Me.Height = 2700

End Sub

Private Sub Form_Resize()
On Error Resume Next
Picture1.Left = Me.Width - 900
txtSearch.Left = cmbUni.Width + 30
txtSearch.Width = Me.Width - (cmbUni.Width + Picture1.Width) + 200
Fg.Width = Me.Width - 100
'Fg.ScrollBars = flexScrollBarVertical
End Sub

Private Sub SmartButton1_Click()
Unload Me
End Sub

Private Sub txtSearch_Change()
Dim i As Integer
On Error Resume Next

If txtSearch.Text = "" Then
rs.Filter = ""
'''''''''''''''''OLD CODING
' For i = 0 To Rs.Fields.Count - 1
' Fg.AutoSize i, i, True
' Fg.AutoSizeMode = flexAutoSizeColWidth
' Next
'
' Exit Sub
'
'
''''''''''''''''''NEW CODE START FOR SORTING

'''''''''''Change for Sorting '''''''''''''''

Fg.DataMode = flexDMFree
Set Fg.DataSource = rs

'''''''''''Change for Sorting '''''''''''''''

For i = 0 To rs.Fields.Count - 1
Fg.AutoSize i, i, True
Fg.AutoSizeMode = flexAutoSizeColWidth
Next

'''''''''''Change for Sorting '''''''''''''''

Fg.Select 1, cmbUni.ListIndex
Fg.Sort = flexSortGenericAscending

'''''''''''Change for Sorting '''''''''''''''
Exit Sub

End If

If rs.Fields(cmbUni.Text).Type = adInteger Or rs.Fields(cmbUni.Text).Type = adCurrency Or rs.Fields(cmbUni.Text).Type = adSingle Or rs.Fields(cmbUni.Text).Type = adSmallInt Then
rs.Filter = "[" & cmbUni.Text & "] Like " & txtSearch.Text & ""
Else

If rs.Fields(cmbUni.Text).Type = 7 Then
rs.Filter = "[" & cmbUni.Text & "] like #" & txtSearch.Text & "#"
Else
rs.Filter = "[" & cmbUni.Text & "] like '" & txtSearch.Text & "*'"
End If

End If

'OLD CODING
' For i = 0 To Rs.Fields.Count - 1
' Fg.AutoSize i, i, True
' Fg.AutoSizeMode = flexAutoSizeColWidth
' Next
'
''''''''''''NEW CODE FOR SORTING

'''''''''''Change for Sorting '''''''''''''''

Fg.DataMode = flexDMBound
Set Fg.DataSource = rs

'''''''''''Change for Sorting '''''''''''''''

For i = 0 To rs.Fields.Count - 1
Fg.AutoSize i, i, True
Fg.AutoSizeMode = flexAutoSizeColWidth
Next

End Sub

Private Sub txtSearch_KeyDown(KeyCode As Integer, _
Shift As Integer)
On Error Resume Next

Select Case KeyCode

Case vbKeyDown

If Fg.Row = Fg.Rows - 1 Then
'Fg.Row = 1
Else
Fg.Row = Fg.Row + 1
Fg.ShowCell Fg.RowSel, Fg.ColSel
End If

Case vbKeyUp

If Fg.Row = 1 Then
'Fg.Row = Fg.Rows - 1
Else
Fg.Row = Fg.Row - 1
Fg.ShowCell Fg.RowSel, Fg.ColSel
End If

Case vbKeyPageDown

If Fg.Row = Fg.Rows - 1 Then
'Fg.Row = 1
Else
Fg.Row = Fg.Row + 9
Fg.ShowCell Fg.RowSel, Fg.ColSel
End If

Case vbKeyPageUp

If Fg.Row = 1 Then
'Fg.Row = Fg.Rows - 1
Else
Fg.Row = Fg.Row - 9
Fg.ShowCell Fg.RowSel, Fg.ColSel
End If

End Select

End Sub

Private Sub txtSearch_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
Fg.SetFocus
Fg_DblClick
End If

End Sub