wwcommon.pas

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

begin
   if dataset=nil then
   begin
     ds:= wwGetControlDataSource(Control);
     if ds<>nil then dataset:= ds.dataset
     else dataset:= nil;
   end;

   if wwGetPictureMaskFromDataSet(Control) and (wwGetPictureMasks(Dataset)<>nil) then
      Result:= Dataset
   else Result:= Control;
end;

Function wwGetControlTypeControl(Control: TComponent; DataSet: TDataSet = nil): TComponent;
var ds: TDataSource;
begin
   if dataset=nil then
   begin
     ds:= wwGetControlDataSource(Control);
     if ds<>nil then dataset:= ds.dataset
     else dataset:= nil;
   end;

   if wwGetControlInfoInDataSet(Control) and (wwGetControlType(Dataset)<>nil) then
      Result:= Dataset
   else Result:= Control;
end;

Function wwGetStrings(Component: TComponent; PropertyName: string): TStrings;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   if Component=nil then exit;

   PropInfo:= Typinfo.GetPropInfo(Component.ClassInfo, PropertyName);
   if PropInfo<>Nil then
      result:= TStrings(GetOrdProp(Component, PropInfo));
end;

Function wwGetPictureMasks(DataSet: TComponent): TStrings;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   if DataSet=nil then exit;

   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'PictureMasks');
   if PropInfo<>Nil then
      result:= TStrings(GetOrdProp(DataSet, PropInfo));
end;

Function wwGetRegexMasks(DataSet: TComponent): TStrings;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   if DataSet=nil then exit;

   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'RegexMasks');
   if PropInfo<>Nil then
      result:= TStrings(GetOrdProp(DataSet, PropInfo));
end;

Function wwGetControlType(DataSet: TComponent): TStrings;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   if DataSet=nil then exit;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'ControlType'); { Delphi 5}
   if PropInfo<>Nil then
      result:= TStrings(GetOrdProp(DataSet, PropInfo));
end;

function wwGetCommandType(DataSet: TDataSet): integer;
var PropInfo: PPropInfo;
begin
   Result:= 0;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'CommandType');
   if (PropInfo<>Nil) then begin
      result:= GetOrdProp(DataSet, PropInfo);
   end
end;

function wwGetDatabaseCursorType(DataSet: TDataSet): integer;
var PropInfo: PPropInfo;
begin
   Result:= 0;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'CursorLocation');
   if (PropInfo<>Nil) then begin
      result:= GetOrdProp(DataSet, PropInfo);
   end
end;

Function wwSetDatabaseCursorType(DataSet: TDataSet; val: integer): boolean;
var PropInfo: PPropInfo;
begin
   Result:= False;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'CursorLocation');
   if (PropInfo<>Nil) then begin
      SetOrdProp(DataSet, PropInfo, ord(val));
      result:= True;
   end
end;

Function wwSetDatabaseMaxRecords(DataSet: TDataSet; val: integer): boolean;
var PropInfo: PPropInfo;
begin
   Result:= False;
   PropInfo:= Typinfo.GetPropINfo(DataSet.ClassInfo,'MaxRecords');
   if (PropInfo<>Nil) then begin
      SetOrdProp(DataSet, PropInfo, ord(val));
      result:= True;
   end
end;

Function wwGetValidateWithMask(dataSet: TDataSet): boolean;
var PropInfo: PPropInfo;
begin
   Result:= False;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'ValidateWithMask');
   if PropInfo<>Nil then
      result:= Boolean(GetOrdProp(DataSet, PropInfo));
end;

Function wwGetControlInfoInDataSet(component: TComponent): boolean;
var PropInfo: PPropInfo;
begin
   Result:= True;
   PropInfo:= Typinfo.GetPropInfo(component.ClassInfo,'ControlInfoInDataSet');
   if PropInfo<>Nil then
      result:= Boolean(GetOrdProp(component, PropInfo));
end;

Function wwGetPictureMaskFromDataSet(component: TComponent): boolean;
var PropInfo: PPropInfo;
begin
   Result:= True;
   PropInfo:= Typinfo.GetPropInfo(component.ClassInfo,'PictureMaskFromDataSet');
   if PropInfo<>Nil then
      result:= Boolean(GetOrdProp(component, PropInfo));
end;

Function wwGetLookupFields(dataSet: TDataSet): TStrings;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'LookupFields');
   if PropInfo<>Nil then
      result:= TStrings(GetOrdProp(DataSet, PropInfo));
end;

Function wwGetLookupLinks(dataSet: TDataSet): TStrings;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'LookupLinks');
   if PropInfo<>Nil then
      result:= TStrings(GetOrdProp(DataSet, PropInfo));
end;

Function wwGetLookupTables(dataSet: TDataSet): TList;
{var PropInfo: PPropInfo;}
begin
   if dataSet is TwwTable then result:= TwwTable(dataSet).LookupTables
   else if dataSet is TwwQuery then result:= TwwQuery(dataSet).LookupTables
   else if dataSet is TwwQBE then result:= TwwQBE(dataSet).LookupTables
   else if dataSet is TwwStoredProc then result:= TwwStoredProc(dataSet).LookupTables
   else result:= nil
end;

Function wwGetFilterFieldValue(method: TMethod;AFieldName:string): TParam;
begin
   result:= TwwFilterFieldMethod(Method)(AFieldName);
end;

Function wwDataSetGetLinks(dataSet: TDataSet; lookupFieldName: string): string;
var parts: TStrings;
    i: integer;
    FLookupFields, FLookupLinks: TStrings;
begin
   result:= '';
   if wwGetLookupLinks(dataSet)=Nil then exit;

   parts:= TStringList.create;
   FLookupFields:= wwGetLookupFields(dataSet);
   FLookupLinks:= wwGetLookupLinks(dataSet);

   try
      for i:= 0 to FLookupfields.count-1 do begin
         strBreakApart(FLookupFields.Strings[i], ';', parts);
         if (parts[0]= lookupfieldName) then begin
            result:= FlookupLinks.strings[i];
            break;
         end
      end;
      parts.free;
   except
      parts.free;
   end
end;

Function wwDataSetGetDisplayField(dataSet: TDataSet; lookupFieldName: string): string;
var parts: TStrings;
    i: integer;
    FLookupFields: TStrings;
begin
   result:= '';
   if wwGetLookupFields(dataSet)=Nil then exit;

   parts:= TStringList.create;
   FLookupFields:= wwGetLookupFields(dataSet);

   try
      for i:= 0 to FLookupfields.count-1 do begin
         strBreakApart(FLookupFields.Strings[i], ';', parts);
         if (parts[0]= lookupfieldName) then begin
            result:= parts[3];
            break;
         end
      end;
   finally
      parts.free;
   end
end;

Function wwGetDatabaseName(dataSet: TDataSet): String;
var PropInfo: PPropInfo;
begin
   Result:= '';
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo, 'DatabaseName');
   if PropInfo<>Nil then
      result:= GetStrProp(DataSet, PropInfo);
end;

Function wwGetConnection(dataSet: TDataSet): TComponent;
var PropInfo: PPropInfo;
begin
   Result:= nil;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo, 'Connection');
   if PropInfo<>Nil then begin
      result:= TComponent(GetOrdProp(dataset, PropInfo));
   end
end;

Function wwGetConnectionString(dataSet: TDataSet): String;
var PropInfo: PPropInfo;
begin
   Result:= '';
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo, 'ConnectionString');
   if PropInfo<>Nil then
      result:= GetStrProp(DataSet, PropInfo);
end;

Function wwGetIBDatabase(dataSet: TDataSet): TComponent;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   PropInfo:= Typinfo.GetPropInfo(dataset.ClassInfo,'DataBase');
   if PropInfo<>Nil then begin
      result:= TComponent(GetOrdProp(dataset, PropInfo));
   end
end;

Function wwSetIBDatabase(Dataset: TDataSet; db: TComponent): boolean;
var PropInfo: PPropInfo;
begin
   result:= False;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'Database');
   if (PropInfo <> nil) and (PropInfo^.Proptype^.Kind = tkClass) then
   begin
       SetOrdProp(Dataset,PropInfo,LongInt(db));
       result:= True;
   end;
end;

Function wwGetAlwaysTransparent(ctrl:  TControl): boolean;
var PropInfo: PPropInfo;
begin
   Result:= False;
   PropInfo:= Typinfo.GetPropInfo(ctrl.ClassInfo, 'AlwaysTransparent');
   if PropInfo<>Nil then
   begin
      result:= Boolean(GetOrdProp(ctrl, PropInfo));
      exit;
   end;

   PropInfo:= Typinfo.GetPropInfo(ctrl.ClassInfo, 'Transparent');
   if PropInfo<>Nil then begin
      result:= Boolean(GetOrdProp(ctrl, PropInfo));
      exit;
   end
end;

Function wwGetTableName(dataSet: TDataSet): String;
var PropInfo: PPropInfo;
begin
   Result:= '';
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo, 'TableName');
   if PropInfo<>Nil then
      result:= GetStrProp(DataSet, PropInfo);
//   if dataSet is TwwTable then result:= TwwTable(dataSet).tableName
//   else result:= '?';
end;

Function wwDataSetIsValidField(dataset : TComponent; fieldName : string): boolean;
var i: integer;
begin
   result:= False;
   if not (dataset is TDataset) then exit;
   if dataSet=Nil then exit;

   with TDataSet(dataset) do begin
      for i:= 0 to fieldCount-1 do begin
         if (uppercase(fieldName) = uppercase(fields[i].fieldName)) then begin
            result:= true;
            break;
         end;
      end
   end
end;


procedure wwDataSetUpdateFieldProperties(dataSet: TDataSet; selected: TStrings);
var i: integer;
    parts: TStrings;
begin
   parts := TStringList.create;

   dataSet.disableControls; {5/27/95}

   for i:= 0 to dataSet.fieldCount-1 do begin
      dataSet.fields[i].visible:= False;
   end;
   if selected<>Nil then begin
      for i:= 0 to selected.count-1 do begin
         strBreakApart(selected[i], #9, parts);
         if wwDataSetIsValidfield(dataSet, parts[0]) then begin
            dataSet.fieldByName(parts[0]).displayWidth:= strtoint(parts[1]);
            dataSet.fieldByName(parts[0]).displayLabel:= parts[2];
            dataSet.fieldByName(parts[0]).index:= i;
            dataSet.fieldByName(parts[0]).visible:= True;
         end;
      end;
   end;

   dataSet.enableControls; {5/27/95}

   parts.Free;
end;

Function wwDataSet(dataSet : TDataSet): boolean;
begin
   if dataset=nil then result:= false
   else begin
     result:= True;
   end;

end;

Procedure wwDebug(s: string);
begin
   MessageDlg(s, mtinformation, [mbok], 0);
end;

{ Win95 for Bitmap support }
procedure GetLookupFields(curField: Tfield;
   var databasename, tableName, displayFieldName: string;
   var joins: string);
var found: boolean;
    i: integer;
    parts: TStrings;
    gridTable: TDataSet;
begin
      found:= false;
      gridTable:= curField.dataset;
      if gridTable=nil then exit;

      parts:= TStringList.create;

      with wwGetLookupFields(gridTable) do begin