************************************************** *-- Form: frmsearch *-- ParentClass: form *-- Time Stamp: 09/10/03 05:17:07 PM * Define Class frmsearch As Form Height = 242 Width = 630 DoCreate = .T. AutoCenter = .T. Caption = "Set Filter" Closable = .F. WindowType = 1 AlwaysOnTop = .T. *-- Alias used for record source of combo grid's grid calias = "" *-- Holds the filter condition as it is being built cfilter = "" Name = "frmSearch" *-- array to hold the field captions if the grid's record source has them or the names of the fields if it doesn't Dimension afieldnames[1,1] Add Object txtdate As txtdate With ; Format = "D", ; Height = 23, ; Left = 376, ; TabIndex = 4, ; Top = 26, ; Width = 250, ; Name = "txtDate" Add Object cbofieldnames As ComboBox With ; BoundColumn = 2, ; RowSourceType = 5, ; RowSource = "Thisform.aFieldNames", ; Height = 24, ; Left = 7, ; TabIndex = 1, ; Top = 26, ; Width = 257, ; Name = "cboFieldNames" Add Object cboconditions As ComboBox With ; Comment = "", ; RowSourceType = 1, ; RowSource = "", ; Height = 24, ; Left = 268, ; Style = 2, ; TabIndex = 2, ; Top = 26, ; Width = 100, ; Name = "cboConditions" Add Object label1 As Label With ; FontBold = .T., ; Caption = "Field", ; Height = 17, ; Left = 9, ; Top = 51, ; Width = 60, ; TabIndex = 9, ; Name = "Label1" Add Object label2 As Label With ; FontBold = .T., ; Caption = "Condition", ; Height = 17, ; Left = 270, ; Top = 51, ; Width = 72, ; TabIndex = 10, ; Name = "Label2" Add Object label3 As Label With ; FontBold = .T., ; Caption = "Value", ; Height = 17, ; Left = 375, ; Top = 50, ; Width = 40, ; TabIndex = 11, ; Name = "Label3" Add Object cmdok As CommandButton With ; Top = 209, ; Left = 317, ; Height = 27, ; Width = 84, ; Caption = "OK", ; TabIndex = 7, ; Name = "cmdOK" Add Object cmdcancel As CommandButton With ; Top = 209, ; Left = 406, ; Height = 27, ; Width = 84, ; Cancel = .T., ; Caption = "Cancel", ; TabIndex = 8, ; Name = "CmdCancel" Add Object cmdclearall As CommandButton With ; Top = 209, ; Left = 228, ; Height = 27, ; Width = 84, ; Caption = "\<Clear All", ; TabIndex = 6, ; Name = "cmdClearAll" Add Object cmdaddcondition As CommandButton With ; Top = 209, ; Left = 139, ; Height = 27, ; Width = 84, ; Caption = "\<Add Condition", ; Default = .T., ; TabIndex = 5, ; Name = "cmdAddCondition" Add Object edtfilter As EditBox With ; Height = 84, ; Left = 7, ; ReadOnly = .T., ; TabIndex = 12, ; Top = 84, ; Width = 619, ; ControlSource = "Thisform.cFilter", ; Name = "edtFilter" Add Object label4 As Label With ; FontBold = .T., ; Caption = "Filter Condition", ; Height = 17, ; Left = 9, ; Top = 169, ; Width = 90, ; TabIndex = 13, ; Name = "Label4" Add Object txtvalues As TextBox With ; Height = 23, ; Left = 376, ; TabIndex = 3, ; Top = 26, ; Width = 250, ; Name = "txtValues" *-- Builds the filter condition Procedure buildfilter Local lcCondition With Thisform * 09/08/03 SPB - If the middle initial was searched for an empty string, it would not give the right results. * Added the following code to fix that. If Empty(Alltrim(.txtvalues.Value)) lcCondition = '(UPPER(' + Alltrim(.cbofieldnames.Value) + ') ' + Alltrim(Thisform.cboconditions.Value) ; + ' ' + Chr(39) + Upper(Alltrim(.txtvalues.Value)) + Chr(39); + ' OR ' + Alltrim(.cbofieldnames.Value) + 'IS NULL)' Else If Type(.calias+'.'+Alltrim(.cbofieldnames.Value)) == 'C' lcCondition = 'UPPER(' + Alltrim(.cbofieldnames.Value) + ') ' + Alltrim(Thisform.cboconditions.Value) + ' ' Else lcCondition = Alltrim(.cbofieldnames.Value) + ' ' + Alltrim(Thisform.cboconditions.Value) + ' ' Endif *** Add the quotation marks if the field type is character If Inlist( Type(.calias+'.'+Alltrim(.cbofieldnames.Value)), 'C', 'D', 'T' ) lcCondition = lcCondition + Chr(39) + Upper(Alltrim(.txtvalues.Value)) + Chr(39) Else *********************************************************************** * Changed By.: Marcia G. Akins on 09 January 2003 * Reason.....: We need to check for logical values required, * ...........: but value entered is not .t. or .f. *********************************************************************** If Type( .calias + '.' + Alltrim( .cbofieldnames.Value ) ) = 'L' lcCondition = lcCondition + Iif( Not Empty( .txtvalues.Value ), '.T.', '.F.' ) Else lcCondition = lcCondition + Chrtran( Alltrim(.txtvalues.Value), Chr( 34 ) + Chr( 39 ) + Chr( 0 ), '' ) Endif Endif Endif *** If there are multiple conditions and them together .cfilter = Iif(Empty(.cfilter), lcCondition, .cfilter + ' AND ' + lcCondition) Endwith Thisform.edtfilter.Refresh() Endproc Procedure Init Lparameters tcALias Local lnFieldCnt, laFields[ 1 ], lnCnt, lcCaption, lcRowSource, lnArrayLen, lcTable, lnConn, laTables[ 1 ] With Thisform *** Save passed alias of so it can be used by the entire form .calias = tcALias laTables[ 1 ] = tcALias *** Get all the descriptions and the field names from SQl server *** GetFieldDescriptions Method creates a temporary file called csrFldDesc If Used( 'csrFldDesc' ) Select csrFldDesc Index On Upper( objName ) Tag objName Endif *** Now get a list of all the fields in the cursor *** Get all the field names in the passed alias lnFieldCnt = Afields( laFields, tcALias ) *** Don't include memo fields in the field list lnArrayLen = lnFieldCnt lnCnt = 1 Do While lnCnt <= lnArrayLen If lnCnt > lnFieldCnt Exit Endif If Type( tcALias + "." + laFields[ lnCnt, 1] ) = "M" Adel( laFields,lnCnt ) lnFieldCnt = lnFieldCnt - 1 Else lnCnt = lnCnt + 1 Endif Enddo *** Create a two-dimensional array of captions (if available) and field names *** loop throught he array of field names and see if we have a match in the *** field descriptions cursor Dimension .afieldnames[ lnFieldCnt, 2 ] For lnCnt = 1 To lnFieldCnt lcCaption = "" If Used( 'csrFldDesc' ) If Seek( Upper( Alltrim( laFields[ lnCnt, 1 ] ) ), 'csrFldDesc', 'objName' ) lcCaption = Padr( csrFldDesc.Value, 40 ) Endif Endif If Empty( lcCaption ) lcCaption = Padr( laFields[ lnCnt, 1 ], 40 ) Endif .afieldnames[ lnCnt,1 ] = lcCaption .afieldnames[ lnCnt,2 ] = Padr( laFields[ lnCnt, 1 ], 40 ) Endfor *** Now remove thing like wage information if the person does not have access lnFldCount = Alen( .afieldnames, 1 ) lnRow = Ascan( .afieldnames, 'WAGE', -1, -1, 2, 15 ) If lnRow > 0 Adel( .afieldnames, lnRow ) lnFldCount = lnFldCount - 1 Endif lnRow = Ascan( .afieldnames, 'WAGEEFFDATE', -1, -1, 2, 15 ) If lnRow > 0 Adel( .afieldnames, lnRow ) lnFldCount = lnFldCount - 1 Dimension .afieldnames[ lnFldCount, 2 ] Endif .cbofieldnames.Requery() .cbofieldnames.ListIndex = 1 Endwith Endproc Procedure Error Lparameters nError, cMethod, nLine Messagebox( 'Invalid Seach Criterion Specified. Please try again', 48, 'HR Status' ) Endproc Procedure txtdate.Valid *** put the convert the date value in the textbox *** to a datetime string so we can uery sql server If Not Empty( This.Value ) Thisform.txtvalues.Value = Dtoc( This.Value ) Else Thisform.txtvalues.Value = .Null. Endif Endproc Procedure cbofieldnames.Valid *** Make sure the data entry goes into the date text box *** if the selected field is a date or datetime field If Inlist( Type( Thisform.calias + '.' + Alltrim( This.Value ) ), 'D', 'T' ) Thisform.txtdate.ZOrder( 0 ) Else Thisform.txtdate.ZOrder( 1 ) Endif Endproc Procedure cboconditions.Init This.AddItem(" = ") This.AddItem(" > ") This.AddItem(" < ") This.AddItem(" <> ") Endproc Procedure cmdok.Click Thisform.Hide() Endproc Procedure cmdcancel.Click Thisform.cfilter = "" Thisform.Hide() Endproc Procedure cmdclearall.Click Thisform.cfilter = "" Thisform.edtfilter.Refresh() Endproc Procedure cmdaddcondition.Click Thisform.buildfilter() Endproc Enddefine