wwcommon.pas

来自「infopower 4000 for delphi 2006」· PAS 代码 · 共 1,887 行 · 第 1/5 页

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 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
         for i:= 0 to count-1 do begin
            strBreakApart(strings[i], ';', parts);
            if parts[0]=curField.fieldName then begin
               if parts.count<5 then continue;

               found:=True;
               databaseName:= parts[1];
               tableName:= parts[2];
               displayFieldName:= parts[3];

               joins:= wwGetLookupLinks(gridTable).Strings[i];
               break;
            end
         end
      end;

      if not found then begin
         databaseName:= wwGetDatabaseName(gridTable);
         tableName:= '';
         displayFieldName:= '';
         joins:= '';
      end;

      parts.free;

end;

{ Win95 for Bitmap support }
Function wwDataSetLookupDisplayField(
   curField: TField; var LookupValue: string; var DisplayField: TField): boolean;
var
    j, APos: integer;
    lookupTable: TwwTable;
    databasename, tableName, displayFieldName, joins: string;
    lookupTables: TList;
begin
    displayField:= curField;
    result:= False;
    if (curField=Nil) or (curField.dataSet=nil) then exit;
    if (wwGetLookupTables(curField.dataset)=nil) then exit;