📄 wwfltdum.pas
字号:
if (isnullvalue(token,CheckMemoStr,FieldOps.NullChar)) then
begin
Result := True;
break;
end
else if (strlen(FiltervaluePtr)=numread) then begin
matchPtr:= strPos(MemoBuffer,FilterValuePtr);
if (matchPtr<>Nil) then begin
Result:= True;
break;
end;
end;
end
else begin
if not isnullvalue(token,CheckMemoStr,FieldOps.NullChar) then
if strlen(FiltervaluePtr)<>numread then begin
Result:= False;
exit;
end
else begin
matchPtr:= strPos(MemoBuffer, FilterValuePtr);
if matchPtr=Nil then begin
Result:= False;
exit;
end;
end;
end;
end;
fdMatchRange:
end; {case}
until (CurPos=-1) or (FldInfo.MatchType=fdMatchRange);
end
else begin (* Not Memo Field *)
RecordFieldValue := '';
case Filterfield.dataType of
ftDate: begin
tempDatetime := GetFilterField(FilterFieldName);
if not tempDatetime.isnull then
RecordFieldValue:= DateToStr(tempDatetime.asDate);
end;
{$ifdef wwDelphi6Up}
ftTimeStamp,
{$endif}
ftDateTime:begin {9/5/97 - Missing not when checking for null field}
tempDatetime := GetFilterField(FilterFieldName);
if not tempDatetime.isnull then
RecordFieldValue:= DateTimeToStr(tempDatetime.asDateTime);
end;
ftTime: begin {9/5/97 - Missing not when checking for null field}
tempDatetime := GetFilterField(FilterFieldName);
if not tempDatetime.isnull then
RecordFieldValue:= TimeToStr(tempDatetime.asTime);
end;
ftWideString:
begin
{ Bypass problem in ADODataSet where it executes callback filter event even though
adodataset is at eof or beginning of file }
{$ifdef wwDelphi5Up}
// if not wwIsClass(FilterField.DataSet.ClassType, 'TCustomADODataSet') or
// (not TCustomADODataSet(FilterField.DataSet).RecordSet.bof and
// not TCustomADODataSet(FilterField.DataSet).RecordSet.eof) then
begin
RecordFieldValue:= FilterField.AsString;
end
{$endif}
end;
else RecordFieldValue:= GetFilterField(FilterFieldName).asString;
end;
if not FldInfo.caseSensitive then begin {11/06/97 - Changed to Ansi}
RecordFieldValue:= AnsiUpperCase(RecordFieldValue);
FilterValue:= AnsiUppercase(FilterValue);
end;
CurPos:= 1;
repeat
if (FldInfo.MatchType <> fdMatchRange) then begin
token:= wwGetFilterToken(FilterValue,SearchDelimiter,CurPos);
strpcopy(FilterValuePtr,token);
end;
case FldInfo.MatchType of
fdMatchEnd:
begin
if (OrFlg) then begin
if (isnullvalue(token,recordfieldvalue,FieldOps.NullChar)) then
begin
Result := True;
break;
end
else if (length(RecordFieldValue)>=length(token)) and
(pos(token, RecordFieldValue)=
length(RecordFieldValue)+1-length(token)) then
begin
Result:= True;
exit;
end;
end
else begin
if not isnullvalue(token,recordfieldvalue,FieldOps.NullChar) then
if (length(RecordFieldValue)<length(token)) or
(pos(token, RecordFieldValue)<>
length(RecordFieldValue)+1-length(token)) then
begin
Result:= False;
exit;
end;
end
end;
fdMatchStart:
begin
if (OrFlg) then begin
if (isnullvalue(token,recordfieldvalue,FieldOps.NullChar)) then
begin
Result := True;
break;
end
else if (pos(token, RecordFieldValue)=1) then begin
Result:= True;
break;
end;
end
else begin
if not isnullvalue(token,recordfieldvalue,FieldOps.NullChar) then
if (pos(token, RecordFieldValue)<>1) then begin
Result:= False;
exit;
end
end
end;
fdMatchAny:
begin
if (OrFlg) then begin
if (isnullvalue(token,recordfieldvalue,FieldOps.NullChar)) then
begin
Result := True;
break;
end
else if (pos(token, RecordFieldValue)<>0) then begin
Result:=True;
break;
end;
end
else begin
if not isnullvalue(token,recordfieldvalue,FieldOps.NullChar) then
if (pos(token, RecordFieldValue)=0) then begin
Result:= False;
exit;
end
end
end;
fdMatchExact:
begin
if (OrFlg) then begin
if (isnullvalue(token,recordfieldvalue,FieldOps.NullChar)) then begin
Result := True;
break;
end
{1/9/98 - Convert to datatypes for true comparison }
else if TokenEqual(token, RecordFieldValue, FilterField.DataType) then
begin
Result:= True;
break;
end
end
else begin {And Flag or nothing}
if not isnullvalue(token,recordfieldvalue,FieldOps.NullChar) then
{1/9/98 - Convert to datatypes for true comparison }
if not TokenEqual(token, RecordFieldValue, FilterField.DataType) then
begin
Result:= False;
exit;
end
end
end;
fdMatchRange:
begin
tempDataType:= FilterField.dataType;
{$ifdef win32}
if tempDataType = ftAutoInc then tempDataType:= ftInteger;
{$endif}
case tempDataType of
ftDate:
if (FldInfo.MinValue<>'') and
(GetFilterField(FilterFieldName).asDate<StrToDate(FldInfo.MinValue)) then
begin
Result:= False;
exit;
end
else if (FldInfo.MaxValue<>'') and
(GetFilterfield(FilterFieldName).asDate>StrToDate(FldInfo.MaxValue)) then
begin
Result:= False;
exit;
end;
{$ifdef wwDelphi6Up}
ftTimeStamp,
{$endif}
ftDateTime:
if (FldInfo.MinValue<>'') and
(GetFilterField(FilterFieldName).asDateTime<StrToDateTime(FldInfo.MinValue)) then
begin
Result:= False;
exit;
end
else if (FldInfo.MaxValue<>'') then begin
TempDate:= StrToDateTime(FldInfo.MaxValue);
// 6/07/00 - PYW - Check for timeseparator when filtering on datetimes. This will allow
// an enduser to filter on a datetime field with a zero time value.
if ((DateSeparator <> TimeSeparator) and (Pos(TimeSeparator,FldInfo.MaxValue) = 0)) or
((DateSeparator = TimeSeparator) and (TempDate-Trunc(TempDate)=0)) then
{ 5/20/99 - RSW - No time entered so add 1 to date and use >= }
begin
TempDate:= TempDate + 1;
if (GetFilterField(FilterFieldName).asDateTime>=TempDate) then
begin
Result:= False;
exit;
end
end
else begin
if (GetFilterfield(FilterFieldName).asDateTime>TempDate) then
begin
Result:= False;
exit;
end
end
end;
ftTime:
if (FldInfo.MinValue<>'') and
(GetFilterField(FilterFieldName).asTime<StrToTime(FldInfo.MinValue)) then
begin
Result:= False;
exit;
end
else if (FldInfo.MaxValue<>'') and
(GetFilterfield(FilterFieldName).asTime>StrTotime(FldInfo.MaxValue)) then
begin
Result:= False;
exit;
end;
ftSmallInt, ftInteger, ftWord:
if (FldInfo.MinValue<>'') and
(GetFilterField(FilterFieldName).asInteger<StrToInt(FldInfo.MinValue)) then
begin
Result:= False;
exit;
end
else if (FldInfo.MaxValue<>'') and
(GetFilterfield(FilterFieldName).asInteger>StrToInt(FldInfo.MaxValue)) then
begin
Result:= False;
exit;
end;
{$ifdef wwDelphi6Up}
ftFMTBcd,
{$endif}
ftFloat, ftCurrency, ftBCD { 1/9/98 - Support BCD} :
if (FldInfo.MinValue<>'') and
(GetFilterField(FilterFieldName).asFloat+TwwFilterDialog(DlgComponent).Rounding.Epsilon<StrToFloat(FldInfo.MinValue)) then
begin
Result:= False;
exit;
end
else if (FldInfo.MaxValue<>'') and
(GetFilterfield(FilterFieldName).asFloat-TwwFilterDialog(DlgComponent).Rounding.Epsilon>StrToFloat(FldInfo.MaxValue)) then
begin
Result:= False;
exit;
end;
ftString: { 3/25/98 - Support case insensitive ranges }
begin
if not FldInfo.caseSensitive then begin
TempMinValue:= AnsiUpperCase(FldInfo.MinValue);
TempMaxValue:= AnsiUpperCase(FldInfo.MaxValue);
end
else begin
TempMinValue:= FldInfo.MinValue;
TempMaxValue:= FldInfo.MaxValue;
end;
if (FldInfo.MinValue<>'') and
(RecordFieldValue<TempMinValue) then
begin
Result:= False;
exit;
end
else begin
TempMaxValue:= wwPadUpperRange(FilterField.size,
TempMaxValue, TempComponent.UpperRangePadChar);
if (FldInfo.MaxValue<>'') and
(RecordFieldValue>TempMaxValue) then
begin
Result:= False;
exit;
end
end
end;
end; {end case for tempDataType}
end; {End MatchRange}
end; {End case;}
until (CurPos= -1) or (FldInfo.MatchType=fdMatchRange);
end;
end;
type
TwwCheatFilterDialog = class(TwwFilterDialog);
{ Don't use try finally block because performance dramatically slows down }
Procedure TwwDummyForm.OnFilterEvent(table: TDataSet; var Accept: boolean);
var i: integer;
tempComponent: TwwFilterDialog;
FldInfo:TwwFieldInfo;
DefaultFiltering: boolean;
begin
tempComponent:= (DlgComponent as TwwFilterDialog);
DataSet:= table;
Accept:= True;
{ Give developer a chance to skip filtering in case of ADO bad record }
DefaultFiltering:= True;
TwwCheatFilterDialog(tempComponent).DoAcceptFilterRecord(table, Accept, DefaultFiltering);
if (not Accept) or (not DefaultFiltering) then exit;
for i:= 0 to tempComponent.FieldInfo.count-1 do begin
FldInfo:= TwwFieldInfo(tempComponent.FieldInfo[i]);
if FldInfo.FieldName='' then { Compute field name from displaylabel if unspecified }
FldInfo.FieldName:= wwGetFieldNameFromTitle(DataSet, FldInfo.DisplayLabel);
Accept := CheckFilterField(i);
if ((FldInfo.NonMatching) and (FldInfo.MatchType <> fdMatchRange)) then
Accept := not Accept; {3/10/97 - Added NonMatching support for values}
if not Accept then break;
end; {end for}
end;
//{$R *.DFM}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -