jvbdefilter.pas

East make Tray Icon in delphi

begin
  SetFilterHandle(FExprHandle, nil);
  SetFilterHandle(FFuncHandle, nil);
  FDataHandle := nil;
  FActive := False;
end;

procedure TJvDBFilter.ActivateFilters;
begin
  if FExprHandle <> nil then
    DbiActivateFilter((FDataLink.DataSet as TBDEDataSet).Handle, FExprHandle);
  if FFuncHandle <> nil then
    DbiActivateFilter((FDataLink.DataSet as TBDEDataSet).Handle, FFuncHandle);
end;

procedure TJvDBFilter.DeactivateFilters;
begin
  if FFuncHandle <> nil then
    DbiDeactivateFilter(TBDEDataSet(FDataLink.DataSet).Handle, FFuncHandle);
  if FExprHandle <> nil then
    DbiDeactivateFilter(TBDEDataSet(FDataLink.DataSet).Handle, FExprHandle);
end;

function TJvDBFilter.RecordFilter(RecBuf: Pointer; RecNo: Longint): Smallint;
var
  ACanModify: Boolean;
  Buffers: PBufferList;
  BufPtr: TBufferList;
  ActiveRecord: Integer;
  RecCount: Integer;
  DS: TBDEDataSet;
begin
  Result := Ord(True);
  if Assigned(FOnFiltering) and (FFuncHandle <> nil) then
  try
    DS := FDataLink.DataSet as TBDEDataSet;
    { save current DataSet's private fields values }
    DsGetBuffers(DS, Buffers);
    ActiveRecord := DsGetActiveRecord(DS);
    RecCount := DsGetRecordCount(DS);
    ACanModify := DsGetCanModify(DS);
    try
      DsSetActiveRecord(DS, 0);
      DsSetRecordCount(DS, 1); { FActiveRecord + 1 }
      DsSetCanModify(DS, False);
      SetLength(BufPtr, 1);
      BufPtr[0] := PChar(RecBuf);
      DsSetBuffers(DS, BufPtr);
      { call user defined function }
      Result := Ord(FOnFiltering(Self, DS));
    finally
      DsSetCanModify(DS, ACanModify);
      DsSetActiveRecord(DS, ActiveRecord);
      DsSetRecordCount(DS, RecCount);
      DsSetBuffers(DS, Buffers);
    end;
  except
    Application.HandleException(Self);
    Result := BDE.ABORT; { BDE constant, not SysUtils.pas procedure }
  end;
end;

procedure TJvDBFilter.FilterChanged(Sender: TObject);
begin
  RecreateExprFilter;
end;

procedure TJvDBFilter.SetOnFiltering(const Value: TFilterEvent);
begin
  if Assigned(FOnFiltering) <> Assigned(Value) then
  begin
    FOnFiltering := Value;
    RecreateFuncFilter;
  end
  else
    FOnFiltering := Value;
end;

procedure TJvDBFilter.RecreateFuncFilter;
var
  Filter: hDBIFilter;
begin
  if FDataLink.Active and not (csReading in ComponentState) then
  begin
    if not FCaptured then
      FDataLink.DataSet.CheckBrowseMode;
    if Assigned(FOnFiltering) then
      Filter := CreateFuncFilter
    else
      Filter := nil;
    SetFilterHandle(FFuncHandle, Filter);
  end;
  if FDataLink.Active and Active and not FCaptured then
    FDataLink.DataSet.First;
end;

procedure TJvDBFilter.RecreateExprFilter;
var
  Filter: hDBIFilter;
begin
  if FDataLink.Active and not (csReading in ComponentState) then
  begin
    if not FCaptured then
      FDataLink.DataSet.CheckBrowseMode;
    if FFilter.Count > 0 then
      try
        Filter := CreateExprFilter;
      except
        if Active or FActivating then
          raise
        else
          Filter := nil;
      end
    else
      Filter := nil;
    SetFilterHandle(FExprHandle, Filter);
  end;
  if FDataLink.Active and Active and not FCaptured then
    FDataLink.DataSet.First;
end;

function TJvDBFilter.GetFilter: TStrings;
begin
  Result := FFilter;
end;

procedure TJvDBFilter.SetFilter(Value: TStrings);
begin
  FFilter.Assign(Value);
end;

procedure TJvDBFilter.SetOptions(Value: TDBFilterOptions);
begin
  if Value <> FOptions then
  begin
    FOptions := Value;
    RecreateExprFilter;
  end;
end;

procedure TJvDBFilter.SetLogicCond(Value: TFilterLogicCond);
begin
  FLogicCond := Value;
end;

procedure TJvDBFilter.SetPriority(Value: Word);
begin
  if FPriority <> Value then
  begin
    FPriority := Value;
    Update;
  end;
end;

function TJvDBFilter.GetFilterText: string;
var
  BufLen: Word;
  I: Integer;
  StrEnd: PChar;
  StrBuf: array [0..255] of Char;
begin
  BufLen := 0;
  for I := 0 to FFilter.Count - 1 do
    if Filter.Strings[I] <> '' then
      Inc(BufLen, Length(Filter.Strings[I]) + 1);
  SetLength(Result, BufLen);
  if BufLen > 0 then
  begin
    StrEnd := @Result[1];
    for I := 0 to Filter.Count - 1 do
      if Filter.Strings[I] <> '' then
      begin
        StrPCopy(StrBuf, Filter.Strings[I]);
        StrEnd := StrECopy(StrEnd, StrBuf);
        StrEnd := StrECopy(StrEnd, ' ');
      end;
  end;
end;

procedure TJvDBFilter.DestroyTree;
begin
  FreeAndNil(FParser);
end;

procedure TJvDBFilter.BeforeDataPost(DataSet: TDataSet);
begin
  ReadCaptureControls;
  ReleaseCapture;
  Activate;
  SysUtils.Abort;
end;

procedure TJvDBFilter.BeforeDataChange(DataSet: TDataSet);
begin
  raise EJVCLFilterError.CreateRes(@RsECaptureFilter);
end;

procedure TJvDBFilter.BeforeDataCancel(DataSet: TDataSet);
begin
  ReleaseCapture;
end;

function TJvDBFilter.BuildTree: Boolean;
var
  Expr: string;
  I: Integer;
begin
  Result := True;
  if not FDataLink.Active then
    _DBError(SDataSetClosed);
  FFilter.OnChange := nil;
  try
    for I := FFilter.Count - 1 downto 0 do
      if FFilter[I] = '' then
        FFilter.Delete(I);
  finally
    FFilter.OnChange := FilterChanged;
  end;
  Expr := GetFilterText;
  if (FFilter.Count <> 0) and (Expr <> '') then
    FParser := TExprParser.Create(FDataLink.DataSet, Expr,
      TFilterOptions(FOptions), [], '', nil, FldTypeMap)
  else
    Result := False;
end;

procedure TJvDBFilter.DoActivate;
begin
  if Assigned(FOnActivate) then
    FOnActivate(Self);
end;

procedure TJvDBFilter.DoDeactivate;
begin
  if Assigned(FOnDeactivate) then
    FOnDeactivate(Self);
end;

procedure TJvDBFilter.SetActive(Value: Boolean);
var
  Bookmark: TBookmark;
begin
  if csReading in ComponentState then
    FStreamedActive := Value
  else
  if FDataLink.Active then
  begin
    FDataLink.DataSet.CheckBrowseMode;
    if FActive <> Value then
    begin
      if Value then
      begin
        FActivating := True;
        try
          if FCaptured then
            raise EJVCLFilterError.CreateRes(@RsECaptureFilter);
          DbiSetToBegin((FDataLink.DataSet as TBDEDataSet).Handle);
          if FExprHandle = nil then
            RecreateExprFilter;
          if FFuncHandle = nil then
            RecreateFuncFilter;
          ActivateFilters;
          FDataLink.DataSet.First;
          FActive := Value;
          DoActivate;
        finally
          FActivating := False;
        end;
      end
      else
      begin
        if not IsDataSetEmpty(FDataLink.DataSet) then
          Bookmark := FDataLink.DataSet.GetBookmark
        else
          Bookmark := nil;
        try
          DbiSetToBegin((FDataLink.DataSet as TBDEDataSet).Handle);
          DeactivateFilters;
          if not SetToBookmark(FDataLink.DataSet, Bookmark) then
            FDataLink.DataSet.First;
        finally
          FDataLink.DataSet.FreeBookmark(Bookmark);
        end;
        FActive := Value;
        DoDeactivate;
      end;
      FActive := Value;
    end;
  end
  else
    FActive := Value;
end;

procedure TJvDBFilter.Activate;
begin
  SetActive(True);
end;

procedure TJvDBFilter.Deactivate;
begin
  SetActive(False);
end;

procedure TJvDBFilter.SetCapture;
begin
  if not FCaptured and (FDataLink <> nil) then
  begin
    if not FDataLink.Active then
      _DBError(SDataSetClosed);
    DataSource.DataSet.CheckBrowseMode;
    Deactivate;
    FIgnoreDataEvents := True;
    { store private fields values }
    with FStorage do
    begin
      FBof := DataSource.DataSet.Bof;
      FEof := DataSource.DataSet.Eof;
      State := DataSource.DataSet.State;
      CanModify := DsGetCanModify(FDataLink.DataSet as TBDEDataSet);
      BeforePost := DataSource.DataSet.BeforePost;
      BeforeCancel := DataSource.DataSet.BeforeCancel;
      BeforeInsert := DataSource.DataSet.BeforeInsert;
      BeforeEdit := DataSource.DataSet.BeforeEdit;
    end;
    DbiInitRecord((DataSource.DataSet as TBDEDataSet).Handle,
      DataSource.DataSet.ActiveBuffer);
    DsSetBOF(DataSource.DataSet, True);
    DsSetEOF(DataSource.DataSet, True);
    DsSetState(DataSource.DataSet, dsEdit);
    DsSetCanModify(DataSource.DataSet as TBDEDataSet, True);
    DataSource.DataSet.BeforeCancel := BeforeDataCancel;
    DataSource.DataSet.BeforePost := BeforeDataPost;
    DataSource.DataSet.BeforeInsert := BeforeDataChange;
    DataSource.DataSet.BeforeEdit := BeforeDataChange;
    TDataSetAccessProtected(DataSource.DataSet).DataEvent(deUpdateState, 0);
    TDataSetAccessProtected(DataSource.DataSet).DataEvent(deDataSetChange, 0);
    {DataSource.DataSet := DataSource.DataSet;}
    FCaptured := True;
    if Assigned(FOnSetCapture) then
      FOnSetCapture(Self);
  end;
end;

procedure TJvDBFilter.ReleaseCapture;
begin
  if (DataSource <> nil) and (DataSource.DataSet <> nil) and FCaptured then
  begin
    { restore private fields values stored in SetCapture }
    with FStorage do
    begin
      DsSetBOF(DataSource.DataSet, FBof);
      DsSetEOF(DataSource.DataSet, FEof);
      DsSetState(DataSource.DataSet, State);
      DsSetCanModify(DataSource.DataSet as TBDEDataSet, CanModify);
      DataSource.DataSet.BeforePost := BeforePost;
      DataSource.DataSet.BeforeCancel := BeforeCancel;
      DataSource.DataSet.BeforeInsert := BeforeInsert;
      DataSource.DataSet.BeforeEdit := BeforeEdit;
    end;
    FCaptured := False;
    FIgnoreDataEvents := False;
    DataSource.DataSet.Resync([]);
    TDataSetAccessProtected(DataSource.DataSet).DataEvent(deUpdateState, 0);
    TDataSetAccessProtected(DataSource.DataSet).DataEvent(deDataSetChange, 0);
    {DataSource.DataSet := DataSource.DataSet;}
    if Assigned(FOnReleaseCapture) then
      FOnReleaseCapture(Self);
    ActiveChanged;
  end;
end;

procedure TJvDBFilter.ReadCaptureControls;
const
  LogicStr: array [TFilterLogicCond] of PChar = (' AND', ' OR');
var
  I: Integer;
  Field: TField;
  S: string;
begin
  if FCaptured then
  begin
    FFilter.BeginUpdate;
    try
      FFilter.Clear;
      with FDataLink.DataSet do
      begin
        UpdateRecord;
        for I := 0 to FieldCount - 1 do
        begin
          Field := Fields[I];
          if not (Field.IsNull or Field.Calculated or Field.Lookup) then
          begin
            S := '(' + cFldQuotaLeft + Field.FieldName + cFldQuotaRight +
              '=' + cQuota + Field.AsString + cQuota + ')';
            if FFilter.Count > 0 then
              S := S + LogicStr[FLogicCond];
            FFilter.Insert(0, S);
          end;
        end;
      end;
    finally
      FFilter.EndUpdate;
    end;
  end
  else
    raise EJVCLFilterError.CreateRes(@RsENotCaptureFilter);
end;

procedure TJvDBFilter.UpdateFuncFilter;
begin
  if FDataLink.Active and Active and (FFuncHandle <> nil) then
    with FDataLink.DataSet as TBDEDataSet do
    begin
      DisableControls;
      try
        DbiDeactivateFilter(Handle, FFuncHandle);
        DbiActivateFilter(Handle, FFuncHandle);
        {CursorPosChanged; Resync([]);}
        First;
      finally
        EnableControls;
      end;
    end;
end;

procedure TJvDBFilter.Update;
begin
  if FDataLink.Active and Active then
  begin
    FDataLink.DataSet.DisableControls;
    try
      RecreateExprFilter;
      RecreateFuncFilter;
      {DeactivateFilters; ActivateFilters;}
    finally
      FDataLink.DataSet.EnableControls;
    end;
  end
  else
    DeactivateFilters;
end;

procedure TJvDBFilter.ActiveChanged;
var
  WasActive: Boolean;
begin
  if not FIgnoreDataEvents then
  begin
    WasActive := Active;
    DropFilters;
    if not (csDestroying in ComponentState) then
    begin
      RecreateExprFilter;
      RecreateFuncFilter;
      if WasActive then
        Activate;
    end;
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.