PROGRAM PropertyClass_Check;
{-- ***************************************************************************
 -- ** Descr. : This script checks if property classes assigned to any object
 -- **          have manually overriden attributes and reports them.
 -- **
 -- ** MINVERS: 252
 -- ***************************************************************************
 -- ** 28/12/01 1.001.00 Initial Creation, muellers@orcl-toolbox.com
 -- ** 17/05/03 1.002.00 use new ChangedInherited func. muellers@orcl-toolbox.com
 -- ***************************************************************************}

{*Variable Declaration*}
VAR
  ps           : TParamScreen;
  pb           : TParamBoard;
  files        : TStringList;
  v_filename   : varchar2;
  i,j,k        : number;
  frm          : number;
  objs         : TStringList;
  obj          : number;
  pcfirst      : boolean;
  pcval        : string;
  objval       : string;


{*Main Program Block*}
BEGIN
    //build together a nice parameter screen ...
    ps := TParamScreen.create;
    pb := ps.AddBoard('Modules',picModules);
    pb.addparam(parLabel,'MYLABEL','This script checks that no property class attributes are overriden.','','');
    pb.addparam(parFiles,'SRC','Source Modules','','Forms Modules (*.fmb)|*.fmb');

    //show the parameter screen and wait for inputs
    if ps.ShowParamScreen('Check PropertyClasses ...') then
    begin

      //get the list of fmb-modules to process
      files := tstringlist.create;
      files.text := ps.ParamValue('SRC');

      //loop through all selected files
      for i := 0 to files.count-1 do
      begin
        v_filename := files.strings[i];
        logadd('Processing ('+to_char(i+1)+'/'+to_char(files.count)+') '+v_filename);

        try
          //load the module
          frm := API_LoadModule(v_filename);

          //Get a list of all the forms objects and loop through
          objs := API_GetAllObjects(frm);
          for j := 0 to objs.count-1 do
          begin
            //get the object from the list
            obj := objs.objects[j];

            //is the object sublassed?
            if Generic_IsSubclassed(obj) then
            begin
              //is it subclassed from a propertyclass
              if (Generic_GetNumProp(obj,D2FP_PAR_TYP)=D2FFO_PROP_CLASS) then
              begin
                pcfirst := true;

                //loop through all possible properties
                for k := 1 to D2FP_MAX do
                begin
                  //has the item this property?
                  if     (Generic_HasProp(obj,k)) then
                  begin
                    //overridden?
                    if (Generic_isPropChangeInherited(obj,k)=true) and (Property_GetPropName(k)<>'') then
                    begin
                      //we found a overridden subclassed property! log it ..
                      if pcfirst then
                      begin
                        pcfirst := false;
                        logadd('  => '+api_getobjectpath(obj) );
                      end;

                      //get current property value
                      objval := Substr(Generic_GetValue(obj,k),1,30);

                      //get original property value
                      Generic_InheritProp(obj,k);
                      pcval := Substr(Generic_GetValue(obj,k),1,30);

                      //and report it ...
                      logadd('    => '+Property_GetPropName(k)+' - [PC:'+pcval+']<>[OBJ:'+objval+']' );
                    end;
                  end;
                end;
              end;
            end;
          end;
          objs.free;

          //... and finally release the module from memory
          API_DestroyModule(frm);

        except
          // ups! an error happened, so just log it and proceed to the next module
          logadd(' =>'+GetError,LogError);
        end;
      end;

    end else
    begin
      //user must have pressed cancel on parameterscreen
      logadd('Cancelled on parameterscreen!');
    end;

    // free the parameter screen
    ps.free;

END.