Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Simple filter builder screen
Message
From
20/10/2008 10:44:58
 
 
To
20/10/2008 00:13:14
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Vista
Network:
Windows 2008 Server
Database:
MS SQL Server
Miscellaneous
Thread ID:
01355811
Message ID:
01355895
Views:
33
I guess, free and ideally nice looking scx screen ( or class if you like ) which helps an application user to enter moderately simple filter condition that can be applied to a single table - should exist somewhere.
**************************************************
*-- 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
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform