?? dbfilter.pas
字號:
Result := FDataLink.DataSource;
end;
procedure TRxDBFilter.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;
{$IFDEF WIN32}
if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
finally
FIgnoreDataEvents := False;
end;
end;
procedure TRxDBFilter.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) then begin
if AComponent = DataSource then DataSource := nil;
end;
end;
function TRxDBFilter.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 TRxDBFilter.CreateFuncFilter: hDBIFilter;
var
FuncPriority: Word;
begin
if (FPriority < $FFFF) and (FExprHandle <> nil) then
FuncPriority := FPriority + 1
else FuncPriority := FPriority;
{$IFDEF WIN32}
Check(DbiAddFilter((FDataLink.DataSet as TBDEDataSet).Handle, Longint(Self),
FuncPriority, False, nil, PFGENFilter(@TRxDBFilter.RecordFilter),
Result));
{$ELSE}
Check(DbiAddFilter(FDataLink.DataSet.Handle, Longint(Self), FuncPriority,
False, nil, FilterCallback, Result));
{$ENDIF WIN32}
FDataHandle := TBDEDataSet(FDatalink.DataSet).Handle;
end;
procedure TRxDBFilter.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 begin
{$IFNDEF WIN32}
if (Filter <> nil) and FDatalink.Active then
DbiDropFilter((FDataLink.DataSet as TBDEDataSet).Handle, Filter);
{$ENDIF}
Filter := Value;
end;
end;
procedure TRxDBFilter.DropFilters;
begin
SetFilterHandle(FExprHandle, nil);
SetFilterHandle(FFuncHandle, nil);
FDataHandle := nil;
FActive := False;
end;
procedure TRxDBFilter.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 TRxDBFilter.DeactivateFilters;
begin
if (FFuncHandle <> nil) then
DbiDeactivateFilter(TBDEDataSet(FDatalink.DataSet).Handle, FFuncHandle);
if (FExprHandle <> nil) then
DbiDeactivateFilter(TBDEDataSet(FDatalink.DataSet).Handle, FExprHandle);
end;
function TRxDBFilter.RecordFilter(RecBuf: Pointer; RecNo: Longint): Smallint;
var
ACanModify: Boolean;
Buffers: PBufferList;
{$IFDEF RX_D4}
BufPtr: TBufferList;
{$ENDIF}
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);
{$IFDEF RX_D4}
SetLength(BufPtr, 1);
BufPtr[0] := PChar(RecBuf);
dsSetBuffers(DS, BufPtr);
{$ELSE}
dsSetBuffers(DS, @PChar(RecBuf));
{$ENDIF}
{ 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 := ABORT; { BDE constant, not SysUtils.pas procedure }
end;
end;
procedure TRxDBFilter.FilterChanged(Sender: TObject);
begin
RecreateExprFilter;
end;
procedure TRxDBFilter.SetOnFiltering(const Value: TFilterEvent);
begin
if Assigned(FOnFiltering) <> Assigned(Value) then begin
FOnFiltering := Value;
RecreateFuncFilter;
end else FOnFiltering := Value;
end;
procedure TRxDBFilter.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 TRxDBFilter.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;
procedure TRxDBFilter.SetFilter(Value: TStrings);
begin
FFilter.Assign(Value);
end;
procedure TRxDBFilter.SetOptions(Value: TDBFilterOptions);
begin
if Value <> FOptions then begin
FOptions := Value;
RecreateExprFilter;
end;
end;
procedure TRxDBFilter.SetLogicCond(Value: TFilterLogicCond);
begin
FLogicCond := Value;
end;
procedure TRxDBFilter.SetPriority(Value: Word);
begin
if FPriority <> Value then begin
FPriority := Value;
Update;
end;
end;
function TRxDBFilter.GetFilterText: PChar;
var
BufLen: Word;
I: Integer;
StrEnd: PChar;
StrBuf: array[0..255] of Char;
begin
BufLen := 1;
for I := 0 to FFilter.Count - 1 do
Inc(BufLen, Length(Filter.Strings[I]) + 1);
Result := StrAlloc(BufLen);
try
StrEnd := Result;
for I := 0 to Filter.Count - 1 do begin
if Filter.Strings[I] <> '' then begin
StrPCopy(StrBuf, Filter.Strings[I]);
StrEnd := StrECopy(StrEnd, StrBuf);
StrEnd := StrECopy(StrEnd, ' ');
end;
end;
except
StrDispose(Result);
raise;
end;
end;
procedure TRxDBFilter.DestroyTree;
begin
if FParser <> nil then begin
FParser.Free;
FParser := nil;
end;
end;
procedure TRxDBFilter.BeforeDataPost(DataSet: TDataSet);
begin
ReadCaptureControls;
ReleaseCapture;
Activate;
SysUtils.Abort;
end;
procedure TRxDBFilter.BeforeDataChange(DataSet: TDataSet);
begin
FilterError(SCaptureFilter);
end;
procedure TRxDBFilter.BeforeDataCancel(DataSet: TDataSet);
begin
ReleaseCapture;
end;
function TRxDBFilter.BuildTree: Boolean;
var
Expr: PChar;
I: Integer;
begin
Result := True;
if not FDataLink.Active then _DBError(SDataSetClosed);
TStringList(FFilter).OnChange := nil;
try
for I := FFilter.Count - 1 downto 0 do
if FFilter[I] = '' then FFilter.Delete(I);
finally
TStringList(FFilter).OnChange := FilterChanged;
end;
if FFilter.Count = 0 then begin
Result := False;
Exit;
end;
Expr := GetFilterText;
try
if StrLen(Expr) = 0 then begin
Result := False;
Exit;
end;
FParser := TExprParser.Create(FDataLink.DataSet, Expr,
TFilterOptions(FOptions) {$IFDEF RX_D4}, [], '', nil {$ENDIF}
{$IFDEF RX_D5}, FldTypeMap {$ENDIF});
finally
StrDispose(Expr);
end;
end;
procedure TRxDBFilter.DoActivate;
begin
if Assigned(FOnActivate) then FOnActivate(Self);
end;
procedure TRxDBFilter.DoDeactivate;
begin
if Assigned(FOnDeactivate) then FOnDeactivate(Self);
end;
procedure TRxDBFilter.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 FilterError(SCaptureFilter);
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 TRxDBFilter.Activate;
begin
SetActive(True);
end;
procedure TRxDBFilter.Deactivate;
begin
SetActive(False);
end;
procedure TRxDBFilter.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;
THackDataSet(DataSource.DataSet).DataEvent(deUpdateState, 0);
THackDataSet(DataSource.DataSet).DataEvent(deDataSetChange, 0);
{DataSource.DataSet := DataSource.DataSet;}
FCaptured := True;
if Assigned(FOnSetCapture) then FOnSetCapture(Self);
end;
end;
procedure TRxDBFilter.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([]);
THackDataSet(DataSource.DataSet).DataEvent(deUpdateState, 0);
THackDataSet(DataSource.DataSet).DataEvent(deDataSetChange, 0);
{DataSource.DataSet := DataSource.DataSet;}
if Assigned(FOnReleaseCapture) then FOnReleaseCapture(Self);
ActiveChanged;
end;
end;
procedure TRxDBFilter.ReadCaptureControls;
const
LogicStr: array[TFilterLogicCond] of string[4] = (' 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 {$IFDEF WIN32}
or Field.Lookup {$ENDIF}) 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 FilterError(SNotCaptureFilter);
end;
procedure TRxDBFilter.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 TRxDBFilter.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 TRxDBFilter.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;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -