PROGRAM CoordinationSystem;
{-- ***************************************************************************
 -- ** Descr. : Converts a forms module from Character to Real Coordinates and
 -- **          visa versa. this implementation is based upon the chgcoord.cpp
 -- **          found in oracles fapi sdk examples.
 -- **
 -- ** MINVERS: requires FormsAPI Master 1.0 Build 231 and up
 -- ***************************************************************************
 -- ** 04-Jan-02 1.001.00 Initial Creation, muellers@orcl-toolbox.com
 -- ** 02-Feb-02 1.002.00 default fontscale should be ignored when target=real, muellers@orcl-toolbox.com
 -- ***************************************************************************}


{*Global Variable Declaration*}
VAR
  v_filename       : varchar2;
  i,j              : number;
  frm              : number;
  x                : number;
  files            : TStringList;
  ps               : TParamScreen;
  pb               : TParamBoard;
  coordsystem      : number;
  CoordObj         : number;
  usedeffntscale   : boolean;
  coordrealunit    : number;
  modifier         : number;


{*Main Program Block*}
BEGIN
    //build together a nice parameter screen ...
    ps := TParamScreen.create;
    pb := ps.AddBoard('Modules',picModules);
    pb.addparam(parLabel,'MYLABEL','Converts a forms module from <B>Character</B> to <B>Real coordinates</B> and vice versa.','','');
    pb.addparam(parFiles,'FILES','Source Files','','Forms Modules (*.fmb)|*.fmb|All Files (*.*)|*.*');
    pb.addparam(parPathname,'TRGPATH','Target Path','','');
    pb.addparam(parRadiogroup,'COORDSYS','Target System','Real','Character'+c_cr+ 'Real');
    pb := ps.AddBoard('When converting to Real Coordinates ...',picOptions);
    pb.addparam(parComboListbox,'COORDREAL','Real Coords','PIXEL','PIXEL'+c_cr+'CENTIMETER'+c_cr+'INCH'+c_cr+'POINT'+c_cr+'DECIPOINT');
    pb := ps.AddBoard('When converting to Character Coordinates ...',picOptions);
    pb.addparam(parCheckBox,'CHARDEFSCALE','Use default char scaling and not char cell width/height parameters','Y','');
    pb.addparam(parInteger,'CELLWIDTH','Char cell width','7','');
    pb.addparam(parInteger,'CELLHEIGHT','Char cell height','14','');

    //show the parameter screen and wait for inputs
    if ps.ShowParamScreen('Coordination System ...') then
    begin
      //because it is nice in the log to see what parameters we have specified
      //we just write them out
      LogParamScreen(ps);
      files := tstringlist.create;
      files.text := ps.paramvalue('FILES');

      //initalize the use default font scale variable for later use
      usedeffntscale := ps.paramvalue('CHARDEFSCALE')='Y';

      //initalize the real unit type variable for later use
      if ps.paramvalue('COORDREAL')='PIXEL' then coordrealunit := D2FC_REUN_PIXEL;
      if ps.paramvalue('COORDREAL')='CENTIMETER' then coordrealunit := D2FC_REUN_CENTIMETER;
      if ps.paramvalue('COORDREAL')='INCH' then coordrealunit := D2FC_REUN_INCH;
      if ps.paramvalue('COORDREAL')='POINT' then coordrealunit := D2FC_REUN_POINT;
      if ps.paramvalue('COORDREAL')='DECIPOINT' then coordrealunit := D2FC_REUN_DECIPOINT;


      if ps.paramvalue('COORDSYS') = 'Real'
        then coordsystem := D2FC_COSY_REAL
        else coordsystem := D2FC_COSY_CHARACTER;


      for j := 0 to files.count-1 do
      begin
        v_filename := files.strings[j];
        logadd('Checking ('+to_char(j+1)+'/'+to_char(files.count)+' '+v_filename);

        try

          // load the forms module
          frm := API_LoadModule(files.strings[j]);

          //create a Coordination System Object with data extracted from the loaded module
          CoordObj := api_GetCoord(frm);

          //do we have to make a change to the coordination system?!
          if Generic_GetValue(CoordObj,D2FP_COORD_SYS) <> coordsystem then
          begin
            Generic_SetValue(CoordObj,D2FP_COORD_SYS,coordsystem);
          end;

          //do we have to make a change to the default font scaling?!
          if coordsystem = D2FC_COSY_CHARACTER then
          begin
            if Generic_GetValue(CoordObj,D2FP_DFLT_FNT_SCALING) <> usedeffntscale then
            begin
              Generic_SetValue(CoordObj,D2FP_DFLT_FNT_SCALING,usedeffntscale);
            end;
          end;

          //is the realunit type already correct (pixel, points, centimeter)
          if coordsystem = D2FC_COSY_REAL then
          begin
            if Generic_GetValue(CoordObj,D2FP_REAL_UNIT) <> coordrealunit then
            begin
              Generic_SetValue(CoordObj,D2FP_REAL_UNIT, coordrealunit);
            end;
          end;

          // inch and centimeter are to special coordsystems as they save
          // values in 1000s to cope with evtl. decimalpoints
          if (coordrealunit = D2FC_REUN_INCH) or (coordrealunit = D2FC_REUN_CENTIMETER)
            then modifier := 1000
            else modifier := 1;


          // set the character cell information if not default font scaling or real specified
          if    (usedeffntscale=false)
             or (coordsystem = D2FC_COSY_REAL) then
          begin
            x  := Generic_GetValue(CoordObj,D2FP_CHAR_CELL_WID);
            if (x div modifier) <> (to_number(ps.paramvalue('CELLWIDTH')) )  then
            begin
              Generic_SetValue(CoordObj,D2FP_CHAR_CELL_WID, to_number(ps.paramvalue('CELLWIDTH')) * modifier);
            end;

            x  := Generic_GetValue(CoordObj,D2FP_CHAR_CELL_HGT);
            if (x div modifier) <> (to_number(ps.paramvalue('CELLHEIGHT')) )  then
            begin
              Generic_SetValue(CoordObj,D2FP_CHAR_CELL_HGT, to_number(ps.paramvalue('CELLHEIGHT')) * modifier);
            end;

          end;

          //now apply the changed coordination system object back to the formsmodule
          //this will cascade down everything just like it does inside FormsBuilder
          Coord_Apply(CoordObj,frm);

          //destroy the coordination object that we now no longer need anymore
          generic_destroy(CoordObj);

          //now modify the filename to point to the new location
          v_filename := ps.ParamValue('TRGPATH') + '\' + ExtractFileName(v_filename);

          //and save it to the new location
          API_SaveModule(frm,v_filename);

          //... 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;

      //free the file list from memory;
      files.free;

    end else
    begin
      //user must have pressed cancel on parameterscreen
      logadd('Canceled on parameterscreen!');
    end;
    // free the parameter screen
    ps.free;


END.