(VFP) - A sample seach form
*********************************************************
** Author : Ramani (Subramanian.G)
** FoxAcc Software / Winners Software
** ramani_vfp@yahoo.com
** Type : Freeware with reservation to Copyrights
** Warranty : Nothing implied or explicit
*********************************************************
** How to Run..
** 1. Save the following code as gsSearch.PRG
** 2. From the command window run that
** DO gsSearch
*********************************************************
** gsSearch.prg
*********************************************************
CREATE CURSOR test (cName C(20), email c(20))
INSERT INTO test (cName, email) VALUES ("experts","experts@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Dummy","dummy@dummy.moc")
INSERT INTO test (cName, email) VALUES ("ClayHead","clay@dummy.moc")
INSERT INTO test (cName, email) VALUES ("WoodBrain","wood@dummy.moc")
INSERT INTO test (cName, email) VALUES ("IronHead","iron@dummy.moc")
INSERT INTO test (cName, email) VALUES ("BigHead","big@dummy.moc")
INSERT INTO test (cName, email) VALUES ("ShowMan","showbiz@dummy.moc")
INSERT INTO test (cName, email) VALUES ("NutHead","nuts@dummy.moc")
INSERT INTO test (cName, email) VALUES ("Ramani","ramani@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Mike","mike@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Rick","Rick@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Chris","chris@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Dsumzz","dsumzz@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("mySelf","me@Tek_tips.moc")
LOCATE
myFields = "cName,email"
=gsFindForm(myFields)
=MESSAGEBOX("You have selected :"+ALLTRIM(cName)+" : "+email, 0+16, "Eureka!")
RETURN
**************************************************
PROCEDURE gsFindForm
** The above codes are for example..
** The below code can be copied as gsFindForm.prg
** and you can call the code as shown in above or..
** DO FORM gsFindForm WITH myFields
*************************************************
** PROCEDURE gsFindForm
PARAMETERS tcFields
IF PARAMETERS() < 1
RETURN .f.
ENDIF
PUBLIC oform1
oform1=NEWOBJECT("gsFindForm",'','',tcFields)
oform1.Show
RELEASE oForm1
RETURN
**************************************************
*-- Form: gsFindForm
*-- ParentClass: form
*-- BaseClass: form
*
DEFINE CLASS gsFindForm AS form
AutoCenter = .t.
Height = 242
Width = 420
DoCreate = .T.
Caption = "FindForm"
Name = "gsFindForm"
WindowType = 1
inrecno = 0
ADD OBJECT cmdfirst AS commandbutton WITH ;
Top = 216, ;
Left = 0, ;
Height = 27, ;
Width = 84, ;
Caption = "\ Name = "cmdFirst"
ADD OBJECT cmdprevious AS commandbutton WITH ;
Top = 216, ;
Left = 84, ;
Height = 27, ;
Width = 84, ;
Caption = "\ Name = "cmdPrevious"
ADD OBJECT cmdnext AS commandbutton WITH ;
Top = 216, ;
Left = 168, ;
Height = 27, ;
Width = 84, ;
Caption = "\ Name = "cmdNext"
ADD OBJECT cmdlast AS commandbutton WITH ;
Top = 216, ;
Left = 252, ;
Height = 27, ;
Width = 84, ;
Caption = "\ Name = "cmdLast"
ADD OBJECT cmdexit AS commandbutton WITH ;
Top = 216, ;
Left = 336, ;
Height = 27, ;
Width = 84, ;
Cancel = .T., ;
Caption = "E\ Name = "cmdExit"
ADD OBJECT grid1 AS grid WITH ;
Height = 216, ;
Left = -12, ;
Top = 0, ;
Width = 432, ;
Name = "Grid1", ;
DeleteMark = .F., ;
HighlightRow = .T., ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,192), ;
GridLineColor = RGB(0,0,128)
PROCEDURE Init
PARAMETERS tcFields
IF PARAMETERS() < 1
RETURN .f.
ENDIF
LOCAL nCount
nCount = ALINES(laFields,tcFields,",")
WITH ThisForm.Grid1
.ColumnCount = nCount
FOR I=1 TO nCount
.Columns(I).ControlSource = laFields(i)
ENDFOR
.SetFocus()
ENDWITH
ENDPROC
PROCEDURE cmdfirst.Click
GO TOP
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdprevious.Click
IF NOT BOF()
SKIP -1
ENDIF
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdnext.Click
IF NOT EOF()
SKIP
ENDIF
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdlast.Click
GO BOTTOM
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdexit.Click
ThisForm.Release()
ENDPROC
PROCEDURE Grid1.AfterRowColChange
LPARAMETERS nColIndex
ThisForm.inRecNo = IIF(EOF() OR BOF(),0,RECNO())
This.Columns(This.ActiveColumn).Text1.BackColor = RGB(255,0,0)
This.Columns(This.ActiveColumn).Text1.DisabledBackColor = RGB(32,224,224)
This.Columns(This.ActiveColumn).Text1.DisabledForeColor = RGB(0,0,0)
This.Refresh()
RETURN .T.
ENDPROC
PROCEDURE Grid1.Init
DODEFAULT()
WITH THIS
.SetAll("DynamicBackColor", ;
"IIF(recno(This.RecordSource)= ;
ThisForm.inRecno,RGB(32,224,224), ;
RGB(255,255,192))","COLUMN")
.SetAll("BackColor", RGB(255,192,192),"Header")
.SetAll("Alignment", 2, "Header")
ENDWITH
ENDPROC
ENDDEFINE
*
*-- EndDefine: form1
**************************************************
** EOF
**************************************************
** Author : Ramani (Subramanian.G)
** FoxAcc Software / Winners Software
** ramani_vfp@yahoo.com
** Type : Freeware with reservation to Copyrights
** Warranty : Nothing implied or explicit
*********************************************************
** How to Run..
** 1. Save the following code as gsSearch.PRG
** 2. From the command window run that
** DO gsSearch
*********************************************************
** gsSearch.prg
*********************************************************
CREATE CURSOR test (cName C(20), email c(20))
INSERT INTO test (cName, email) VALUES ("experts","experts@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Dummy","dummy@dummy.moc")
INSERT INTO test (cName, email) VALUES ("ClayHead","clay@dummy.moc")
INSERT INTO test (cName, email) VALUES ("WoodBrain","wood@dummy.moc")
INSERT INTO test (cName, email) VALUES ("IronHead","iron@dummy.moc")
INSERT INTO test (cName, email) VALUES ("BigHead","big@dummy.moc")
INSERT INTO test (cName, email) VALUES ("ShowMan","showbiz@dummy.moc")
INSERT INTO test (cName, email) VALUES ("NutHead","nuts@dummy.moc")
INSERT INTO test (cName, email) VALUES ("Ramani","ramani@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Mike","mike@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Rick","Rick@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Chris","chris@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("Dsumzz","dsumzz@Tek_tips.moc")
INSERT INTO test (cName, email) VALUES ("mySelf","me@Tek_tips.moc")
LOCATE
myFields = "cName,email"
=gsFindForm(myFields)
=MESSAGEBOX("You have selected :"+ALLTRIM(cName)+" : "+email, 0+16, "Eureka!")
RETURN
**************************************************
PROCEDURE gsFindForm
** The above codes are for example..
** The below code can be copied as gsFindForm.prg
** and you can call the code as shown in above or..
** DO FORM gsFindForm WITH myFields
*************************************************
** PROCEDURE gsFindForm
PARAMETERS tcFields
IF PARAMETERS() < 1
RETURN .f.
ENDIF
PUBLIC oform1
oform1=NEWOBJECT("gsFindForm",'','',tcFields)
oform1.Show
RELEASE oForm1
RETURN
**************************************************
*-- Form: gsFindForm
*-- ParentClass: form
*-- BaseClass: form
*
DEFINE CLASS gsFindForm AS form
AutoCenter = .t.
Height = 242
Width = 420
DoCreate = .T.
Caption = "FindForm"
Name = "gsFindForm"
WindowType = 1
inrecno = 0
ADD OBJECT cmdfirst AS commandbutton WITH ;
Top = 216, ;
Left = 0, ;
Height = 27, ;
Width = 84, ;
Caption = "\
ADD OBJECT cmdprevious AS commandbutton WITH ;
Top = 216, ;
Left = 84, ;
Height = 27, ;
Width = 84, ;
Caption = "\
ADD OBJECT cmdnext AS commandbutton WITH ;
Top = 216, ;
Left = 168, ;
Height = 27, ;
Width = 84, ;
Caption = "\
ADD OBJECT cmdlast AS commandbutton WITH ;
Top = 216, ;
Left = 252, ;
Height = 27, ;
Width = 84, ;
Caption = "\
ADD OBJECT cmdexit AS commandbutton WITH ;
Top = 216, ;
Left = 336, ;
Height = 27, ;
Width = 84, ;
Cancel = .T., ;
Caption = "E\
ADD OBJECT grid1 AS grid WITH ;
Height = 216, ;
Left = -12, ;
Top = 0, ;
Width = 432, ;
Name = "Grid1", ;
DeleteMark = .F., ;
HighlightRow = .T., ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,192), ;
GridLineColor = RGB(0,0,128)
PROCEDURE Init
PARAMETERS tcFields
IF PARAMETERS() < 1
RETURN .f.
ENDIF
LOCAL nCount
nCount = ALINES(laFields,tcFields,",")
WITH ThisForm.Grid1
.ColumnCount = nCount
FOR I=1 TO nCount
.Columns(I).ControlSource = laFields(i)
ENDFOR
.SetFocus()
ENDWITH
ENDPROC
PROCEDURE cmdfirst.Click
GO TOP
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdprevious.Click
IF NOT BOF()
SKIP -1
ENDIF
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdnext.Click
IF NOT EOF()
SKIP
ENDIF
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdlast.Click
GO BOTTOM
ThisForm.Grid1.SetFocus()
ThisForm.Refresh()
ENDPROC
PROCEDURE cmdexit.Click
ThisForm.Release()
ENDPROC
PROCEDURE Grid1.AfterRowColChange
LPARAMETERS nColIndex
ThisForm.inRecNo = IIF(EOF() OR BOF(),0,RECNO())
This.Columns(This.ActiveColumn).Text1.BackColor = RGB(255,0,0)
This.Columns(This.ActiveColumn).Text1.DisabledBackColor = RGB(32,224,224)
This.Columns(This.ActiveColumn).Text1.DisabledForeColor = RGB(0,0,0)
This.Refresh()
RETURN .T.
ENDPROC
PROCEDURE Grid1.Init
DODEFAULT()
WITH THIS
.SetAll("DynamicBackColor", ;
"IIF(recno(This.RecordSource)= ;
ThisForm.inRecno,RGB(32,224,224), ;
RGB(255,255,192))","COLUMN")
.SetAll("BackColor", RGB(255,192,192),"Header")
.SetAll("Alignment", 2, "Header")
ENDWITH
ENDPROC
ENDDEFINE
*
*-- EndDefine: form1
**************************************************
** EOF
**************************************************
Comments