Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Simple filter builder screen
Message
De
20/10/2008 12:22:23
Jay Johengen
Altamahaw-Ossipee, Caroline du Nord, États-Unis
 
 
À
20/10/2008 10:44:58
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire d'écran & Écrans
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Vista
Network:
Windows 2008 Server
Database:
MS SQL Server
Divers
Thread ID:
01355811
Message ID:
01355918
Vues:
29
Where were you when I needed this a couple months ago?!

Very nicely done.


>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
>
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform