jvbdefilter.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBFilter.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvBDEFilter.pas,v 1.16 2005/02/17 10:19:59 marquardt Exp $

unit JvBDEFilter;

interface

{$I jvcl.inc}

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes, BDE, DB,
  JvTypes, JvComponent;

type
  TFilterLogicCond = (flAnd, flOr); { for captured DataSet }
  TDBFilterOption = TFilterOption;
  TDBFilterOptions = TFilterOptions;

  TFilterEvent = function(Sender: TObject; DataSet: TDataSet): Boolean of object;

  TDataSetStorage = record { for internal use only }
    FBof: Boolean;
    FEof: Boolean;
    State: TDataSetState;
    CanModify: Boolean;
    BeforePost: TDataSetNotifyEvent;
    BeforeCancel: TDataSetNotifyEvent;
    BeforeInsert: TDataSetNotifyEvent;
    BeforeEdit: TDataSetNotifyEvent;
  end;

  TJvDBFilter = class(TJvComponent)
  private
    FParser: TObject;
    FDataLink: TDataLink;
    FIgnoreDataEvents: Boolean;
    FPriority: Word;
    FOptions: TDBFilterOptions;
    FLogicCond: TFilterLogicCond;
    FFilter: TStringList;
    FExprHandle: hDBIFilter;
    FFuncHandle: hDBIFilter;
    FDataHandle: hDBICur;
    FActive: Boolean;
    FCaptured: Boolean;
    FStreamedActive: Boolean;
    FActivating: Boolean;
    FStorage: TDataSetStorage;
    FOnFiltering: TFilterEvent;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnSetCapture: TNotifyEvent;
    FOnReleaseCapture: TNotifyEvent;
    procedure SetDataSource(Value: TDataSource);
    function GetDataSource: TDataSource;
    function BuildTree: Boolean;
    procedure DestroyTree;
    function GetFilter: TStrings;
    procedure SetFilter(Value: TStrings);
    procedure SetOptions(Value: TDBFilterOptions);
    procedure SetOnFiltering(const Value: TFilterEvent);
    procedure SetPriority(Value: Word);
    procedure SetLogicCond(Value: TFilterLogicCond);
    function GetFilterText: string;
    procedure FilterChanged(Sender: TObject);
    function CreateExprFilter: hDBIFilter;
    function CreateFuncFilter: hDBIFilter;
    procedure DropFilters;
    procedure SetFilterHandle(var Filter: hDBIFilter; Value: hDBIFilter);
    procedure RecreateExprFilter;
    procedure RecreateFuncFilter;
    procedure ActivateFilters;
    procedure DeactivateFilters;
    function RecordFilter(RecBuf: Pointer; RecNo: Longint): Smallint;stdcall;
    procedure BeforeDataPost(DataSet: TDataSet);
    procedure BeforeDataChange(DataSet: TDataSet);
    procedure BeforeDataCancel(DataSet: TDataSet);
    procedure SetActive(Value: Boolean);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoActivate; dynamic;
    procedure DoDeactivate; dynamic;
    procedure ActiveChanged; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; virtual;
    procedure UpdateFuncFilter;
    procedure Activate;
    procedure Deactivate;
    procedure SetCapture;
    procedure ReleaseCapture;
    procedure ReadCaptureControls;
    property Captured: Boolean read FCaptured;
    property Handle: hDBIFilter read FExprHandle; { obsolete, use ExprFilter }
    property ExprFilter: hDBIFilter read FExprHandle;
    property FuncFilter: hDBIFilter read FFuncHandle;
  published
    property Active: Boolean read FActive write SetActive default False;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Filter: TStrings read GetFilter write SetFilter;
    property LogicCond: TFilterLogicCond read FLogicCond write SetLogicCond default flAnd;
    property Options: TDBFilterOptions read FOptions write SetOptions default [];
    property Priority: Word read FPriority write SetPriority default 0;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnFiltering: TFilterEvent read FOnFiltering write SetOnFiltering;
    property OnSetCapture: TNotifyEvent read FOnSetCapture write FOnSetCapture;
    property OnReleaseCapture: TNotifyEvent read FOnReleaseCapture write FOnReleaseCapture;
  end;

  EJVCLFilterError = class(EJVCLException);

procedure DropAllFilters(DataSet: TDataSet);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvBDEFilter.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2005/02/17 10:19:59 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Forms, DBConsts, DbCommon, DBTables,
  JvDBUtils, JvBdeUtils, JvResources;

procedure DropAllFilters(DataSet: TDataSet);
begin
  if (DataSet <> nil) and DataSet.Active then
  begin
    DataSet.Filtered := False;
    DbiDropFilter(TBDEDataSet(DataSet).Handle, nil);
    DataSet.CursorPosChanged;
    DataSet.Resync([]);
  end;
end;

const
  SExprNothing = '""'; { nothing token name }
  cQuota = ''''; { quotas for string constants }
  cFldQuotaLeft = '['; { left qouta for field names }
  cFldQuotaRight = ']'; { right qouta for field names }

{$HINTS OFF}

type
  TDataSetAccessProtected = class(TDataSet);

{*******************************************************}
{ !! ATTENTION Nasty implementation                     }
{*******************************************************}
{                                                       }
{ These class definitions were copied from TDataSet     }
{ (DB.PAS) and TBDEDataSet (DBTABLES.PAS).              }
{ It is needed to access FState, FBof, FEof, FBuffers,  }
{ FRecordCount, FActiveRecord, FCanModify private       }
{ fields of TDataSet.                                   }
{                                                       }
{ Any changes in the underlying classes may cause       }
{ errors in this implementation!                        }
{                                                       }
{*******************************************************}

  PBufferList = TBufferList;

  TNastyDataSet = class(TComponent)
  private
    FFields: TFields;
    FAggFields: TFields;
    FFieldDefs: TFieldDefs;
    FFieldDefList: TFieldDefList;
    FFieldList: TFieldList;
    FDataSources: TList;
    FFirstDataLink: TDataLink;
    FBufferCount: Integer;
    FRecordCount: Integer;
    FActiveRecord: Integer;
    FCurrentRecord: Integer;
    FBuffers: TBufferList;
    FCalcBuffer: PChar;
    FBookmarkSize: Integer;
    FCalcFieldsSize: Integer;
    FDesigner: TDataSetDesigner;
    FDisableCount: Integer;
    FBlobFieldCount: Integer;
    FFilterText: string;
    FBlockReadSize: Integer;
    FConstraints: TCheckConstraints;
    FDataSetField: TDataSetField;
    FNestedDataSets: TList;
    FNestedDatasetClass: TClass;
    FReserved: Pointer;
    FFieldNoOfs: Integer;
    { Byte sized data members (for alignment) }
    FFilterOptions: TFilterOptions;
    FState: TDataSetState;
    FEnableEvent: TDataEvent;
    FDisableState: TDataSetState;
    FBof: Boolean;
    FEof: Boolean;
  end;

  TBDENastyDataSet = class(TDataSet)
  private
    FHandle: hDBICur;
    FStmtHandle: hDBIStmt;
    FRecProps: RecProps;
    FLocale: TLocale;
    FExprFilter: hDBIFilter;
    FFuncFilter: hDBIFilter;
    FFilterBuffer: PChar;
    FIndexFieldMap: DBIKey;
    FExpIndex: Boolean;
    FCaseInsIndex: Boolean;
    FCachedUpdates: Boolean;
    FInUpdateCallback: Boolean;
    FCanModify: Boolean;
  end;

{$HINTS ON}

procedure DsSetState(DataSet: TDataSet; Value: TDataSetState);
begin
  TNastyDataSet(DataSet).FState := Value;
end;

procedure DsSetBOF(DataSet: TDataSet; Value: Boolean);
begin
  TNastyDataSet(DataSet).FBof := Value;
end;

procedure DsSetEOF(DataSet: TDataSet; Value: Boolean);
begin
  TNastyDataSet(DataSet).FEof := Value;
end;

procedure AssignBuffers(const Source: TBufferList; var Dest: TBufferList);
begin
  SetLength(Dest, Length(Source));
  Move(Pointer(Source)^, Pointer(Dest)^, Length(Source) * SizeOf(PChar));
end;

procedure DsGetBuffers(DataSet: TDataSet; var ABuf: TBufferList);
begin
  with TNastyDataSet(DataSet) do
    AssignBuffers(FBuffers, ABuf);
end;

procedure DsSetBuffers(DataSet: TDataSet; const Value: TBufferList);
begin
  AssignBuffers(Value, TNastyDataSet(DataSet).FBuffers);
end;

function DsGetRecordCount(DataSet: TDataSet): Integer;
begin
  Result := TNastyDataSet(DataSet).FRecordCount;
end;

procedure DsSetRecordCount(DataSet: TDataSet; Value: Integer);
begin
  TNastyDataSet(DataSet).FRecordCount := Value;
end;

function DsGetActiveRecord(DataSet: TDataSet): Integer;
begin
  Result := TNastyDataSet(DataSet).FActiveRecord;
end;

procedure DsSetActiveRecord(DataSet: TDataSet; Value: Integer);
begin
  TNastyDataSet(DataSet).FActiveRecord := Value;
end;

function DsGetCanModify(DataSet: TBDEDataSet): Boolean;
begin
  Result := TBDENastyDataSet(DataSet).FCanModify;
end;

procedure DsSetCanModify(DataSet: TBDEDataSet; Value: Boolean);
begin
  TBDENastyDataSet(DataSet).FCanModify := Value;
end;

//=== { TJvFilterDataLink } ==================================================

type
  TJvFilterDataLink = class(TDataLink)
  private
    FFilter: TJvDBFilter;
  protected
    procedure ActiveChanged; override;
  public
    constructor Create(Filter: TJvDBFilter);
    destructor Destroy; override;
  end;

constructor TJvFilterDataLink.Create(Filter: TJvDBFilter);
begin
  inherited Create;
  FFilter := Filter;
end;

destructor TJvFilterDataLink.Destroy;
begin
  FFilter := nil;
  inherited Destroy;
end;

procedure TJvFilterDataLink.ActiveChanged;
begin
  if FFilter <> nil then
    FFilter.ActiveChanged;
end;

//=== { TJvDBFilter } ========================================================

constructor TJvDBFilter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TJvFilterDataLink.Create(Self);
  FFilter := TStringList.Create;
  FFilter.OnChange := FilterChanged;
  FLogicCond := flAnd;
  FIgnoreDataEvents := False;
end;

destructor TJvDBFilter.Destroy;
begin
  FFilter.OnChange := nil;
  Deactivate;
  DropFilters;
  FFilter.Free;
  FDataLink.Free;
  inherited Destroy;
end;

procedure TJvDBFilter.Loaded;
begin
  inherited Loaded;
  try
    if FStreamedActive then
      Active := True;
  except
    if csDesigning in ComponentState then
      Application.HandleException(Self)
    else
      raise;
  end;
end;

function TJvDBFilter.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TJvDBFilter.SetDataSource(Value: TDataSource);
var
  DSChange: Boolean;
begin
  if not (csLoading in ComponentState) then
    ReleaseCapture;
  DSChange := True;
  if (Value <> nil) and (DataSource <> nil) then
    DSChange := (Value.DataSet <> FDataLink.DataSet);
  FIgnoreDataEvents := not DSChange;
  try
    if not (csLoading in ComponentState) then
      ActiveChanged;
    FDataLink.DataSource := Value;
    if Value <> nil then
      Value.FreeNotification(Self);
  finally
    FIgnoreDataEvents := False;
  end;
end;

procedure TJvDBFilter.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) then
    if AComponent = DataSource then
      DataSource := nil;
end;

function TJvDBFilter.CreateExprFilter: hDBIFilter;
begin
  Result := nil;
  if FFilter.Count > 0 then
    if BuildTree then
      try
        Check(DbiAddFilter((FDataLink.DataSet as TBDEDataSet).Handle,
          Longint(Self), FPriority, False,
            pCANExpr(TExprParser(FParser).FilterData), nil, Result));
        FDataHandle := TBDEDataSet(FDataLink.DataSet).Handle;
      finally
        DestroyTree;
      end;
end;

function TJvDBFilter.CreateFuncFilter: hDBIFilter;
var
  FuncPriority: Word;
begin
  if (FPriority < $FFFF) and (FExprHandle <> nil) then
    FuncPriority := FPriority + 1
  else
    FuncPriority := FPriority;
  Check(DbiAddFilter((FDataLink.DataSet as TBDEDataSet).Handle, Longint(Self),
    FuncPriority, False, nil, PFGENFilter(@TJvDBFilter.RecordFilter),
    Result));
  FDataHandle := TBDEDataSet(FDataLink.DataSet).Handle;
end;

procedure TJvDBFilter.SetFilterHandle(var Filter: hDBIFilter;
  Value: hDBIFilter);
var
  Info: FilterInfo;
begin
  if FActive and FDataLink.Active then
  begin
    FDataLink.DataSet.CursorPosChanged;
    DbiSetToBegin((FDataLink.DataSet as TBDEDataSet).Handle);
    if (Filter <> nil) and (Filter <> Value) then
      DbiDropFilter((FDataLink.DataSet as TBDEDataSet).Handle, Filter);
    Filter := Value;
    if Filter <> nil then
      DbiActivateFilter((FDataLink.DataSet as TBDEDataSet).Handle, Filter);
  end
  else
  if FActive and (Filter <> nil) and (FDataHandle <> nil) and
    (FDataLink.DataSet = nil) and (Value = nil) then
  begin
    if DbiGetFilterInfo(FDataHandle, Filter, 0, 0, Info) = DBIERR_NONE then
      DbiDeactivateFilter(FDataHandle, Filter);
    Filter := Value;
  end
  else
    Filter := Value;
end;

procedure TJvDBFilter.DropFilters;