filter.pas

来自「IT业进销存管理系统源代码Delphi」· PAS 代码 · 共 764 行 · 第 1/2 页

    with StringGrid1, StringGrid1.Canvas do
    begin
      if (Trim(Cells[2, ARow]) <> '') or (Pos('空值', Cells[1, ARow]) > 0) then
      begin
        Brush.Color := clInfoBk;
        Pen.Color := clWindowText;
      end
      else
      begin
        Brush.Color := clWhite;
        Pen.Color := clWindowText;
      end;
      if (ARow = StringGrid1.Row) and (ACol = StringGrid1.Col) then
      begin
        Brush.Color := clHighlight;
        Pen.Color := clHighlightText;
      end;
      TextRect(rect, rect.Left + 2, rect.Top + 2, Cells[ACol, ARow]);
      if ACol = 2 then
        for i := 0 to ColCount do
          if i <> 2 then
            Cells[i, ARow] := Cells[i, ARow];
    end;
end;

//btnOk.Click
procedure TfrmFilter.btnOkClick(Sender: TObject);
var
  i, j: integer;
  strNy, strCaptions, s: string;
  fdTmp: TField;
begin
  screen.Cursor := crHourGlass;
  iniPos := TiniFile.Create(strFileName);
  strFt := '';
  strCaptions := '';
  with StringGrid1 do
    for i := 1 to RowCount - 1 do
    begin
      Cells[2, i] := Trim(Cells[2, i]);
      if (Cells[2, i] <> '') or (Pos('空值', Cells[1, i]) > 0) then
      begin
        if strCaptions <> '' then
          strCaptions := strCaptions + ';' + Cells[0, i]
        else
          strCaptions := Cells[0, i];
        fdTmp := FieldOf(dsFt, Cells[0, i]);
        //Save
        if Pos('空值', Cells[1, i]) = 0 then
        begin
          iniPos.WriteInteger('', 'Row', i);
          s := iniPos.ReadString('', Cells[0, i], '');
          s := StringReplace(s, Cells[2, i] + '|', '', [rfReplaceAll, rfIgnoreCase]);
          s := Cells[2, i] + '|' + s;
          j := PosPlus('|', s, 20);
          if j > 0 then
            s := Copy(s, 1, j);
          iniPos.WriteString('', Cells[0, i], s);
        end;
        //
        if (Cells[2, i] <> '') then
          strNy := GetFilterString(fdTmp, i)
        else
          strNy := ' ';
        if (strNy <> '') or (Pos('空值', Cells[1, i]) > 0) then
        begin
          if (strNy <> '') and (Pos('空值', Cells[1, i]) = 0) then
            //Save to AppFilter
            with Data.Tmp do
            begin
              Close;
              CommandText := 'select * from AppFilter ' +
                'where uID = ' + IntToStr(pintUserId) + ' and ' +
                'FormCaption = ''' + Application.MainForm.ActiveMDIChild.Name + ''' and ' +
                'FieldCaption = ''' + Cells[0, i] + '''';
              Open;
              if IsEmpty then
              begin
                Close;
                CommandText := 'Insert into AppFilter ' +
                  '(uID, FormCaption, FieldCaption, FieldIndex, Bjfs, UseCount) ' +
                  'select ' + IntToStr(pintUserId) + ', ''' +
                  Application.MainForm.ActiveMDIChild.Name + ''', ''' +
                  Cells[0, i] + ''',' +
                  IntToStr(fdTmp.Index) + ',''' +
                  Cells[1, i] + ''', 1';
              end
              else
              begin
                Close;
                CommandText := 'update AppFilter ' +
                  'set UseCount = UseCount + 1, ' +
                  'Bjfs = ''' + Cells[1, i] + ''' ' +
                  'where uID = ' + IntToStr(pintUserId) + ' and ' +
                  'FormCaption = ''' + Application.MainForm.ActiveMDIChild.Name + ''' and ' +
                  'FieldCaption = ''' + Cells[0, i] + '''';
              end;
              Execute;
            end;
          case fdTmp.DataType of
            ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftLargeInt,
            ftDateTime, ftDate:
              //数值 或 日期
              begin
                if (Cells[1, i] = '等于') or (Cells[1, i] = '全等于') then
                  strNy := '(' + fdTmp.FieldName + ' = ' + #39 + strNy + #39 + ')'
                else if Cells[1, i] = '不等于' then
                  strNy := '(' + fdTmp.FieldName + ' <> ' + #39 + strNy + #39 + ')'
                else if Cells[1, i] = '大于' then
                  strNy := '(' + fdTmp.FieldName + ' > ' + #39 + strNy + #39 + ')'
                else if Cells[1, i] = '小于' then
                  strNy := '(' + fdTmp.FieldName + ' < ' + #39 + strNy + #39 + ')'
                else if Cells[1, i] = '大于等于' then
                  strNy := '(' + fdTmp.FieldName + ' >= ' + #39 + strNy + #39 + ')'
                else if Cells[1, i] = '小于等于' then
                  strNy := '(' + fdTmp.FieldName + ' <= ' + #39 + strNy + #39 + ')'
                else if Cells[1, i] = '为空值' then
                  if fdTmp.DataType in [ftDateTime, ftDate] then
                    strNy := '(' + fdTmp.FieldName + ' = null)'
                  else
                    strNy := '(' + fdTmp.FieldName + ' = 0)'
                else if Cells[1, i] = '不为空值' then
                  if fdTmp.DataType in [ftDateTime, ftDate] then
                    strNy := '(' + fdTmp.FieldName + ' <> null)'
                  else
                    strNy := '(' + fdTmp.FieldName + ' <> 0)'
                else
                begin
                  Application.MessageBox(PChar('''' + Cells[0, i] + '''不能用''' + Cells[1, i] + '''进行比较, 请重新选择.'), '资料查询', MB_OK + MB_ICONWARNING);
                  Col := 1;
                  Row := i;
                  SetFocus;
                  Abort;
                end;
              end;
          else
            //字符
            if Cells[1, i] = '等于' then
            begin
              if pDataBaseType = 'SERVER' then
                strNy := '(' + fdTmp.FieldName + ' = ' + #39 + strNy + '*' + #39 + ')'
              else
                strNy := '(' + fdTmp.FieldName + ' like ' + #39 + strNy + '%' + #39 + ')';
            end
            else if Cells[1, i] = '不等于' then
              strNy := '(' + fdTmp.FieldName + ' <> ' + #39 + strNy + #39 + ')'
            else if Cells[1, i] = '全等于' then
              strNy := '(' + fdTmp.FieldName + ' = ' + #39 + strNy + #39 + ')'
            else if Cells[1, i] = '大于' then
              strNy := '(' + fdTmp.FieldName + ' > ' + #39 + strNy + #39 + ')'
            else if Cells[1, i] = '小于' then
              strNy := '(' + fdTmp.FieldName + ' < ' + #39 + strNy + #39 + ')'
            else if Cells[1, i] = '大于等于' then
              strNy := '(' + fdTmp.FieldName + ' >= ' + #39 + strNy + #39 + ')'
            else if Cells[1, i] = '小于等于' then
              strNy := '(' + fdTmp.FieldName + ' <= ' + #39 + strNy + #39 + ')'
            else if Cells[1, i] = '为空值' then
              strNy := '(' + fdTmp.FieldName + ' = null)'
            else if Cells[1, i] = '不为空值' then
              strNy := '(' + fdTmp.FieldName + ' <> null)'
            else if Cells[1, i] = '包含' then
              strNy := '(' + fdTmp.FieldName + ' like ' + #39 + '%' + strNy + '%' + #39 + ')';
          end;
          //累加
          if Cells[3, i] = '并且' Then
            strFt := strFt + ' ' + strNy + ' and'
          else
            strFt := strFt + ' ' + strNy + ' or ';
        end
        else
        begin
          screen.Cursor := crDefault;
          Col := 2;
          Row := i;
          SetFocus;
          Abort;
        end;
      end;
    end;
  strFt := trim(strFt);
  if strFt = '' then
    Application.MessageBox('没有输入有效的查询条件, 本次查询将被取消.', '资料查询', MB_OK + MB_ICONWARNING)
  else
    if (Copy(strFt, Length(strFt) - 2, 3) = 'and') or (Copy(strFt,Length(strFt) - 2, 3) = 'or ') Then
      Delete(strFt, Length(strFt) - 2, 3);
  if Application.MainForm.ActiveMDIChild is TfrmComJbzl then
    TfrmComJbzl(Application.MainForm.ActiveMDIChild).labSearch.Caption :=
      '查询项目: ' + strCaptions;
  iniPos.Free;
  screen.Cursor := crDefault;
  Close;
end;

//btnIni.Click
procedure TfrmFilter.btnIniClick(Sender: TObject);
begin
  AFormName := '';
  with Data.Tmp do
  begin
    Close;
    CommandText := 'delete from AppFilter ' +
      'where uID = ' + IntToStr(pintUserId) + ' and ' +
      'FormCaption = ''' + Application.MainForm.ActiveMDIChild.Name + '''';
    Execute;
  end;
end;

//GetFilterString
function TfrmFilter.GetFilterString(const AFd: TField; const ARow: Integer): string;
var
  i: integer;
begin
  result := '';
  with StringGrid1 do
  begin
    case AFd.DataType of
      ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftLargeInt:
        begin
          result := Cells[2, ARow];
          while Pos(',', result) > 0 do
            result := Copy(result, 1, Pos(',', result) - 1 )
              + Copy(result, Pos(',', result) + 1, Length(result) - Pos(',', result) );
          result := IsVisibleNumber(result);
          if result = '' then
            Application.MessageBox(PChar('在''' + Cells[0, ARow] + '''中输入的''' + Cells[2, ARow] + '''不是有效数值, 请重新输入.'), '资料查询', MB_OK + MB_ICONWARNING);
        end;
      ftDateTime, ftDate:
        begin
          result := Cells[2, ARow];
          for i := 1 to Length(result) do
            if result[i] in ['/','.'] then
              result[i] := '-';
          result := IsVisibleDate(result);
          if result = '' then
            Application.MessageBox(PChar('在''' + Cells[0, ARow] + '''中输入的''' + Cells[0, ARow] + '''不是有效日期, 请重新输入.'), '资料查询', MB_OK + MB_ICONWARNING);
        end;
    else
      if (Length(Cells[2, ARow]) > AFd.Size ) Then
        Application.MessageBox(PChar('在''' + Cells[0, ARow] + '''中输入的查询内容太长, 请重新输入.'), '资料查询', MB_OK + MB_ICONWARNING)
      else
        result := Cells[2, ARow];
    end;
  end;
end;

//FieldOf
function TfrmFilter.FieldOf(Data: TDataSet; FieldCaption: String): TField;
begin
  result := TField(slField.Objects[slField.IndexOf(FieldCaption)]);
{  for i:= 0 To Data.FieldCount - 1 do
    if Data.Fields[i].DisplayLabel = FieldCaption then
    begin
      result := Data.Fields[i];
      break;
    end;}
end;

//IsVisibleNumber
function TfrmFilter.IsVisibleNumber(const s: string): string;
begin
  try
    StrToFloat(s);
    result := s;
  except
    result := '';
  end;
end;

//IsVisibleDate
function TfrmFilter.IsVisibleDate(const s: string): string;
begin
  try
    StrToDate(s);
    result := s;
  except
    result := '';
  end;
end;

//btnClear.Click
procedure TfrmFilter.btnClearClick(Sender: TObject);
var
  i: integer;
begin
  with StringGrid1 do
    for i := 1 to RowCount - 1 do
      Cells[2, i] := '';
end;

//CheckBox1.Click
procedure TfrmFilter.CheckBox1Click(Sender: TObject);
begin
  StringGrid1.SetFocus;
end;

//OpenListBox
procedure TfrmFilter.OpenListBox;
var
  i: integer;
  s, t: string;
begin
  if StringGrid1.Col <> 2 then Exit;
  iniPos := TiniFile.Create(strFileName);
  with StringGrid1 do
  begin
    btnCancel.Cancel := False;
    ListBox1.Top := CellRect(Col, Row).Top + Top + DefaultRowHeight + 1;
    if ListBox1.Top + ListBox1.Height + 22 >= self.Height then
      ListBox1.Top := CellRect(Col, Row).Top + Top - ListBox1.Height - 1;
    //Load
    ListBox1.Items.Clear;
    s := iniPos.ReadString('', Cells[0, Row], '');
    repeat
      i := Pos('|', s);
      t := Copy(s, 1, i - 1);
      s := Copy(s, i + 1, Length(s));
      ListBox1.Items.Add(t);
    until (Pos('|', s) = 0) or (Length(s) = 1);
    ListBox1.Visible := True;
    ListBox1.SetFocus;
    if (ListBox1.ItemIndex < 0) and (ListBox1.Items.Count > 0) then
      ListBox1.ItemIndex := 0;
  end;
  iniPos.Free;
end;

//ListBox1.KeyDown
procedure TfrmFilter.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (ListBox1.ItemIndex >= 0) then
    with StringGrid1 do
      Cells[Col, Row] := ListBox1.Items.Strings[ListBox1.ItemIndex];
  if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
  begin
    btnCancel.Cancel := True;
    ListBox1.Visible := False;
    if (Key = VK_RETURN) then
      btnOk.SetFocus
    else
      StringGrid1.SetFocus;
  end;
end;

//ListBox1.MouseDown
procedure TfrmFilter.ListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  wdKey : word;
begin
  wdKey := 13;
  ListBox1KeyDown(nil, wdKey, []);
end;

//btnSelect.Click
procedure TfrmFilter.btnSelectClick(Sender: TObject);
begin
  OpenListBox;
end;

//ListBox1.MouseMove
procedure TfrmFilter.ListBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  P: TPoint;
begin
  P.x := X;
  P.y := Y;
  ListBox1.ItemIndex := ListBox1.ItemAtPos(P, True);
end;

//ListBox1.Exit
procedure TfrmFilter.ListBox1Exit(Sender: TObject);
var
  wdKey : word;
begin
  wdKey := 27;
  ListBox1KeyDown(nil, wdKey, []);
end;

end.