You are not logged in.
Pages: 1
Hello,
in musical files, i have often someting like
"Variation XV Canone alla Quinta.flac"
Such roman number does'nt sort correctly so i wrote a VBS function which run and convert it to Pascal.
function RomanToArabic(Roman:string):string;
// limited to roman string <255 car !!
var
idx:byte;
total, valPrec, valCourante:Word;
begin
ValPrec:=65535;
for i:=1 to Length(Roman) do
begin
case roman[idx] of
'M' : valCourante:=1000;
'D' : valCourante:=500;
'C' : valCourante:=100;
'L' : valCourante:=50;
'X' : valCourante:=10;
'V' : valCourante:=5;
'I' : valCourante:=1;
end;
total:=total+valcourante;
if valcourante>valprec then valprec:=valprec - (2*valprec);
valprec:=valcourante;
end;
result:=IntToStr(total);
end;
But my problem now is to use it.
I know to use a regexp to to extract a $x value but i don't know how to collect this value, how to apply the function and how to insert the result back to the filename.
An idea can be to allow the possibility to use $1...$9 as parameters for users functions.
If you can help me it would be nice.
Regards
Eric
Offline
Hi and welcome Eric!
I don't know.... but here are some hints:
http://www.den4b.com/wiki/ReNamer:Pascal_Script
In Pascal Script, ReNamer has defined the FileName variable to represent the New Name of the File.
Therefore, in your script, you will have to manipulate this variable to change the filename.http://www.den4b.com/wiki/ReNamer:Pasca … g_Handling
function SubMatchesRegEx(const Input, Find: WideString;const CaseSensitive: Boolean): TStringsArray;
My guess is something like this idea may be an start:
(non tested script)
var
Parts: TStringsArray;
begin
Parts := SubMatchesRegEx(FileName , '(.+ )([MDCLXVI]+)( .+)', TRUE);
If (Length(Parts) = 3)Then
begin
// WideShowMessage(Parts[0] + Parts[1] + Parts[2]);
FileName := Parts[0] + RomanToArabic(Parts[1]) + Parts[2];
Exit;
End;
function RomanToArabic(Roman:string):string;
;
;
end;
end.
HTH?
Read the *WIKI* for HELP + MANUAL + Tips&Tricks.
If ReNamer had helped you, please *DONATE* to Denis or buy a PRO license. (Read *Lite vs Pro*)
Offline
OK, I didn't get peace, so here is my tested script:
FROM:
"Variation XV Canone alla Quinta.flac"
TO:
"Variation 15 Canone alla Quinta.flac"
USE PascalScript (http://www.den4b.com/wiki/ReNamer:Rules:PascalScript)
{
Change Roman numbers to arabic:
FROM: "Variation XV Canone alla Quinta.flac"
TO: "Variation 15 Canone alla Quinta.flac"
}
// Helper Function:
function RomanToArabic(Roman:string):string;
(* limited to roman string <255 car !! *)
var
idx:byte;
total, valPrec, valCourante:Word;
begin
ValPrec:=65535;
for idx:=1 to Length(Roman) do
begin
case roman[idx] of
'M' : valCourante:=1000;
'D' : valCourante:=500;
'C' : valCourante:=100;
'L' : valCourante:=50;
'X' : valCourante:=10;
'V' : valCourante:=5;
'I' : valCourante:=1;
end;
total:=total+valcourante;
if valcourante>valprec then valprec:=valprec - (2*valprec);
valprec:=valcourante;
end;
result:=IntToStr(total);
end;
// Main script:
var
Parts: TStringsArray;
begin
Parts := SubMatchesRegEx(FileName , '(.+ )([MDCLXVI]+)( .+)', TRUE);
If (Length(Parts) = 3)Then
begin
// WideShowMessage(Parts[0] + Parts[1] + Parts[2]);
FileName := Parts[0] + RomanToArabic(Parts[1]) + Parts[2];
Exit;
End;
end.
HTH?
Last edited by Stefan (2015-10-14 12:43)
Read the *WIKI* for HELP + MANUAL + Tips&Tricks.
If ReNamer had helped you, please *DONATE* to Denis or buy a PRO license. (Read *Lite vs Pro*)
Offline
Hello Stefan,
thanks for help and bonus : Now I know the HTH acronym :)
Thats works perfectly.
As idea of evolution, i imagine a custom string function library on a side and on the regex rule tab , in the replace line, the ability to replace a subexpression by function(subexpression).
I use very often Renamer and am happy to have bought it.
Regards
Eric
Offline
I went with a bit of an old fashioned and hardcore approach - manually parsing, extracting and replacing all roman numerals. The result is a more flexible way than RegEx, by allowing roman numerals to appear at the start or end of name, surrounded by punctuation, etc.
Example: "VI test (M) test-XI.txt" will be converted to "6 test (1000) test-11.txt"
WARNING: In this code the RomanToArabic function is the one that you have provided! Beware that it does not handle least-significant-order roman numerals correctly, i.e. IX and XI both get converted to 11, while it should be 9 and 11, respectively.
const
AllRomanDigits = 'MDCLXVI';
function RomanToArabic(const Roman: String): String;
var
i: byte;
total, valPrec, valCourante: Word;
begin
ValPrec:=65535;
for i:=1 to Length(Roman) do
begin
case roman[i] of
'M' : valCourante:=1000;
'D' : valCourante:=500;
'C' : valCourante:=100;
'L' : valCourante:=50;
'X' : valCourante:=10;
'V' : valCourante:=5;
'I' : valCourante:=1;
end;
total:=total+valcourante;
if valcourante>valprec then
valprec:=valprec - (2*valprec);
valprec:=valcourante;
end;
result:=IntToStr(total);
end;
function IsWideCharWordBreak(const WC: WideChar): Boolean;
begin
Result := IsWideCharSpace(WC) or IsWideCharPunct(WC);
end;
function FindRomanNumber(const Subject: WideString;
out RomanNumber: WideString; var NextPosition: Integer): Boolean;
var
Started: Boolean;
begin
Result := False;
Started := (NextPosition = 1);
RomanNumber := '';
while NextPosition <= Length(Subject) do
begin
if IsWideCharWordBreak(Subject[NextPosition]) then
begin
if Length(RomanNumber) > 0 then
Break;
Started := True;
end
else if Started then
begin
if WidePos(Subject[NextPosition], AllRomanDigits) > 0 then
RomanNumber := RomanNumber + Subject[NextPosition]
else
begin
Started := False;
RomanNumber := '';
end;
end;
NextPosition := NextPosition + 1;
end;
Result := WideLength(RomanNumber) > 0;
end;
procedure ReplaceRomanDigits(var S: WideString);
var
RomanNumber, ArabicNumber: WideString;
NextPosition, RomanNumberPos: Integer;
begin
NextPosition := 1;
while FindRomanNumber(S, RomanNumber, NextPosition) do
begin
ArabicNumber := RomanToArabic(RomanNumber);
RomanNumberPos := NextPosition - WideLength(RomanNumber);
WideDelete(S, RomanNumberPos, WideLength(RomanNumber));
WideInsert(ArabicNumber, S, RomanNumberPos);
NextPosition := NextPosition - WideLength(RomanNumber) + WideLength(ArabicNumber);
end;
end;
var
BaseName: WideString;
begin
BaseName := WideExtractBaseName(FileName);
ReplaceRomanDigits(BaseName);
FileName := BaseName + WideExtractFileExt(FileName);
end.
Offline
Hi,
thanks for this code. I will look it further later to try to full understand it. (The last time i do Turbo Pascal was in 1984.)
I try my vbs code and it work. In fact, i do a mistake when I convert VBS to Pascal.
The good code is a modification after the test.
replace :
if valcourante>valprec then valprec:=valprec - (2*valprec);
by
if valcourante>valprec then total:=total - (valprec+valprec);
Sorry .
the good code with all your modifications is :
const
AllRomanDigits = 'MDCLXVI';
function RomanToArabic(const Roman: String): String;
var
i: byte;
total, valPrec, valCourante: Word;
begin
ValPrec:=65535;
for i:=1 to Length(Roman) do
begin
case roman[i] of
'M' : valCourante:=1000;
'D' : valCourante:=500;
'C' : valCourante:=100;
'L' : valCourante:=50;
'X' : valCourante:=10;
'V' : valCourante:=5;
'I' : valCourante:=1;
end;
total:=total + valCourante;
if valCourante > valPrec then total:=total - (valPrec + valPrec);
valPrec:=valCourante;
end;
result:=IntToStr(total);
end;
function IsWideCharWordBreak(const WC: WideChar): Boolean;
begin
Result := IsWideCharSpace(WC) or IsWideCharPunct(WC);
end;
function FindRomanNumber(const Subject: WideString;
out RomanNumber: WideString; var NextPosition: Integer): Boolean;
var
Started: Boolean;
begin
Result := False;
Started := (NextPosition = 1);
RomanNumber := '';
while NextPosition <= Length(Subject) do
begin
if IsWideCharWordBreak(Subject[NextPosition]) then
begin
if Length(RomanNumber) > 0 then
Break;
Started := True;
end
else if Started then
begin
if WidePos(Subject[NextPosition], AllRomanDigits) > 0 then
RomanNumber := RomanNumber + Subject[NextPosition]
else
begin
Started := False;
RomanNumber := '';
end;
end;
NextPosition := NextPosition + 1;
end;
Result := WideLength(RomanNumber) > 0;
end;
procedure ReplaceRomanDigits(var S: WideString);
var
RomanNumber, ArabicNumber: WideString;
NextPosition, RomanNumberPos: Integer;
begin
NextPosition := 1;
while FindRomanNumber(S, RomanNumber, NextPosition) do
begin
ArabicNumber := RomanToArabic(RomanNumber);
RomanNumberPos := NextPosition - WideLength(RomanNumber);
WideDelete(S, RomanNumberPos, WideLength(RomanNumber));
WideInsert(ArabicNumber, S, RomanNumberPos);
NextPosition := NextPosition - WideLength(RomanNumber) + WideLength(ArabicNumber);
end;
end;
var
BaseName: WideString;
begin
BaseName := WideExtractBaseName(FileName);
ReplaceRomanDigits(BaseName);
FileName := BaseName + WideExtractFileExt(FileName);
end.
This code has some limits and "unreal" roman numbers are interpreted like IXI =10
I test (in VBS) RomanToArabic from 1 to 4000 with the ArabicToRoman (den4b.com/forum/viewtopic.php?id=828) and it works till 4000 where ArabicToRoman produce M(V) but RomanToArabic expect MMMM.
I try "MMMMDCCCLXXXVIII" which give 4888 (Wikipedia : fr.wikipedia.org/wiki/Num%C3%A9ration_romaine)
Eric
Offline
Pages: 1