wwtable.pas

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

          else result:= True;

       end;

       Close;
       Exclusive:= bExclusive;
       Active:= bActive;
       EnableControls;

    end;

    procedure TwwTable.AddDependentTablePtr(a_value: PtrBoolean);
    begin
       if dependentPtrs<>Nil then
          dependentPtrs.add(a_value);
    end;

    procedure TwwTable.RemoveDependentTablePtr(a_value: PtrBoolean);
    begin
       if dependentPtrs<>Nil then
          dependentPtrs.remove(a_value);
    end;

    Procedure TwwTable.FreeLookupTables;
    var i: integer;
    begin
       if lookupTables= Nil then exit;

       for i:= lookupTables.count-1 downto 0 do
       begin
          TwwTable(lookupTables.items[i]).free;
          lookupTables.delete(i);
       end;
    end;

    procedure TwwTable.SetQuery(sel : TStrings);
    begin
       if Active then Active:= False;
       if sel.count>0 then
       begin
          TableName:= '';
          IndexFieldNames:= '';  { Clear fields not related to query }
          MasterSource:= Nil;
          MasterFields:= '';
       end;
       FQuery.assign(sel);
    end;

    function TwwTable.GetLookupFields: TStrings;
    begin
       Result:= FLookupFields;
    end;

    procedure TwwTable.SetLookupFields(sel : TStrings);
    begin
         FLookupFields.assign(sel);
    end;

    function TwwTable.GetPictureMasks: TStrings;
    begin
       Result:= FPictureMasks
    end;

    procedure TwwTable.SetPictureMasks(sel : TStrings);
    begin
         FPictureMasks.assign(sel);
    end;

    function TwwTable.GetControltype: TStrings;
    begin
         Result:= FControlType;
    end;

    procedure TwwTable.SetControlType(sel : TStrings);
    begin
       FControlType.assign(sel);
    end;

    function TwwTable.GetFilter: TStrings;
    begin
         Result:= FFilter;
    end;

    { Close related lookup tables when closing master }
    procedure TwwTable.CloseCursor;
    begin
       FreeLookupTables;
       inherited CloseCursor;
{       if QueryFileName<>'' then
       begin
          SysUtils.DeleteFile(QueryFileName);
          QueryFileName:= '';
          QueryType:= '';
       end;
}
       if (FQuery<>Nil) and (FQuery.count>0) then
       begin
          TableName:= '';
       end
    end;

     Function TwwTable.CreateHandle:  HDBICur;
     begin
        Result:= Nil;
        if (FQuery.count>0) then begin
           TableName:= '';
           IndexFieldNames:= '';  { Clear fields not related to query }
           MasterSource:= Nil;
           MasterFields:= '';
           Check(PerformQuery(result))
        end
        else result:= inherited CreateHandle;
     end;

   {$ifdef wwDelphi3Up}
    procedure TwwTable.OpenCursor(InfoQuery: Boolean);
   {$else}
    procedure TwwTable.OpenCursor;
   {$endif}
    var FirstLine: string;
        curpos: integer;
    begin

       if (FQuery.count>0) then
       begin

          FirstLine:= lowercase(FQuery.strings[0]);
          curpos:= 1;
          if strGetToken(FirstLine, ' ', curpos)='query' then
             QueryType:= 'QBE'
          else QueryType:= 'SQL';

       end;

      {$ifdef wwDelphi3Up}
       inherited OpenCursor(InfoQuery);
      {$else}
       inherited OpenCursor;
      {$endif}

       FisSequencable:= isSequencableTable;
    end;

    procedure TwwTable.PrepareCursor;
    begin
       inherited PrepareCursor;
{       if Assigned(FOnPrepareCursor) then FOnPrepareCursor(self);}

       isOpen:= True;
       if (FilterString<>'') or
           assigned(FOnFilter) then FilterActivate;
       isOpen:= False;

    end;


    Function TwwTable.FilterString: string;
    var filt: string;
        line: string;
        i: integer;
    begin
       filt:= '';
       for i:= 0 to FFilter.count-1 do begin
          line:= FFilter[i];
          strStripTrailing(line, [' ', #9]);
          if (length(line)>0) then begin
             if length(filt)>0 then filt:= filt + ' AND (' + line +')'
             else filt:= line;
          end
       end;
       result:= filt;
    end;

    Function TwwTable.FilterActivate: boolean;
    var filt: string;
    begin
       filt:= FilterString;
       result:= wwSetFilter(filt, self, hFilter, isOpen);

       if assigned(FOnFilter)then begin
          wwSetFilterFunction(@filterFunction, self, hFilterFunction);
       end
    end;

    Function TwwTable.SetFilter(sel: String): boolean;
    begin
       if not wwSetFilter(sel, self, hFilter, False) then begin
          MessageDlg('Fail to set filter', mtWarning, [mbok], 0);
          result:= False;
       end
       else begin
          FFilter.clear;
          FFilter.add(sel);
          result:= True;
       end
    end;

    procedure TwwTable.SetFilterArray(sel: TStrings);
    begin
       FFilter.assign(sel);

       if not active then exit;
       if not wwSetFilter(FilterString, self, hFilter, False) then begin
          MessageDlg('Fail to set filter', mtWarning, [mbok], 0);
       end
    end;

    function TwwTable.GetLookupLinks: TStrings;
    begin
         Result:= FLookupLinks;
    end;

    procedure TwwTable.SetLookupLinks(sel : TStrings);
    begin
         FLookupLinks.assign(sel);
    end;

    { Removes obsolete links and control types }
    procedure TwwTable.RemoveObsoleteLinks;
    begin
       wwDataSetRemoveObsolete(self, FLookupFields, FLookupLinks, FControlType);
    end;

    procedure TwwTable.DoOnCalcFields;
    begin
       removeObsoleteLinks;
       wwDataSetDoOnCalcFields(self, FLookupFields, FLookupLinks, lookupTables);
       inherited DoOnCalcFields;
    end;

procedure TwwTable.wwChangeIndexName(a_indexName: string);
var i: integer;
begin
   UpdateIndexes;

   for i:= 0 to IndexDefs.count-1 do begin
      with IndexDefs do begin
          if lowercase(Items[i].name) = lowercase(a_indexName) then begin
             wwChangeIndex(Items[i]);
             break;
          end
       end
   end;
end;

procedure TwwTable.wwChangeIndex(a_indexItem: TIndexDef);
begin
   wwTableChangeIndex(self, a_indexItem);
end;

Function TwwTable.SetToIndexContainingFields(selected: TStrings): boolean;
var curpos: integer;
    IndexFieldName: String;
begin
   result:= False;
   if selected.count<=0 then exit;

   curPos:= 1;
   IndexFieldName:= strGetToken(Selected[0], #9, curpos);

   result:= setToIndexContainingField(IndexFieldName);

end;

Function TwwTable.SetToIndexContainingField(selected: String): boolean;
var curpos: integer;
    found: boolean;
    tempIndexName: string;
    newIndexFields: string;

    { Get detail fields used to link to master table }
    function GetDetailLinkFields: string;
    var tempStr: string;
        count, curpos, i: integer;
    begin
       curpos:= 1;
       count:= 0;
       repeat
          if strGetToken(masterFields, ';', curpos)<>'' then count:= count + 1
          else break;
       until False;

       tempStr:= indexFields[0].FieldName;
       for i:= 1 to count-1 do tempStr:= tempStr + ';' + indexFields[i].FieldName;
       result:= tempstr;

    end;

    { Requested Index is different - Maybe unnecessary since BDE may already optimze this}
    Function DifferentIndex(tempIndexName: string): boolean;
    begin
       if (IndexFieldNames='') then
       begin
          result:= (Uppercase(IndexName)<>Uppercase(tempIndexName));
       end
       else begin
          result:= Uppercase(FieldsToIndex(IndexFieldNames))<>Uppercase(tempIndexName);
       end
    end;

begin
   result:= False;
   Found:= False;
   if selected='' then exit;
   if (FQuery.count>0) then exit; { Don't change indexes if query }

   UpdateIndexes;

   { 5/4/98 - Don't switch indexes if active index already works }
   if (MasterSource=Nil) and (indexFieldCount>0) and
      wwEqualStr(indexFields[0].FieldName, selected) then
   begin
      result:= True;
      exit;
   end;

   inc(inFindRecordCount);
   try
      if (MasterSource<>Nil) and (not ignoreMasterLink) then begin
         curpos:= 1;
         selected:= strGetToken(Selected, ';', curpos);
         newIndexFields:= GetDetailLinkFields + ';' + selected;
         tempIndexName:= FieldsToIndex(newIndexFields);
      end
      else tempIndexName:= FieldsToIndex(selected);

      if tempIndexName<>UNKNOWN then
      begin
         Found:= True;
         if DifferentIndex(tempIndexName) then
         begin
            if (MasterSource<>nil) then  { Forces detail range to be re-applied}
               ClearCurrentRangeBuffers;
            wwChangeIndexName(tempIndexName);
         end
      end
   finally
      dec(InFindRecordCount);
   end;

   result:= Found;

end;


  Function TwwTable.IsValidField(fieldName : string): boolean;
  begin
      result:= wwDataSetIsValidField(self, fieldname);
  end;


procedure TwwTable.SyncSQLTable(lookupTable: TTable);
var
   j: integer;
begin
   if (lookupTable=self) then exit;

   Screen.cursor:= crHourGlass;

   DisableControls;

  { Synchronize to lookupTable }
   setRangeStart;
   for j:= 0 to indexFieldCount-1 do
   begin
       IndexFields[j].asString:=
           lookupTable.fieldByName(indexFields[j].fieldname).text;
   end;
   setRangeEnd;
   ApplyRange;
   EnableControls;
   Screen.cursor:= crDefault;

end;

Function TwwTable.wwFindNearest(key: string; FieldNo: integer): boolean;
begin
   inc(inFindRecordCount);
   try
     result:= wwTableFindNearest(self, key, FieldNo);
   finally
     dec(inFindRecordCount);
   end;
end;

function TwwTable.wwFindRecord(
   KeyValue: string;
   LookupField: string;
   MatchType: TwwLocateMatchType;
   caseSensitive: boolean): boolean;
begin
   inc(inFindRecordCount);
   try
      result:= wwDataSetFindRecord(self, KeyValue, LookupField, MatchType, caseSensitive);
   finally
      dec(inFindRecordCount);
   end;
end;

function TwwTable.wwFindKey(const KeyValues: array of const): Boolean;

     Function GetTempStr(i: integer): string;
     var tempStr : string;
     begin
         result:= '';

         case KeyValues[i].vType of
           vtInteger: tempStr:= inttoStr(KeyValues[i].VInteger);
           vtBoolean: if (KeyValues[i].vBoolean) then tempStr:= 'True' else tempStr:= 'False';
           vtChar: tempStr:= KeyValues[i].VChar;
           vtExtended: tempStr:= FloatToStr(KeyValues[i].VExtended^);
           vtString: tempStr:= KeyValues[i].VString^;
           vtPChar: tempStr:= strPas(KeyValues[i].VPChar);
           {$ifdef win32}
           vtAnsiString: tempStr:= String(KeyValues[i].VAnsiString);
           {$endif}
         end;
         result:= tempStr;
     end;

    { If already on this record then skip findkey }
    Function isAlreadyFound: boolean;
    var i: integer;
        tempStr: string;
    begin
      result:= True;
      for I := 0 to High(KeyValues) do begin
         tempStr:= GetTempStr(i);
         if (lowercase(tempStr) <> lowercase(indexFields[i].asString)) then
         begin
            result:= False;
            break;
         end
      end
    end;

begin
   result:= False;

   if indexFieldCount=0 then exit;

   if (High(KeyValues)>=indexFieldCount) then begin
      MessageDlg('Table ' + name + ': FindKey has too many lookup values for index ' + indexName,
                        mtWarning, [mbok], 0);
      exit;
   end;

   inc(inFindRecordCount);
   try if (not database.isSqlBased) or (not SyncSQLByRange) then begin
       if indexFieldCount>0 then begin
          if NarrowSearch then CancelRange; {5/25/95}
          if not isAlreadyFound then result:= FindKey(KeyValues)
          else result:= True;
       end
       else begin
          { Perform sequential search }
          MessageDlg('Table ' + name + ': Table index not found', mtWarning, [mbok], 0);
       end
   end
   else begin
      if (not isAlreadyFound) or (BOF and EOF) or
         (GetKeyBuffer(kiRangeEnd)^.modified and (not inLookupLink)) then  { If blank result set then reset range }
      begin
         if GetTempStr(0)='' then
         begin
            { Don't allow Null range - Some SQL's (i.e. Oracle) do not support Null starting range}
            if inLookupLink then result:= False
            else CancelRange
         end
         else begin
            if inLookupLink then SetRange(KeyValues, KeyValues)  { 12/4/96 - Limit upper and lower range for lookup link }
            else wwSetRangeStart(KeyValues);
            First;
            result:= isAlreadyFound;
         end;
      end
      else result:= True;
   end
   finally
      dec(inFindRecordCount);
   end;

end;

procedure TwwTable.SetTableName(const Value: TFileName);
var tempValue: string;
begin
   inherited TableName:= Value;
   tempValue:= lowercase(Value);
   if (Value<>'') {and
      (pos('.qbe', tempValue)=0) and (pos('.sql', tempValue)=0) }then
      FQuery.Clear;
end;

function TwwTable.GetTableName: TFileName;
begin
   result:= inherited TableName;
end;

{$ifndef wwDelphi3Up}
procedure TwwMemoStream.CreateCommon(Field: TBlobField; InFilter: boolean);
begin
  FField := Field;
  FDataSet := Field.DataSet;
  FRecord := FDataSet.ActiveBuffer;
  FFieldNo := Field.FieldNo;

  FBuffer := AllocMem(FDataSet.RecordSize);
  FRecord := FBuffer;

  if not InFilter then
     with FDataSet do
        if (State in [dsBrowse, dsEdit, dsInsert]) then UpdateCursorPos;
  if DbiGetRecord(FDataSet.Handle, dbiNoLock, FBuffer, nil) <> 0 then Exit;

  Check(DbiOpenBlob(FDataSet.Handle, FRecord, FFieldNo, dbiReadOnly));
  FOpened := True;
end;

constructor TwwMemoStream.Create(Field: TBlobField);