Layer Rename Macro
Posted: Tue Oct 19, 2010 4:07 pmCode: 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.