PROGRAM Missing_ShortCuts;
{-- ***************************************************************************
 -- ** Descr. : This script loops through all items that can have short cuts (such 
 -- **          as menuitems, buttons, radiobuttons,etc) and looks if there is any 
 -- **          that doesn't have a shortcut assigned.
 -- ***************************************************************************
 -- ** 17/12/01 1.001.00 Initial Creation, muellers@orcl-toolbox.com
 -- ***************************************************************************}

var
  ps : TParamScreen;
  x : tparamboard;
  i : integer;
  frm : integer;
  ts : tstringlist;
  formsname : string;
  shortname : string;
  fname : string;



procedure addanal_item(p_obj : longint; p_prop: longint; p_context, p_prefix : string);
begin


  if (p_context = 'LABEL') and (D2FFO_ITEM = Generic_QueryType(p_obj)) THEN
  begin
    if generic_GetNumProp(p_obj, D2FP_ITM_TYP) = D2FC_ITTY_PB then
    begin
      if generic_GetBoolProp(p_obj, D2FP_ICONIC) = true then
        exit;
    end else
    begin
      exit;
    end;
  end;

  if (pos('&',generic_getTextProp(p_obj,p_prop))<=0)
     and (generic_getTextProp(p_obj,D2FP_ACCESS_KEY)='')  then
    saveappendstring(shortname+p_prefix+'.'+generic_GetTextProp(p_obj, D2FP_NAME)+'  [missing shortcut!]'+c_cr,fname);
end;

procedure GetAllObjects(p_obj : longint; p_prefix : string);
var v_obj : longint;
    l_prefix : string;
begin
  v_obj := p_obj;
  while v_obj <> 0 do
  begin
    if generic_HasProp(v_obj, D2FP_LABEL) then addanal_item(v_obj,D2FP_LABEL, 'LABEL', p_prefix);
    if generic_HasProp(v_obj, D2FP_BTN_1_LBL) then addanal_item(v_obj,D2FP_BTN_1_LBL, 'ALT_BTN_1', p_prefix);
    if generic_HasProp(v_obj, D2FP_BTN_2_LBL) then addanal_item(v_obj,D2FP_BTN_2_LBL, 'ALT_BTN_2', p_prefix);
    if generic_HasProp(v_obj, D2FP_BTN_3_LBL) then addanal_item(v_obj,D2FP_BTN_3_LBL, 'ALT_BTN_3', p_prefix);

    if l_prefix = ''
       then l_prefix := generic_GetTextProp(v_obj, D2FP_NAME)
       else l_prefix := p_prefix + '.'+generic_GetTextProp(v_obj, D2FP_NAME);

    if generic_HasProp(v_obj, D2FP_BLOCK) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_BLOCK),l_prefix+'.BLK');
    if generic_HasProp(v_obj, D2FP_EDITOR) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_EDITOR),l_prefix+'.EDT');
    if generic_HasProp(v_obj, D2FP_ITEM) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_ITEM),l_prefix+'.ITM');
    if generic_HasProp(v_obj, D2FP_LOV) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_LOV),l_prefix+'.LOV');
    if generic_HasProp(v_obj, D2FP_MENU) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_MENU),l_prefix+'.MNU');
    if generic_HasProp(v_obj, D2FP_MNU_ITM) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_MNU_ITM),l_prefix+'.MNI');
    if generic_HasProp(v_obj, D2FP_POPUP_MNU_OBJ) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_POPUP_MNU_OBJ),l_prefix+'.PMU');
    if generic_HasProp(v_obj, D2FP_RAD_BUT) then GetAllObjects(generic_GetObjProp(v_obj,D2FP_RAD_BUT),l_prefix+'.RAD');

    v_obj := Generic_GetObjProp(v_obj, D2FP_NEXT);

  end;

end;




BEGIN
      ps := TParamScreen.create;
      x := ps.AddBoard('Analyze missing Shortcuts',picOptions);
      x.addparam(parLabel,'MYLABEL','Please select the <B>basepath</B> of the modules that you wish to analyze for missing shortcuts:','','');
      x.addparam(parPathname,'MYPATH','Basepath','w:\formsapi master','');
      x.addparam(parLabel,'MYLABEL2','... and specify the filename for the results:','','');
      x.addparam(parsaveFilename,'P_LOGSAVE','Log Filename','c:\miss_shortcuts.txt','');
      x.addparam(parLabel,'MYDBLAB','Connection to use:','','');
      x.addparam(parDatabaseLogon,'MYDB','Database','keyowner/ty12@ty12','');

      if ps.ShowParamScreen('') then
      begin
        fname := ps.paramvalue('P_LOGSAVE');
        deletefile(fname);

        ts := GetFileList(ps.paramvalue('MYPATH') ,'*.fmb;*.mmb', true);
        logadd('number of objects: '+inttostr(ts.count));

        api_connect(ps.paramvalue('MYDB'));
        for i := 0 to ts.count-1 do
        begin

          try
          frm := api_loadmodule(ts.strings[i],false);
          shortname := rpad(extractfilename(ts.strings[i]),20);
          formsname := generic_GetTextProp(frm, D2FP_NAME);
          logadd(formsname+' ('+inttostr(i+1)+'/'+inttostr(ts.count)+')');
          getallobjects(frm,'');
          api_destroymodule(frm);
          except
            logadd('Error loading '+ts.strings[i],logerror);
          end;
        end;
        api_disconnect;
        ts.free;
        host('notepad.exe '+fname,false);
      end else
      begin
        logadd('pressed cancelbutton on parameterscreen!');
      end;
      ps.free;

END.