wwkeycb.pas

胜天进销存源码,国产优秀的进销存

      end;
   end;

   if not Found then begin
      for i:= 0 to IndexDefs.count-1 do begin
         with IndexDefs do begin
             strBreakApart(Items[i].fields, ';', parts);
             if not wwDataSetIsValidField(Dataset, Parts[0]) then continue;
             if useThisIndex then break;
          end
      end;
   end;

   parts.Free;

   itemIndex:= items.indexOf(IndexTitle); {ft5 bug requires this redundancy}

   inherited change;

end;


constructor TwwIncrementalSearch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink:= TDataLink.create;
  FTimer:= TTimer.create(self);
  FTimer.enabled:= False;
  FTimerInterval:= 200;
  FTimer.Interval:= FTimerInterval;
  FTimer.OnTimer:= OnEditTimerEvent;
  LastValue:= '';
  Text:= '';
  FieldNo:= 0;
  FPictureMaskAutoFill:= True;
  FPictureMaskFromField:= False;
  FFrame:= TwwEditFrame.create(self);
  FCaseSensitivity:= wwcsAutoDetect;
end;

destructor TwwIncrementalSearch.Destroy;
begin
  FDataLink.free;
  FTimer.free;
  FFrame.Free;
  FCanvas.Free;
  inherited destroy;
end;

procedure TwwIncrementalSearch.OnEditTimerEvent(Sender: TObject);
begin
   if not FTimer.enabled then exit;
   FTimer.enabled:= False;
   if text <> lastValue then
   begin
      findValue;
      lastValue:= text;
   end;
end;

procedure TwwIncrementalSearch.SetDataSource(value : TDataSource);
begin
   FDataLink.dataSource:= value;
end;

Function TwwIncrementalSearch.GetDataSource: TDataSource;
begin
   Result:= FdataLink.dataSource;
end;

procedure TwwIncrementalSearch.KeyUp(var Key: Word; Shift: TShiftState);
   Function isValidChar(key: word): boolean;
   begin
      result:= (key = VK_BACK) or (key=VK_SPACE) or (key=VK_DELETE) or
               ((key >= ord('0')) and (key<=VK_DIVIDE)) or
               (key>VK_SCROLL); { Support international characters }
   end;
begin
  inherited KeyUp(Key, Shift);
  if ((lastValue<>Text) and IsValidChar(Key)) then
  begin
     if FShowMatchText and (key in [VK_BACK, VK_DELETE]) then begin
        { 1/29/97 - Cancel range when blank }
        if (datasource.dataset is TwwTable) and (datasource.dataset as TwwTable).narrowSearch
           and (Text = '') then
           (datasource.dataset as TwwTable).FastCancelRange;
        exit;
     end;

     FTimer.enabled:= False;
     if (dataSource=Nil) then begin
         MessageDlg('DataSource not defined - object ' + name, mtWarning, [mbok], 0);
         exit;
     end;
     if (dataSource.dataSet=Nil) then begin
         MessageDlg('Dataset not defined for DataSource', mtWarning, [mbok], 0);
         exit;
     end;

     if FSearchDelay<>0 then FTimer.Interval:= FSearchDelay
     else if not wwIsClass(DataSource.DataSet.classType, 'TClientDataSet') then
     begin
        if datasource.dataset.active then
           if (datasource.dataset is TDBDataSet) then { 9/20/97}
              if not (datasource.dataSet as TDBDataSet).database.isSQLBased then
                 FTimer.Interval:= FTimerInterval div 2;
     end;
     FTimer.enabled:= True;
  end
end;

procedure TwwIncrementalSearch.PerformCustomSearch(
   SearchField: string; SearchValue: string;
   PerformLookup: boolean; var Found: boolean);
begin
   if Assigned(FOnPerformCustomSearch) and Assigned(DataSource.DataSet) then
   begin
      FOnPerformCustomSearch(self, DataSource.DataSet,
          SearchField, SearchValue, PerformLookup, Found);
   end
end;

procedure TwwIncrementalSearch.FindValue;
var
   dataSet : TDataSet;
   SearchIndex: integer;
   i: integer;
   tempSearchField: wwSmallString;
   SearchText: string;
   isQuery, isFound: boolean;
   {$ifdef wwDelphi3Up}
   curField: TField;
   IndexDefs: TIndexDefs;
   apos, idx: integer;
   {$endif}

   PropInfo: PPropInfo;
   CaseSensitive: boolean;

   TempText : string;
   curSearchField: string;

   Function isExpressionIndex(table: TDataSet): boolean;
   var curpos: integer;
       expression: string;
       curWord: wwSmallString;
   begin
      result:= False;
      with Table as TTable do begin
         if (TableType = ttDBase) or
            (CompareText(ExtractFileExt(TableName), '.DBF') = 0) then
         begin
            if (IndexDefs.indexof(IndexName)>=0) and
               (ixExpression in IndexDefs.Items[IndexDefs.indexof(IndexName)].Options) then
            begin
               TempSearchField:= SearchField;
               if SearchField<>'' then begin
                  result:= True;
               end
               else begin
                  // 2/12/06 - Use Ansi functions
                  expression:= AnsiUppercase(IndexDefs.Items[IndexDefs.indexOf(IndexName)].expression);
                  curPos:= 1;
                  repeat
                     curWord:=
                        wwGetWord(Expression, curpos, [wwgwSkipLeadingBlanks],
                            [ ')','(', '+', '-', '*', '/']);
                     if FindField(curWord)<>Nil then begin
                        TempSearchField:= curWord;
                        result:= True;
                        exit;
                     end
                  until (curWord='');
               end
            end
         end
      end
   end;

    function GetIndexFieldNames: string;
    begin
       Result:= '';
       PropInfo:= Typinfo.GetPropInfo(DataSource.DataSet.ClassInfo,'IndexFieldNames');
       if PropInfo<>Nil then Result:= GetStrProp(DataSource.DataSet, PropInfo);
    end;

    function GetIndexName: string;
    begin
       Result:= '';
       PropInfo:= Typinfo.GetPropInfo(DataSource.DataSet.ClassInfo,'IndexName');
       if PropInfo<>Nil then Result:= GetStrProp(DataSource.DataSet, PropInfo);
    end;

    // 7/9/02 - Support multi-field lookup for
    function MultiFieldSearch: boolean;
    var i: integer;
        TempFieldValues: Variant;
        ATextPos, APos: integer;
        curText, curSearchField: string;
        searchParts: TStringlist;
        curField: TField;
    begin
      APos:= 1;
      ATextPos:= 1;
      i:= 0;
      searchParts:= TStringlist.create;
      try
        strBreakApart(TempSearchField, ';', searchparts);

        TempFieldValues:= VarArrayCreate([0, searchParts.count-1], varVariant);

        repeat
          curSearchField:= strGetToken(tempSearchField, ';', APos);
          if CurSearchField='' then break;

          curText:= strGetToken(Text, ';', ATextPos);

          // Limit length to field size to prevent runtime error
          curField:= DataSet.FindField(curSearchField);
          if (curField is TStringField) and (curField.size>0) and (curField.size<length(curText)) then
            curText:= copy(curText, 1, curField.size);

          TempFieldValues[i]:= curText;
          inc(i);
        until False;
        if CaseSensitive then
           result:= DataSet.Locate(TempSearchField, TempFieldValues, [loPartialKey])
        else
           result:= DataSet.Locate(TempSearchField, TempFieldValues, [loPartialKey, loCaseInsensitive]);

      finally
        searchParts.Free;
      end
    end;


    function IsMultiFieldSearch: boolean;
    begin
        result:=
           (pos(';', SearchField)>0) and (pos(';', Text)>0) and
           (length(Text)>pos(';', Text));
    end;

begin
   if dataSource=Nil then exit;
   if dataSource.dataSet=Nil then exit;
   if not Assigned(FOnPerformCustomSearch) then
   begin
     if not dataSource.dataset.Active then exit;
   end;
   dataSet := dataSource.DataSet as TDataSet;
   isQuery:= False;
   TempSearchField:= SearchField;

   {$ifdef wwDelphi3Up}
   if not (dataSet is TBDEDataset) then begin
      if (Text='') then begin { 9/15/99 - Locate causes exception if passing blank value so we skip locate }
         DataSet.First;
         exit;
      end;
      caseSensitive:= False;
      PropInfo:= Typinfo.GetPropInfo(DataSource.DataSet.ClassInfo,'IndexDefs');
      if PropInfo<>Nil then begin
         IndexDefs:= TIndexDefs(GetOrdProp(DataSource.DataSet, PropInfo));
         idx:= IndexDefs.indexof(GetIndexName);
         if idx>=0 then begin
            caseSensitive:= not (ixCaseInsensitive in IndexDefs.Items[idx].Options);
            APos:= 1;
            if TempSearchField='' then
               TempSearchField:= strGetToken(IndexDefs.items[idx].fields, ';', APos);
         end
         else begin
            caseSensitive:= False;
         end
      end
   end
   else caseSensitive:= False;
   {$endif}

   case FCaseSensitivity of
      wwcsAutoDetect:;
      wwcsCaseSensitive: caseSensitive:= True;
      wwcsCaseInsensitive: caseSensitive:= False;
   end;

   if Assigned(FOnPerformCustomSearch) then
   begin
      if SearchField='' then TempSearchField:= dataset.fields[0].FieldName
      else TempSearchField:= SearchField;
      curField:= DataSet.FindField(TempSearchField);
      if (curField is TStringField) and (curField.size>0) and (curField.size<length(Text)) then
          TempText:= copy(Text, 1, curField.size)
      else TempText:=Text;

      PerformCustomSearch(TempSearchField, TempText, False, IsFound);
   end
   else if (dataSet is TTable) then begin
     with (DataSet as TTable) do
        if not wwIsTableQuery(DataSet) and (IndexDefs.count=0) then IndexDefs.update;  { refreshes Index list }

     if ((dataset as TTable).indexFieldCount=0) and wwIsTableQuery(DataSet) then begin
        isQuery:= True;
        if SearchField='' then TempSearchField:= dataset.fields[0].FieldName
        else TempSearchField:= SearchField;
        if (FCaseSensitivity=wwcsAutoDetect) then
           isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, False)
        else
           isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, caseSensitive)
     end
     else if isExpressionIndex(dataSet) then
     begin
        with DataSet as TTable do begin
           if not wwFieldIsValidValue(FieldbyName(TempSearchField), text) then exit;
           EditKey;
           FieldByName(TempSearchField).asString:= text;
           GoToNearest;

           // 2/12/06 - Use Ansi functions
           isFound:= AnsiPos(AnsiUppercase(Text), AnsiUppercase(FieldByName(TempSearchField).asString))=1;
        end
     end
     else begin
        SearchIndex:= 0;

        if IsMultiFieldSearch then
          isFound:= MultiFieldSearch
        else begin
          if SearchField<>'' then with DataSet as TTable do begin
             for i:= 0 to indexFieldCount-1 do
                if (lowercase(SearchField)=lowercase(indexFields[i].fieldName)) then
                   SearchIndex:= i;
          end;
          if ((DataSet as TTable).indexFieldCount>0) and (CaseSensitivity = wwcsAutoDetect) and
             ((SearchIndex>0) or (SearchField='') or (SearchField=(DataSet as TTable).IndexFields[0].FieldName)) then // 5/8/03 - Disallow if SearchField does not matach index
             isFound:= wwTableFindNearest(dataSet as TTable, Text, SearchIndex)
          else begin
             if SearchField='' then TempSearchField:= dataset.fields[0].FieldName
             else TempSearchField:= SearchField;
             APos:= 1;
             if pos(';', SearchField)>0 then
               TempSearchField:=strGetToken(SearchField, ';', APos);
             isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, caseSensitive);
          end
        end
     end
   end
   else begin
      isQuery:= True;

      if SearchField='' then begin
         if TempSearchField='' then
             if GetIndexFieldNames<>'' then
             begin
                APos:= 1;
                TempSearchField:= strGetToken(GetIndexFieldNames, ';', APos);
             end
             else
                TempSearchField:= dataset.fields[0].FieldName
         else { TempSearchField assigned above }
      end
      else TempSearchField:= SearchField;

      {$ifdef wwDelphi3Up}
      curField:= DataSet.FindField(TempSearchField);
      if (not wwFieldIsValidLocateValue(curField, Text)) then begin { If invalid value type then skip search }
         isFound:= False;
      end
      else if (not wwIsClass(DataSet.classType, 'TwwQuery')) or  {ClientDataSet Locate fails on partial match }
              (not wwInternational.UseLocateMethodForSearch) then
      begin
         if  wwInternational.UseLocateMethodForSearch then
         begin
            { 11/4/97 - Replace wwDataSetFindRecord call with Locate to allow 3rd party engines
                        opportunity to take advantage of the index. Code assumes
                        case sensitive index if not using the BDE. }
            Screen.cursor:= crHourGlass;
            if (dataset is TBDEDataSet) and (FCaseSensitivity=wwcsAutoDetect) then
               isFound:= Dataset.Locate(TempSearchField, Text, [loPartialKey, loCaseInsensitive])
            else begin
               if caseSensitive then { 2/18/98 - Backwards logic before }
                  isFound:= Dataset.Locate(TempSearchField, Text,
                             [loPartialKey])
               else
                  isFound:= Dataset.Locate(TempSearchField, Text,
                             [loPartialKey, loCaseInsensitive])
            end;

            Screen.cursor:= crDefault;
         end
         else begin
            if (FCaseSensitivity=wwcsAutoDetect) then
               isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, False)
            else
               isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, caseSensitive)
         end
      end
      else begin
         { Require seq search on live parameterized query as Delphi Locate does not support this}
         if (DataSet is TwwQuery) and TwwQuery(DataSet).RequestLive and
                   TwwQuery(DataSet).CanModify and (TwwQuery(DataSet).DataSource<>Nil) then
         begin
             isFound:= wwDataSetFindRecord(DataSet, Text, TempSearchField, mtPartialMatchStart, False);
         end
         else begin
            Screen.cursor:= crHourGlass;
            try
              if TwwQuery(DataSet).isValidIndexField(TempSearchField, False) then
                 isFound:= DataSet.Locate(TempSearchField, Text, [loPartialKey, loCaseInsensitive])
              else if TwwQuery(DataSet).isValidIndexField(TempSearchField, True) then
                 isFound:= DataSet.Locate(TempSearchField, Text, [loPartialKey])
              else