wwcommon.pas

InfoPower_Studio 2007 v5.0.1.3 banben

       for i:= 0 to LookupFields.count-1 do begin
          strBreakApart(LookupFields.Strings[i], ';', parts);

          if (uppercase(parts[0])= uppercase(lookupfieldName)) then begin

             curpos:= 1;
             tempTblName1:= uppercase(strGetToken(lookupTable.tablename, '.', curpos));
             curpos:= 1;
             tempTblName2:= uppercase(strGetToken(parts[2], '.', curpos));
             if (tempTblName1=tempTblName2) then
             begin
                if parts.count>5 then begin
                   indexFields:= parts[5];
                   for j:= 6 to parts.count-2 do indexFields:= indexFields + ';' + parts[j];
                   lookupTable.ignoreMasterLink:= True;  { Just change index }
                   lookupTable.setToIndexContainingField(indexFields);  {2/10/97}
                   lookupTable.ignoreMasterLink:= False;
{                   lookupTable.indexName:= lookupTable.FieldsToIndex(indexFields);}
                end
                else if (lookupTable.indexName<>parts[4]) then   { Set index name}
                    lookuptable.indexName:=parts[4];
             end;

             strBreakApart(LookupLinks[i], ';', links);

             { Source Link field is gone, hide dependent field }
             for j:= 0 to ((links.count-1) div 2) do begin
                if not wwDataSetIsValidField(dataSet, links[j*2]) then begin
                   dataSet.fieldByName(parts[0]).visible:= False;
                   parts.free;
                   links.free;
                   exit;
                end
             end;

             with DataSet do
               result:= wwDoLookupTable(lookupTable, Dataset, links);

             fromField:= links[0];
             break;
          end
       end;
       parts.free;
       links.free;
    end;

(*
Function wwDataSetRemoveObsoleteControls(parentForm: TCustomForm; dataSet: TComponent): boolean;
var i: integer;
    parts: TStrings;
    ControlType: TStrings;
begin
   result:= True;
   exit;
   if parentForm=nil then exit;
   if not (csDesigning in parentForm.ComponentState) then exit; { only remove in design mode}

   parts:= TStringList.create;
   ControlType:= wwGetControlType(dataSet);
   i:= 0;
   if ControlType<>nil then while (i<=ControlType.count-1) do begin{ Delphi 5}
      strbreakApart(ControlType.Strings[i], ';', parts);
      if (parts.count<2) then begin
         i:= i + 1;
         continue;
      end;
      if isWWEditControl(parts[1]) then
      begin
         if pos('.', parts[2])>0 then begin
            if (length(StrTrailing(parts[2],'.'))>0) and
               (Dataset.owner.FindComponent(strTrailing(parts[2],'.'))=Nil) then
            begin
               ControlType.delete(i);
            end
            else inc(i)
         end
         else begin
            if (parentForm.FindComponent(parts[2])=Nil) then
            begin
               ControlType.delete(i);
            end
            else inc(i);
         end;
      end
      else i:= i+1;
   end;

   parts.free;

end;
*)
procedure wwDataSet_GetControl(dataSet: TComponent; AFieldName: string;
                      var AControlType: string; var AParameters: string);
var i: integer;
    ControlType: TStrings;
    APos: integer;
begin
   { 8/14/97 - Optimized logic to speed painting of grid }
   AControlType:= '';
   AParameters:= '';
   controlType:= wwGetControlType(dataset);
   if ControlType=nil then exit; { Delphi 5}
   for i:= 0 to ControlType.count-1 do begin
      APos:= 1;
      if strGetToken(controlType[i], ';', APos)<>AFieldName then continue;
      AControlType:= strGetToken(controlType[i], ';', APos);
      AParameters:= copy(controlType[i], APos, 255);
   end
end;

procedure wwDataSetRemoveObsolete(dataSet: TComponent; //DataSet;
          FLookupFields, FLookupLinks, FControlType: TStrings);
var i: integer;
    parts: Tstrings;
begin
   parts:= TStringList.create;
   i:= 0;
   if FLookupFields<>Nil then while (i<=FLookupfields.count-1) do begin
      strbreakApart(FLookupFields.Strings[i], ';', parts);
      if (not wwDataSetisValidField(dataSet, parts[0])) then begin
         FLookupFields.delete(i);
         FLookupLinks.delete(i);
      end
      else i:= i+1;
   end;

   i:= 0;
   if (FControlType<>nil) then { Delphi5}
     while (i<=FControlType.count-1) do begin
        strbreakApart(FControlType.Strings[i], ';', parts);
        if (not wwDataSetIsValidField(dataSet, parts[0])) then
        begin
           FControlType.delete(i);
        end
        else i:= i+1;
     end;

   parts.free;
end;

procedure wwDataSet_SetControl(dataSet: TComponent;
          AFieldName: string; AComponentType: string; AParameters: string);
var i: integer;
    parts: Tstrings;
    Found: boolean;
    ControlType: TStrings;
begin
   i:= 0;
   Found:= False;
   ControlType:= wwGetControlType(dataSet);
   parts:= TStringList.create;

   if ControlType<>nil then while (i<=ControlType.count-1) do begin { Delphi 5}
      strbreakApart(ControlType.Strings[i], ';', parts);
      if (lowercase(parts[0])=lowercase(AFieldName)) then begin
         if (lowercase(AComponentType)='field') or (lowercase(AComponentType)='') then
         begin
            ControlType.delete(i);  {Delete control}
            Found:= True;
            break;
         end
         else begin
            ControlType.Strings[i]:= parts[0] + ';' + AComponentType + ';' +
                 AParameters;
            Found:= True; {Update Control}
            break;
         end
      end;
      i:= i + 1;
   end;

   if (not found) and (ControlType<>nil) then begin { Delphi 5}
      ControlType.add(AFieldName + ';' + AComponentType + ';' + AParameters);
   end;

   parts.free;
end;

function wwFieldIsValidValue(fld: TField; key: string): boolean;
begin
   result:= wwIsValidValue(fld.dataType, key);
end;

Function wwFieldIsValidLocateValue(fld: TField; key: string):boolean;
begin
   result:= False;
   if Fld=Nil then exit;
   
   result:= wwFieldIsValidValue(fld, key);

   if (key='') and
   {$ifdef win32}
   (fld.datatype in [ftCurrency, ftFloat, ftBCD, ftInteger, ftSmallInt, ftWord,
      {$ifdef wwDelphi6Up}
      ftTimeStamp, ftFMTBCD,
      {$endif}
                    ftAutoInc, ftTime, ftDate, ftDateTime]) then result:= False;
   {$else}
   (fld.datatype in [ftCurrency, ftFloat, ftBCD, ftInteger, ftSmallInt, ftWord,
                   ftTime, ftDate, ftDateTime]) then result:= False;
   {$endif}
end;

Function wwIsValidValue(FldType: TFieldType; key: string):boolean;
begin
   result:= False;
   case FldType of
     {$ifdef wwDelphi6Up}
     ftFMTBCD,
     {$endif}
     ftCurrency, ftFloat, ftBCD : if not wwStrToFloat(key) then exit;
     ftinteger, ftSmallInt, ftWord : if not wwStrToInt(key) then exit;

     {$ifdef win32}
     ftAutoInc : if not wwStrToInt(key) then exit;
     {$endif}

     ftTime: if not wwStrToTime(key) then exit;  {3/6/97}
     ftDate : if not wwStrToDate(key) then exit;
     {$ifdef wwDelphi6Up}
     ftTimeStamp,
     {$endif}
     ftDateTime:
        if not wwStrToDateTime(key) then begin
           if not wwStrToDate(key) then exit;
        end;
     else;
   end;
   result:= True;
end;


type TCheatTable = class(TTable);

Function wwTableFindNearest(dataSet: TDataSet; key: string; FieldNo: integer): boolean;
var table: TTable;
    useNarrowSearch, syncSQLByRange: boolean;
    useTextSearch: boolean;
    UpperRangeString: string;
    i: integer;
    SkipLocate: boolean;
    {$ifdef wwDelphi3Up}
    LocateOptions: TLocateOptions;
    LocateValues: Variant;
    LocateFields: string;
    {$endif}

   Function IsValueType(AFieldType: TFieldType): boolean;
   begin
      result:=
          (AFieldType in [ ftSmallInt, ftInteger, ftWord, ftFloat, ftCurrency]);
      {$ifdef win32}
       if AFieldType=ftAutoInc then result:= True;
      {$endif}
   end;

  Function GetIndexFieldName: string;
  var indexFlds: string;
      curpos: integer;
  begin
      curpos:= 1;
      indexFlds:= table.indexFieldNames;
      if indexFlds='' then indexFlds:= TwwTable(table).IndexToFields(table.indexName);
      if indexFlds='' then result:= ''
      else result:= strGetToken(indexFlds, ';', curpos);
  end;

   function IsCaseInsensitiveIndex: boolean;
   var Fields: TList;
   begin
      Fields := TList.Create;
      try
         result:= false;
         Table.GetFieldList(Fields, GetIndexFieldName);
         result:= TCheatTable(Table).MapsToIndex(Fields, True);
      finally
         Fields.Free;
      end;
   end;

begin
   result:= False;
   if not (dataset is TTable) then exit;

   if (dataset is TwwTable) then begin
      useNarrowSearch:= (dataset as TwwTable).NarrowSearch;
      syncSQLByRange:= (dataset as TwwTable).SyncSQLByRange;
   end
   else begin
      useNarrowSearch:= False;
      syncSQLByRange:= False;
   end;
   table:= dataSet as TTable;

   if table.indexFieldCount=0 then begin
      MessageDlg('Table ' + dataset.name + ': Table index not found', mtWarning, [mbok], 0);
      exit;
   end;

   useTextSearch:= False;

   case table.indexFields[FieldNo].dataType of
         {$ifdef wwDelphi6Up}
          ftFMTBCD,
         {$endif}
         ftCurrency, ftFloat, ftBCD : if not wwStrToFloat(key) then exit;

         ftinteger, ftSmallInt, ftWord : if not wwStrToInt(key) then exit;
         {$ifdef win32}
         ftAutoInc : if not wwStrToInt(key) then exit;
         {$endif}
         ftDate : if not wwStrToDate(key) then exit;
         ftTime: if not wwStrToTime(key) then exit;

         {$ifdef wwDelphi6Up}
         ftTimeStamp,
         {$endif}
         ftDateTime:
            if not wwStrToDateTime(key) then begin
               if not wwStrToDate(key) then exit;
            end;
            else useTextSearch:= True;
   end;

   with table do try

      if UseNarrowSearch then begin  { Search by narrowing down }
         Screen.cursor:= crHourGlass;
         DisableControls;
         if useTextSearch then begin
            if key='' then
              (table as TwwTable).FastCancelRange  { 12/4/96 - Faster cancel range }
            else begin
              { MSSQL does not work with char(255) }
              UpperRangeString:= key;
//              for i:= 0 to indexfields[0].size-1 do
              for i:= 0 to indexfields[0].size-1-length(key) do { 2/24/98 - Subtrack length(key) }
                 UpperRangeString:= UpperRangeString + char((table as TwwTable).NarrowSearchUpperChar);

              { 10/16/97 - Skip descending test if using IndexFieldNames }
              if ((IndexName<>'') or (IndexFieldNames='')) and
                 (ixDescending in IndexDefs.Items[IndexDefs.indexof(IndexName)].Options) then
                  table.SetRange([UpperRangeString], [key])
              else table.setRange([key],[UpperRangeString])
            end;
         end
         else begin
            if table is TwwTable then
               (table as TwwTable).wwSetRangeStart([key]);
         end;
         EnableControls;
         Screen.cursor:= crDefault;
      end
      { 11/6/96 - Don't use setRange if detail table }
      else if (not database.isSqlBased) or (not SyncSQLByRange) or (table.mastersource<>nil) then begin
         {$ifdef wwDelphi3Up}
         { 5/29/97 - Use 32 bit Locate function instead of FindNearest }
         if wwInternational.UseLocateMethodForSearch then
         begin
            if IsCaseInsensitiveIndex then LocateOptions:= [loPartialKey,  loCaseInsensitive]
            else LocateOptions:= [loPartialKey];

            if (Key='') then Dataset.first { 6/9/97}
            else if FieldNo=0 then
                DataSet.Locate(indexFields[0].FieldName, Key, LocateOptions)
            else begin
               LocateValues:= VarArrayCreate([0, FieldNo], varVariant);
               LocateFields:= '';
               SkipLocate:= False; { 2/22/99}
               for i:= 0 to FieldNo do begin
                  LocateValues[i]:= indexfields[i].asString;

                  // 7/18/03 - Multi-field search skips in this case - it should not
                  if (i<FieldNo) and (indexfields[i].isNull) then
                     SkipLocate:= True; { 2/22/99 }
                  if Lo