编程语言

img nhconch

过滤条件定义窗体(旧)

发表于2004/10/26 17:38:00  1600人阅读

//========================================================================
//  DESIGN BY :  彭国辉
//  DATE:        2004-07-20
//  SITE:       
http://kacarton.yeah.net/
//  BLOG:        http://blog.csdn.net/nhconch
//  EMAIL:       kacarton@sohu.com
//  文章为作者保留,请勿转载!
//  我的Blog:编程手札
http://blog.csdn.net/nhconch
//========================================================================

frm文件内容:(点击打开或折叠)
object frmTFilter: TfrmTFilter
  Left = 199
  Top = 117
  BorderStyle = bsDialog
  Caption = '定义筛选条件'
  ClientHeight = 343
  ClientWidth = 628
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = '宋体'
  Font.Style = []
  OldCreateOrder = False
  Position = poOwnerFormCenter
  ShowHint = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignSize = (
    628
    343)
  PixelsPerInch = 96
  TextHeight = 12
  object btnInfo1: TSpeedButton
    Left = 8
    Top = 40
    Width = 19
    Height = 19
    Enabled = False
    Flat = True
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000000000000000000000000
      8000008000000080800080000000800080008080000080808000C0C0C0000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFFFFFFFF0000FFFFFF9999999FFFFFFFFFFFFFFFFFFFFFFF
      0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFFFFF0000FFF999FF9999F999FFFF
      FFF22FFFFFFFFFFF0000FF999FFF9999FF999FFFFFF222FFFFFFFFFF0000FF99
      FFFF9999FFF99FFFFF2222FFFFFFFFFF0000F99FFFFF9999FFFF99FFFF22222F
      FFFFFFFF0000F99FFFFF9999FFFF99FFF222F22FFFFFFFFF0000F99FFFFF9999
      FFFF99FF222FF222FFFFFFFF0000F99FFFFF9999FFFF99FFFFFFFF222FFFFFFF
      0000F99FFFFF9999FFFF99FFFFFFFFF222FFFFFF0000F99FFFFFFFFFFFFF99FF
      FFFFFFFF22FFFFFF0000FF99FFFF9999FFF99FFFFFFFFFFFF22FFFFF0000FF99
      9FFF9999FF999FFFFFFFFFFFFF22FFFF0000FFF999FF9999F999FFFFFFFFFFFF
      FFF222FF0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFF22F0000FFFFFF999999
      9FFFFFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000}
    NumGlyphs = 2
    Visible = False
  end
  object btnInfo2: TSpeedButton
    Left = 8
    Top = 80
    Width = 19
    Height = 19
    Enabled = False
    Flat = True
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000000000000000000000000
      8000008000000080800080000000800080008080000080808000C0C0C0000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFFFFFFFF0000FFFFFF9999999FFFFFFFFFFFFFFFFFFFFFFF
      0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFFFFF0000FFF999FF9999F999FFFF
      FFF22FFFFFFFFFFF0000FF999FFF9999FF999FFFFFF222FFFFFFFFFF0000FF99
      FFFF9999FFF99FFFFF2222FFFFFFFFFF0000F99FFFFF9999FFFF99FFFF22222F
      FFFFFFFF0000F99FFFFF9999FFFF99FFF222F22FFFFFFFFF0000F99FFFFF9999
      FFFF99FF222FF222FFFFFFFF0000F99FFFFF9999FFFF99FFFFFFFF222FFFFFFF
      0000F99FFFFF9999FFFF99FFFFFFFFF222FFFFFF0000F99FFFFFFFFFFFFF99FF
      FFFFFFFF22FFFFFF0000FF99FFFF9999FFF99FFFFFFFFFFFF22FFFFF0000FF99
      9FFF9999FF999FFFFFFFFFFFFF22FFFF0000FFF999FF9999F999FFFFFFFFFFFF
      FFF222FF0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFF22F0000FFFFFF999999
      9FFFFFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000}
    NumGlyphs = 2
    Visible = False
  end
  object btnInfo3: TSpeedButton
    Left = 8
    Top = 120
    Width = 19
    Height = 19
    Enabled = False
    Flat = True
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000000000000000000000000
      8000008000000080800080000000800080008080000080808000C0C0C0000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFFFFFFFF0000FFFFFF9999999FFFFFFFFFFFFFFFFFFFFFFF
      0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFFFFF0000FFF999FF9999F999FFFF
      FFF22FFFFFFFFFFF0000FF999FFF9999FF999FFFFFF222FFFFFFFFFF0000FF99
      FFFF9999FFF99FFFFF2222FFFFFFFFFF0000F99FFFFF9999FFFF99FFFF22222F
      FFFFFFFF0000F99FFFFF9999FFFF99FFF222F22FFFFFFFFF0000F99FFFFF9999
      FFFF99FF222FF222FFFFFFFF0000F99FFFFF9999FFFF99FFFFFFFF222FFFFFFF
      0000F99FFFFF9999FFFF99FFFFFFFFF222FFFFFF0000F99FFFFFFFFFFFFF99FF
      FFFFFFFF22FFFFFF0000FF99FFFF9999FFF99FFFFFFFFFFFF22FFFFF0000FF99
      9FFF9999FF999FFFFFFFFFFFFF22FFFF0000FFF999FF9999F999FFFFFFFFFFFF
      FFF222FF0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFF22F0000FFFFFF999999
      9FFFFFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000}
    NumGlyphs = 2
    Visible = False
  end
  object btnInfo4: TSpeedButton
    Left = 8
    Top = 160
    Width = 19
    Height = 19
    Enabled = False
    Flat = True
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000000000000000000000000
      8000008000000080800080000000800080008080000080808000C0C0C0000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFFFFFFFF0000FFFFFF9999999FFFFFFFFFFFFFFFFFFFFFFF
      0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFFFFF0000FFF999FF9999F999FFFF
      FFF22FFFFFFFFFFF0000FF999FFF9999FF999FFFFFF222FFFFFFFFFF0000FF99
      FFFF9999FFF99FFFFF2222FFFFFFFFFF0000F99FFFFF9999FFFF99FFFF22222F
      FFFFFFFF0000F99FFFFF9999FFFF99FFF222F22FFFFFFFFF0000F99FFFFF9999
      FFFF99FF222FF222FFFFFFFF0000F99FFFFF9999FFFF99FFFFFFFF222FFFFFFF
      0000F99FFFFF9999FFFF99FFFFFFFFF222FFFFFF0000F99FFFFFFFFFFFFF99FF
      FFFFFFFF22FFFFFF0000FF99FFFF9999FFF99FFFFFFFFFFFF22FFFFF0000FF99
      9FFF9999FF999FFFFFFFFFFFFF22FFFF0000FFF999FF9999F999FFFFFFFFFFFF
      FFF222FF0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFF22F0000FFFFFF999999
      9FFFFFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000}
    NumGlyphs = 2
    Visible = False
  end
  object btnInfo5: TSpeedButton
    Left = 8
    Top = 200
    Width = 19
    Height = 19
    Enabled = False
    Flat = True
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000000000000000000000000
      8000008000000080800080000000800080008080000080808000C0C0C0000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFFFFFFFF0000FFFFFF9999999FFFFFFFFFFFFFFFFFFFFFFF
      0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFFFFF0000FFF999FF9999F999FFFF
      FFF22FFFFFFFFFFF0000FF999FFF9999FF999FFFFFF222FFFFFFFFFF0000FF99
      FFFF9999FFF99FFFFF2222FFFFFFFFFF0000F99FFFFF9999FFFF99FFFF22222F
      FFFFFFFF0000F99FFFFF9999FFFF99FFF222F22FFFFFFFFF0000F99FFFFF9999
      FFFF99FF222FF222FFFFFFFF0000F99FFFFF9999FFFF99FFFFFFFF222FFFFFFF
      0000F99FFFFF9999FFFF99FFFFFFFFF222FFFFFF0000F99FFFFFFFFFFFFF99FF
      FFFFFFFF22FFFFFF0000FF99FFFF9999FFF99FFFFFFFFFFFF22FFFFF0000FF99
      9FFF9999FF999FFFFFFFFFFFFF22FFFF0000FFF999FF9999F999FFFFFFFFFFFF
      FFF222FF0000FFFF999FFFFF999FFFFFFFFFFFFFFFFFF22F0000FFFFFF999999
      9FFFFFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000}
    NumGlyphs = 2
    Visible = False
  end
  object Label1: TLabel
    Left = 32
    Top = 232
    Width = 84
    Height = 12
    Caption = '筛选条件预览:'
  end
  object StaticText2: TStaticText
    Left = 8
    Top = 12
    Width = 495
    Height = 2
    Anchors = [akLeft, akTop, akRight]
    AutoSize = False
    BevelInner = bvNone
    BorderStyle = sbsSunken
    TabOrder = 0
  end
  object StaticText3: TStaticText
    Left = 515
    Top = 8
    Width = 2
    Height = 329
    Anchors = [akTop, akRight, akBottom]
    AutoSize = False
    BevelInner = bvNone
    BorderStyle = sbsSunken
    TabOrder = 1
  end
  object btnOK: TBitBtn
    Left = 531
    Top = 24
    Width = 81
    Height = 25
    Anchors = [akTop, akRight]
    Caption = '确定(&O)'
    TabOrder = 34
    Kind = bkOK
  end
  object btnCancel: TBitBtn
    Left = 531
    Top = 64
    Width = 81
    Height = 25
    Anchors = [akTop, akRight]
    Caption = '取消(&C)'
    TabOrder = 35
    Kind = bkCancel
  end
  object StaticText1: TStaticText
    Left = 74
    Top = 20
    Width = 28
    Height = 16
    Caption = '字段'
    TabOrder = 8
  end
  object chkIsField1: TCheckBox
    Tag = 1
    Left = 248
    Top = 42
    Width = 41
    Height = 17
    Caption = '字段'
    TabOrder = 11
    OnClick = chkIsFieldClick
  end
  object cbbLogical1: TComboBox
    Tag = 1
    Left = 416
    Top = 40
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    ItemIndex = 0
    TabOrder = 13
    Text = '与(AND)'
    OnChange = SettingChange
    Items.Strings = (
      '与(AND)'
      '或(OR)')
  end
  object cbbValue1: TComboBox
    Tag = 1
    Left = 296
    Top = 40
    Width = 113
    Height = 20
    Style = csSimple
    ItemHeight = 12
    TabOrder = 12
    OnChange = SettingChange
  end
  object cbbOperators1: TComboBox
    Tag = 1
    Left = 152
    Top = 40
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 10
    OnChange = SettingChange
    Items.Strings = (
      '='
      '<>'
      '>'
      '>='
      '<'
      '<='
      '包含'
      '不包含')
  end
  object cbbFields1: TComboBox
    Tag = 1
    Left = 32
    Top = 40
    Width = 113
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 9
    OnChange = cbbFieldsChange
  end
  object StaticText4: TStaticText
    Left = 176
    Top = 20
    Width = 40
    Height = 16
    Caption = '运算符'
    TabOrder = 6
  end
  object StaticText5: TStaticText
    Left = 323
    Top = 20
    Width = 58
    Height = 16
    Caption = '值/字段值'
    TabOrder = 5
  end
  object StaticText6: TStaticText
    Left = 422
    Top = 20
    Width = 76
    Height = 16
    Caption = '条件间的关系'
    TabOrder = 3
  end
  object StaticText7: TStaticText
    Left = 148
    Top = 14
    Width = 1
    Height = 215
    AutoSize = False
    BorderStyle = sbsSunken
    TabOrder = 2
  end
  object StaticText8: TStaticText
    Left = 244
    Top = 14
    Width = 1
    Height = 215
    AutoSize = False
    BorderStyle = sbsSunken
    TabOrder = 4
  end
  object StaticText9: TStaticText
    Left = 412
    Top = 14
    Width = 1
    Height = 215
    AutoSize = False
    BorderStyle = sbsSunken
    TabOrder = 7
  end
  object cbbFields2: TComboBox
    Tag = 2
    Left = 32
    Top = 80
    Width = 113
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 14
    OnChange = cbbFieldsChange
  end
  object cbbOperators2: TComboBox
    Tag = 2
    Left = 152
    Top = 80
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 15
    OnChange = SettingChange
    Items.Strings = (
      '='
      '<>'
      '>'
      '>='
      '<'
      '<='
      '包含'
      '不包含')
  end
  object chkIsField2: TCheckBox
    Tag = 2
    Left = 248
    Top = 82
    Width = 41
    Height = 17
    Caption = '字段'
    TabOrder = 16
    OnClick = chkIsFieldClick
  end
  object cbbValue2: TComboBox
    Tag = 2
    Left = 296
    Top = 80
    Width = 113
    Height = 20
    Style = csSimple
    ItemHeight = 12
    TabOrder = 17
    OnChange = SettingChange
  end
  object cbbLogical2: TComboBox
    Tag = 2
    Left = 416
    Top = 80
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    ItemIndex = 0
    TabOrder = 18
    Text = '与(AND)'
    OnChange = SettingChange
    Items.Strings = (
      '与(AND)'
      '或(OR)')
  end
  object cbbLogical3: TComboBox
    Tag = 3
    Left = 416
    Top = 120
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    ItemIndex = 0
    TabOrder = 23
    Text = '与(AND)'
    OnChange = SettingChange
    Items.Strings = (
      '与(AND)'
      '或(OR)')
  end
  object cbbValue3: TComboBox
    Tag = 3
    Left = 296
    Top = 120
    Width = 113
    Height = 20
    Style = csSimple
    ItemHeight = 12
    TabOrder = 22
    OnChange = SettingChange
  end
  object chkIsField3: TCheckBox
    Tag = 3
    Left = 248
    Top = 122
    Width = 41
    Height = 17
    Caption = '字段'
    TabOrder = 21
    OnClick = chkIsFieldClick
  end
  object cbbOperators3: TComboBox
    Tag = 3
    Left = 152
    Top = 120
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 20
    OnChange = SettingChange
    Items.Strings = (
      '='
      '<>'
      '>'
      '>='
      '<'
      '<='
      '包含'
      '不包含')
  end
  object cbbFields3: TComboBox
    Tag = 3
    Left = 32
    Top = 120
    Width = 113
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 19
    OnChange = cbbFieldsChange
  end
  object cbbLogical4: TComboBox
    Tag = 4
    Left = 416
    Top = 160
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    ItemIndex = 0
    TabOrder = 28
    Text = '与(AND)'
    OnChange = SettingChange
    Items.Strings = (
      '与(AND)'
      '或(OR)')
  end
  object cbbValue4: TComboBox
    Tag = 4
    Left = 296
    Top = 160
    Width = 113
    Height = 20
    Style = csSimple
    ItemHeight = 12
    TabOrder = 27
    OnChange = SettingChange
  end
  object chkIsField4: TCheckBox
    Tag = 4
    Left = 248
    Top = 162
    Width = 41
    Height = 17
    Caption = '字段'
    TabOrder = 26
    OnClick = chkIsFieldClick
  end
  object cbbOperators4: TComboBox
    Tag = 4
    Left = 152
    Top = 160
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 25
    OnChange = SettingChange
    Items.Strings = (
      '='
      '<>'
      '>'
      '>='
      '<'
      '<='
      '包含'
      '不包含')
  end
  object cbbFields4: TComboBox
    Tag = 4
    Left = 32
    Top = 160
    Width = 113
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 24
    OnChange = cbbFieldsChange
  end
  object cbbLogical5: TComboBox
    Tag = 5
    Left = 416
    Top = 200
    Width = 89
    Height = 20
    Style = csDropDownList
    Enabled = False
    ItemHeight = 12
    ItemIndex = 0
    TabOrder = 33
    Text = '与(AND)'
    OnChange = SettingChange
    Items.Strings = (
      '与(AND)'
      '或(OR)')
  end
  object cbbValue5: TComboBox
    Tag = 5
    Left = 296
    Top = 200
    Width = 113
    Height = 20
    Style = csSimple
    ItemHeight = 12
    TabOrder = 32
    OnChange = SettingChange
  end
  object chkIsField5: TCheckBox
    Tag = 5
    Left = 248
    Top = 202
    Width = 41
    Height = 17
    Caption = '字段'
    TabOrder = 31
    OnClick = chkIsFieldClick
  end
  object cbbOperators5: TComboBox
    Tag = 5
    Left = 152
    Top = 200
    Width = 89
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 30
    OnChange = SettingChange
    Items.Strings = (
      '='
      '<>'
      '>'
      '>='
      '<'
      '<='
      '包含'
      '不包含')
  end
  object cbbFields5: TComboBox
    Tag = 5
    Left = 32
    Top = 200
    Width = 113
    Height = 20
    Style = csDropDownList
    ItemHeight = 12
    TabOrder = 29
    OnChange = cbbFieldsChange
  end
  object txtFilter: TStaticText
    Left = 32
    Top = 248
    Width = 471
    Height = 83
    Anchors = [akLeft, akTop, akRight, akBottom]
    AutoSize = False
    BorderStyle = sbsSunken
    TabOrder = 36
  end
end

PAS文件:

unit FormTFilter;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Buttons, DB, StrUtils;

type
  TComponentType = (ctField, ctOperator, ctCheckBox, ctValue, ctLogical);
  TFilterString = record
    FilterStr, DisplayText, ErrorStr: String;
  end;
  TfrmTFilter = class(TForm)
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    cbbFields1: TComboBox;
    cbbOperators1: TComboBox;
    cbbValue1: TComboBox;
    chkIsField1: TCheckBox;
    cbbLogical1: TComboBox;
    StaticText4: TStaticText;
    StaticText5: TStaticText;
    StaticText6: TStaticText;
    StaticText7: TStaticText;
    StaticText8: TStaticText;
    StaticText9: TStaticText;
    cbbFields2: TComboBox;
    cbbOperators2: TComboBox;
    chkIsField2: TCheckBox;
    cbbValue2: TComboBox;
    cbbLogical2: TComboBox;
    cbbLogical3: TComboBox;
    cbbValue3: TComboBox;
    chkIsField3: TCheckBox;
    cbbOperators3: TComboBox;
    cbbFields3: TComboBox;
    cbbLogical4: TComboBox;
    cbbValue4: TComboBox;
    chkIsField4: TCheckBox;
    cbbOperators4: TComboBox;
    cbbFields4: TComboBox;
    cbbLogical5: TComboBox;
    cbbValue5: TComboBox;
    chkIsField5: TCheckBox;
    cbbOperators5: TComboBox;
    cbbFields5: TComboBox;
    txtFilter: TStaticText;
    btnInfo1: TSpeedButton;
    btnInfo2: TSpeedButton;
    btnInfo3: TSpeedButton;
    btnInfo4: TSpeedButton;
    btnInfo5: TSpeedButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cbbFieldsChange(Sender: TObject);
    procedure chkIsFieldClick(Sender: TObject);
    procedure SettingChange(Sender: TObject);
  private
    Fields: TFields;
    FFilterString: String;
    procedure ListFieldsToComboBox(cbbTarget: TCombobox);
    procedure SetFilterString(const Value: String);
    procedure SynchronizeFilterString;
    function ParseFilter(Field: TField; Opeartor:String; cbbValue: TComboBox): TFilterString;

  public
    property FilterString: String read FFilterString write SetFilterString;

  end;

var
  frmTFilter: TfrmTFilter;

implementation

{$R *.dfm}

uses FormTList;

{ TfrmTFilter }

procedure TfrmTFilter.FormCreate(Sender: TObject);
var
    i: Integer;
begin
    if not (Owner is TfrmTList) then raise EComponentError.CreateFmt('建立窗体时发生错误,错误描述如下:'#13#10'  窗体的属主必须为TfrmTList对象或继承于TfrmTList对象,但实际中使用了%s', [Owner.ClassName]);
    Fields := (Owner as TfrmTList).ADODataSet1.Fields;
    for i:=1 to 5 do
    begin   //将有效字段添加到所有cbbFields、cbbValue中
        ListFieldsToComboBox(TComboBox(Self.FindComponent('cbbFields'+IntToStr(i))));
        ListFieldsToComboBox(TComboBox(Self.FindComponent('cbbValue'+IntToStr(i))));
    end;
end;

procedure TfrmTFilter.FormDestroy(Sender: TObject);
begin
    Fields := nil;
end;

procedure TfrmTFilter.ListFieldsToComboBox(cbbTarget: TCombobox);
var
    i: Integer;
begin
    //添加字段到指定的ComboBox,ComboBox显示为Field.DisplayLabel,
    //可通过ComboBox.Items.Objects[ComboBox.ItemIndex]得到对应字段
    //不添加Blob、Graphic、OLE、Reference、Bytes等特殊类型的字段
    //只添加FieldKind为fkData、fkLookup的字段
    cbbTarget.Items.Clear;
    for i:=0 to Fields.Count-1 do
        if (not (Fields[i].DataType in [ftUnknown, ftBlob, ftGraphic, ftBytes, ftVarBytes, ftParadoxOle, ftDBaseOle, ftCursor, ftADT, ftArray, ftReference, ftDataSet]))
        and (Fields[i].Visible) and (Fields[i].FieldKind=fkData) then
            cbbTarget.Items.AddObject(Fields[i].DisplayLabel, Fields[i]);
end;

procedure TfrmTFilter.cbbFieldsChange(Sender: TObject);
var
    cbbOperators: TComboBox;
begin
    //根据选择字段类型不同,刷新操作符列表
    cbbOperators := TComboBox(Self.FindComponent('cbbOperators'+IntToStr((Sender as TComponent).Tag)));
    if cbbOperators = nil then raise EComponentError.CreateFmt('刷新操作符列表时发生错误,错误描述如下:'#13#10'  试图刷新不存在的组件%s', ['cbbOperators'+IntToStr((Sender as TComponent).Tag)]);
    cbbOperators.Items.Clear;
    with (Sender as TComboBox) do begin
        case TField(Items.Objects[ItemIndex]).DataType of
            ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString:
              begin
                cbbOperators.Items.Add('=');
                cbbOperators.Items.Add('<>');
                cbbOperators.Items.Add('以..开头');
                cbbOperators.Items.Add('包含');
                cbbOperators.Items.Add('不包含');
              end;
            ftBoolean:
              begin
                cbbOperators.Items.Add('=');
                cbbOperators.Items.Add('<>');
              end;
            ftSmallInt, ftInteger, ftWord, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime, ftBCD, ftAutoInc, ftTypedBinary, ftLargeInt:
              begin
                cbbOperators.Items.Add('=');
                cbbOperators.Items.Add('<>');
                cbbOperators.Items.Add('>');
                cbbOperators.Items.Add('>=');
                cbbOperators.Items.Add('<');
                cbbOperators.Items.Add('<=');
              end;
        end;
    end;
    SynchronizeFilterString;
end;

procedure TfrmTFilter.chkIsFieldClick(Sender: TObject);
var
    cbbValue: TComboBox;
begin
    cbbValue := TComboBox(Self.FindComponent('cbbValue'+IntToStr((Sender as TComponent).Tag)));
    if cbbValue = nil then raise EComponentError.CreateFmt('试图切换值/字段值编辑框时发生错误,错误描述如下:'#13#10'  试图刷新不存在的组件%s', ['cbbValue'+IntToStr((Sender as TComponent).Tag)]);
    if (Sender as TCheckBox).Checked then cbbValue.Style := csDropDownList
    else cbbValue.Style := csSimple;
    SynchronizeFilterString;
end;

procedure TfrmTFilter.SetFilterString(const Value: String);
begin
    //TODO:根据Value内容更新各控件(不是必须)
    FFilterString := Value;
end;

procedure TfrmTFilter.SynchronizeFilterString;
var
    cbbField, cbbOpeartor, cbbValue, cbbLogical: TComboBox;
    chkIsField: TCheckBox;
    btnInfo: TSpeedButton;
    i: Integer;
    FilterStr: TFilterString;
    LogicalStr: String;
begin
    //刷新过滤条件,包括FilterString、txtFilter.Caption,并用btnInfo显示正确或错误提示
    //cbbFieldsX、cbbOpeartorsX、cbbValueX、cbbLogicalX、chkIsFieldX、btnInfoX视为一组
    //ParseFilter按每组设置返回TFilterString(结构),包含过滤字串、显示用的文本和错误提示信息
    txtFilter.Caption := '';
    FFilterString := '';
    LogicalStr := '';
    for i:=1 to 5 do begin
        cbbField := TComboBox(Self.FindComponent('cbbFields'+IntToStr(i)));
        cbbOpeartor := TComboBox(Self.FindComponent('cbbOperators'+IntToStr(i)));
        cbbValue := TComboBox(Self.FindComponent('cbbValue'+IntToStr(i)));
        cbbLogical := TComboBox(Self.FindComponent('cbbLogical'+IntToStr(i)));
        chkIsField := TCheckBox(Self.FindComponent('chkIsField'+IntToStr(i)));
        btnInfo := TSpeedButton(Self.FindComponent('btnInfo'+IntToStr(i)));
        if (cbbField<>nil) and (cbbOpeartor<>nil) and (cbbValue<>nil) and (cbbLogical<>nil)
         and (chkIsField<>nil) and (btnInfo<>nil) and (cbbField.ItemIndex<>-1) then begin
            FilterStr := ParseFilter(TField(cbbField.Items.Objects[cbbField.ItemIndex]), cbbOpeartor.Text, cbbValue);
            if FilterStr.FilterStr<>'' then begin
                //分别处理FilterString和显示用的过滤条件文本
                FFilterString := IfThen(FFilterString<>'', '(' + FFilterString + ') ', '') + IfThen(i>0, LogicalStr, '') + FilterStr.FilterStr;
                txtFilter.Caption := IfThen(txtFilter.Caption<>'', '(' + txtFilter.Caption + ')', '') + IfThen(i>0, LogicalStr, '') + FilterStr.DisplayText;
                LogicalStr := IfThen(cbbLogical.ItemIndex=0, ' AND ', ' OR ');
                //让控钮显示表示正确的绿色勾子
                btnInfo.Enabled := false;
                btnInfo.Visible := true;
            end else begin
                if FilterStr.ErrorStr='' then
                    btnInfo.Visible := false    //返回值全为空字串,说明用户没有使用控件组
                else begin
                    //显示错误提示
                    btnInfo.Enabled := true;
                    btnInfo.Hint := FilterStr.ErrorStr;
                    btnInfo.Visible := true;
                end;
            end;
        end;
    end;
end;

function TfrmTFilter.ParseFilter(Field: TField; Opeartor:String; cbbValue: TComboBox): TFilterString;
begin
    //根据参数返回相应的过滤字串
    Result.FilterStr := '';
    Result.DisplayText := '';
    Result.ErrorStr := '';
    if (Opeartor='') or (cbbValue.Text='') then Exit;
    if (cbbValue.Style<>csSimple) and (cbbValue.ItemIndex=-1) then Exit;
    case Field.DataType of  //根据字段类型处理方式略有区别
        ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString:
          begin
            if cbbValue.Style=csSimple then begin
                if (Opeartor='=') or (Opeartor='<>') then begin
                    Result.FilterStr := Format('%s%s''%s''', [Field.FieldName, Opeartor, cbbValue.Text]);
                    Result.DisplayText := Format('%s%s''%s''', [Field.DisplayLabel, Opeartor, cbbValue.Text]);
                end;
                if Opeartor='以..开头' then begin
                    Result.FilterStr := '(' + Field.FieldName + ' like ''' + Trim(cbbValue.Text) + '%'')';
                    Result.DisplayText := '(' + Field.DisplayLabel + ' 以''' + Trim(cbbValue.Text) + '''开头)';
                end;
                if Opeartor='包含' then begin
                    Result.FilterStr := '(' + Field.FieldName + ' like ''%' + Trim(cbbValue.Text) + '%'')';
                    Result.DisplayText := '(' + Field.DisplayLabel + ' 包含 ''' + Trim(cbbValue.Text) + ''')';
                end;
                if Opeartor='不包含' then begin
                    Result.FilterStr := '(' + Field.FieldName + ' not like ''%' + Trim(cbbValue.Text) + '%'')';
                    Result.DisplayText := '(' + Field.DisplayLabel + ' 不包含 ''' + Trim(cbbValue.Text) + ''')';
                end;
            end else begin
                if not (TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).DataType in [ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString]) then begin
                    Result.ErrorStr := '指定的两个字段数据类型差异太大,不能用作比较';
                    Exit;
                end;
                if (Opeartor='=') or (Opeartor='<>') then begin
                    Result.FilterStr := Format('%s%s%s', [Field.FieldName, Opeartor, TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).FieldName]);
                    Result.DisplayText := Format('%s%s%s', [Field.DisplayLabel, Opeartor, cbbValue.Text]);
                end;
                if (Opeartor='以..开头') or (Opeartor='包含') or (Opeartor='不包含') then begin Result.ErrorStr:='两字段与字段间不能使用“以..开头”、“包含”或“不包含”操作符'; Exit; end;
            end;
          end;
        ftDate, ftTime, ftDateTime:
          begin
            if cbbValue.Style=csSimple then begin
                try
                    StrToDateTime(cbbValue.Text)
                except
                    Result.ErrorStr := '“值/字段值”内容不是有效的日期/时间格式';
                    Exit;
                end;
                Result.FilterStr := Field.FieldName + Opeartor + '''' + Trim(cbbValue.Text) + '''';
                Result.DisplayText := Field.DisplayLabel + Opeartor + '''' + Trim(cbbValue.Text) + '''';
            end else begin
                if not (TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).DataType in [ftDate, ftTime, ftDateTime]) then begin
                    Result.ErrorStr := '指定的两个字段数据类型不同,不能用作比较';
                    Exit;
                end;
                Result.FilterStr := Field.FieldName + Opeartor + TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).FieldName;
                Result.DisplayText := Field.DisplayLabel + Opeartor + '''' + Trim(cbbValue.Text) + '''';
            end;
          end;
        ftBoolean:
          begin
            if cbbValue.Style=csSimple then begin
                try
                    StrToBool(cbbValue.Text)
                except
                    Result.ErrorStr := '“值/字段值”内容必须为布尔类型';
                    Exit;
                end;
                Result.FilterStr := Field.FieldName + Opeartor + BoolToStr(StrToBool(cbbValue.Text));
                Result.DisplayText := Field.DisplayLabel + Opeartor + BoolToStr(StrToBool(cbbValue.Text));
            end else begin
                if TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).DataType <> ftBoolean then begin
                    Result.ErrorStr := '指定的两个字段数据类型不同,不能用作比较';
                    Exit;
                end;
                Result.FilterStr := Field.FieldName + Opeartor + TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).FieldName;
                Result.DisplayText := Field.DisplayLabel + Opeartor + BoolToStr(StrToBool(cbbValue.Text));
            end;
          end;
        ftSmallInt, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftAutoInc, ftTypedBinary, ftLargeInt:
          begin
            if cbbValue.Style=csSimple then begin
                try
                    StrToFloat(cbbValue.Text)
                except
                    Result.ErrorStr := '“值/字段值”内容无效';
                    Exit;
                end;
                Result.FilterStr := Field.FieldName + Opeartor + cbbValue.Text;
                Result.DisplayText := Field.DisplayLabel + Opeartor + cbbValue.Text;
            end else begin
                if not (TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).DataType in [ftSmallInt, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftAutoInc, ftTypedBinary, ftLargeInt]) then begin
                    Result.ErrorStr := '指定的两个字段数据类型差异太大,不能用作比较';
                    Exit;
                end;
                Result.FilterStr := Field.FieldName + Opeartor + TField(cbbValue.Items.Objects[cbbValue.ItemIndex]).FieldName;
                Result.DisplayText := Field.DisplayLabel + Opeartor + cbbValue.Text;
            end;
          end;
    end;
end;

procedure TfrmTFilter.SettingChange(Sender: TObject);
begin
    SynchronizeFilterString;
end;

end.

调用:

procedure TfrmTList.btnFilterConstraintClick(Sender: TObject);
var
    AllowExit: Boolean;
begin
    AllowExit := false;
    if frmFilter.ShowModal=mrCancel then AllowExit := true;
    while not AllowExit do
    try
        ADODataSet1.Filter := frmFilter.FilterString;
        ADODataSet1.Filtered := true;
        FilterStr := frmFilter.FilterString;
        AllowExit := true;
        btnFilter.Down := true;
    except
        MessageBox(Handle, '对不起,您的筛选条件被数据集拒绝,您可以尝试改变条件或调整它们的顺序', '定义筛选条件', MB_OK+MB_ICONERROR);
        if frmFilter.ShowModal=mrCancel then AllowExit := true;
    end;
end;
阅读全文
0 0

相关文章推荐

img
取 消
img