The DataCAD Developer Network (DDN) is an online resource for information and support for DCAL® (DataCAD Applications Language) developers as well as anyone interested in creating fonts, toolbars, hatch patterns, or linetypes for use in DataCAD.

Moderator: pjdixit

#50715 by Mark F. Madura
Tue Oct 19, 2010 4:07 pm
Code: Select all{
  DCAL for Delphi Program: LyrRename
}

library LyrRename;

uses
  // Delphi Units
   sysutils,

  // DCAL for Delphi Header Files
   uconstants in '..\Header Files\UConstants.pas',
   uinterfaces in '..\Header Files\UInterfaces.pas',
   uinterfacesrecords in '..\Header Files\UInterfacesRecords.pas',
   urecords in '..\Header Files\URecords.pas',
   uvariables in '..\Header Files\UVariables.pas';

{$e dmx}  // dmx is the extension for DCAL for Delphi Dll's

// The values stored in the records you define here will be rememberd
// between dispatcher calls because they are pushed onto the command stack
type
   renamel = record
      state: asint;
      searchstring: str255;
      replacestring: str255;
      case byte of
         0: (getp: getpointarg);
         1: (dgets: dgetstrarg);
   end;

   prenamel = ^renamel;

function SearchAndReplace(const str: string; searchstring: string;
   const replacestring: string; casesens: boolean = false): string;

var
   p: word;
   done: boolean;
   newstring, tmprepl, tmpsrch: string;
   cd, charsdeleted: integer;
   res: string;

begin
   if (length(searchstring) = 0) then begin
      result := str;
      exit;
   end;

   if not casesens then begin
      newstring := ansiuppercase(str);
      searchstring := ansiuppercase(searchstring);
   end
   else begin
      newstring := str;
   end;

   res := '';
   done := false;
   charsdeleted := 0;
   while not done do begin
      p := pos(searchstring, newstring);
      done := (p = 0);
      if done then begin
         res := res + copy(str, charsdeleted + 1, length(newstring));
      end
      else begin
         tmpsrch := searchstring;
         tmprepl := replacestring;

         // Get the characters up to the text to be replaced and append them
         // to the resulting (post-replace) string.
         res := res + copy(str, charsdeleted + 1, p - 1);

         // Now calculate the number of characters
         // up to *and including* the text to be replaced.
         cd := p + length(tmpsrch) - 1;

         // Chop off the text up to and including the text to be replaced,
         // so it can be used for the pos() call in the next loop
         delete(newstring, 1, cd);

         // Increment total number of characters deleted.
         inc(charsdeleted, cd);

         // Append the replace text to the resulting (post-replace) string.
         res := res + tmprepl;
      end;
   end;
   result := res;
end; { SearchAndReplace }

// Check the replacement string for invalid characters
function Valid_Characters(name: shortstring): boolean;
const
   // These characters are not allowed in Windows file names.
   forbiddenchars: set of char = ['?', '[', ']', '/', '\', '=', '+', '<', '>',
      ':', ';', '''', ',', '*'];

var
   len, i: asint;

begin
   result := true;
   len := length(name);
   for i := 1 to len do begin
      if (name[i] in forbiddenchars) or (ord(name[i]) < 32) then begin
         result := false; // invalid characters found
         exit;
      end;
   end;
end; { Valid_Characters }

// Then use this on the new layer name prior to committing it to the database
{ 0 = ok }
{ 1 = invalid character in layer name }
{ 2 = name already used }
{ 3 = name too short (0 chars) }
function Check_Layer_Name(name: shortstring): asint;

var
   temp_name: shortstring;
   rlyr: rlayer;
   plyr: lgl_addr;

begin
   name := trim(name);
   if (length(name) = 0) then begin
      result := 3; // too short
   end
   else begin
      result := 0;
      if not Valid_Characters(name) then begin
         result := 1; // invalid character
      end
      else begin
         plyr := lyr_first;
         while lyr_get(plyr, rlyr) do begin
            plyr := lyr_next(rlyr.addr);
            getlonglayername(plyr, temp_name);
            temp_name := trim(temp_name);
            if sametext(temp_name, name) then begin
               result := 2; // duplicate layer name
               exit;
            end;
         end;
      end;
   end;
end; { Check_Layer_Name }

procedure LayerRename(searchstring: str255; replacestring: str255);
var
   lyr: layer;
   newname, lyrname: shortstring;
   lyrschanged, lyrsskipped: asint;
   howmany: str255;

begin
   lyrschanged := 0;
   lyrsskipped := 0;
   lyr := lyr_first;
   while not lyr_nil(lyr) do begin
      getlonglayername(lyr, lyrname);
      newname := SearchAndReplace(lyrname, searchstring, replacestring, false);
      if Check_Layer_Name(newname) = 0 then begin
      // if no invalid characters are found...
         setlayername(lyr, newname);  // ...then update the layer name.
         if not ansisametext(newname, lyrname) then
            lyrschanged := lyrschanged + 1
         else
            lyrsskipped := lyrsskipped + 1;
      end
      else
         lyrsskipped := lyrsskipped + 1;
      lyr := lyr_next(lyr);
   end;
   howmany := inttostr(lyrschanged) + ' layers changed.  ' +
      inttostr(lyrsskipped) + ' layers skipped.';
   wrterr(howmany, true);
end;

// Main Function (Re-entrant State Machine)
function Rename_Main(act: action; pl, pargs: pointer): wanttype;
// The values stored in variables you define here will not be retained
// between dispatcher calls because they are not pushed onto the stack
var
   retval: wanttype; { asint; }
   l: prenamel;

begin
   l := prenamel(pl);

  { Section 3: Aagain - Return to menus and wait for input }
   if act = aagain then begin // Re-entrant section
      case l.state of
         1: begin
          // If a key was pressed or a menu button was selected...
               if l.getp.result = res_escape then begin
                  case l.getp.key of
                     f1: { Search }
                        l.state := 2;
                     f2: { Replace }
                        l.state := 3;
                     s9: { Begin }
                        begin
                           lblsinit;
                           lblson1;
                           LayerRename(l.searchstring, l.replacestring);
                        end;
                     s0: { Exit }
                        l.state := 0;
                  end;
               end;
            end;
         2: begin // search string
               if l.dgets.result = res_normal then begin
                  if Valid_Characters(l.searchstring) then
                     l.state := 1
                  else begin // try again
                     wrterr(l.searchstring +
                        ' contains an invalid character. Please re-enter the search string.',
                        true);
                  end;
               end
               else if l.dgets.result = res_escape then begin
                  if l.dgets.key = s0 then
                     l.state := 1;
               end;
            end;
         3: begin // replace string
               if l.dgets.result = res_normal then begin
                  if Valid_Characters(l.replacestring) then
                     l.state := 1
                  else begin // try again
                     wrterr(l.replacestring +
                        ' contains an invalid character. Please re-enter the replacement string.',
                        true);
                  end;
               end
               else if l.dgets.result = res_escape then begin
                  if l.dgets.key = s0 then
                     l.state := 1;
               end;
            end;
      else
         l.state := 0;
      end;
   end;

  { Section 2: Afirst - Tasks to perform only once }
   if act = afirst then begin // Initialize local state and other variables
      wrterr('Layer Renamer Version 1.0 by Joey Nips', true);
      l.state := 1;
   end

  { Section 4: Alast - If your macro has been interrupted by user action }
   else if act = alast then begin
    // If you're going to get blown off the stack...
    // (i.e.) the user pressed a hotkey,
    // then this is your last chance to clean up temporary data.
   end

  { Section 1: AlSize - Allocate memory on stack for local variables }
   else if act = alsize then begin
      setlocalsize(sizeof(l^));
   end;

   if act <> alsize then begin // Action section
      case l.state of
         1: begin
               wrtlvl('Rename'); // Set Menu Title
               lblsinit;
               lblset(1, 'Search', 'Enter the string search string');
               if l.searchstring = '' then
                  lblmsg(1, 'Enter the string search string')
               else
                  lblmsg(1, 'Current search string: ' + l.searchstring);
               lblset(2, 'Replace');
               if l.replacestring = '' then
                  lblmsg(2, 'Enter the replacement string')
               else
                  lblmsg(2, 'Current replacement string: ' + l.replacestring);

               lblset(19, 'Begin');
            // lblset(20, 'Exit');  //In DCAL for Delphi use lblson1 instead
               lblson1;

               wrtmsg('Enter the search and replacement strings or select begin.');

               getpoint(l.getp, retval);
            end;
         2: begin
               lblsinit;
               lblson1;
               wrtmsg('Enter the SEARCH string: ', true);
               calldgetstr255(l.searchstring, 255, l.dgets, retval);
          { Dispatcher will call as soon as it has control, go to Aagain: 2 }
            end;
         3: begin
               lblsinit;
               lblson1;
               wrtmsg('Enter the REPLACEMENT string: ', true);
               calldgetstr255(l.replacestring, 255, l.dgets, retval);
          { Dispatcher will call as soon as it has control, go to Aagain: 3 }
            end;
      else
         retval := xdone; // Don't go back to Aagain
      end;
   end;
   result := retval;
end;
// End of Main Function (Re-entrant State Machine)

function main(dcalstate: asint; act: action; pl, pargs: pointer)
   : wanttype; stdcall;
begin
   case dcalstate of
      xdcalstatebegin:
         result := Rename_Main(act, pl, pargs);
   else
      result := xdone; { Necessary }
   end;
end;

exports
   main; { This is the entry function that will be called by DataCAD.
  All DCAL Dlls will have this function. }

begin

end.

Who is online

Users browsing this forum: No registered users and 1 guest

About DataCAD Forum

The DataCAD Forum is a FREE online community we provide to enhance your experience with DataCAD.

We hope you'll visit often to get answers, share ideas, and interact with other DataCAD users around the world.

DataCAD

Software for AEC Professionals Since 1984