Page 2 of 3 FirstFirst 1 2 3 LastLast
Results 16 to 30 of 34

Thread: How to sort files with custom function?

  1. #16
    I just renamed few files which had no number.

    OK. Now I am confused.

    Code:
    ListFile.CustomSort(StringListSortCompare);
    Why it generates error

    List index out of bounds? Did you not have this error?

    Code:
    function getPrefixSmart(s: string; var sNum: String; num: Integer): string;
    var b: Byte;
      got_prefix: Boolean;
    begin
     Result := '';
     sNum:= '';
     got_prefix := false;
     for b:=1 to length(s) do
      begin
      case s[b] of
        'a'..'z':
          begin
          if not got_prefix then
            Result:=Result+s[b];
          end;
        '0'..'9':
          begin
          sNum := sNum+s[b];
          if got_prefix = false then
            got_prefix := true;
          end;
         else
            got_prefix := true;
      end;
      end;
      if not TryStrToInt(sNum, num) then
        showmessage('sNum:"'+sNum+'" from '+s);
    end;
    function StringListSortCompare(sl: TStringList; idx1, idx2: Integer): Integer;
    var
      s1   , s2   : string;  // current lines to compare
      pfs1 , pfs2 : string;  // current prefix string parts
      pfw1 , pfw2 : integer; // current prefix 'weights'
      num1 , num2 : integer; // current number parts
      sn: string;
    begin
      result := 0;
      s1 := sl[idx1];
      s2 := sl[idx2];
      pfs1 := getPrefixSmart(s1, sn, num1);
      pfs2 := getPrefixSmart(s1, sn, num2);
    accordingly.
      pfw1 := GetPrefixWeight(pfs1);
      pfw2 := GetPrefixWeight(pfs2);
      if pfw1 <> pfw2 then
        begin
        Result := pfw1 - pfw2;
        exit;
        end;
      Result := num1 - num2;
      exit;
    end;

  2. #17
    No, I do not have that error.

    However, I did notice some issues in your last posted code.
    Code:
    pfs2 := getPrefixSmart(s1, sn, num2);
    must be
    Code:
    pfs2 := getPrefixSmart(s2, sn, num2);
    and
    Code:
    function getPrefixSmart(s: string; var sNum: String; num: Integer): string;
    must be:
    Code:
    function getPrefixSmart(s: string; var sNum: String; var num: Integer): string;
    Assuming that you wish to return the num value. That is what the var is meant for: to return a value.

    Does that help ?
    Last edited by flabber; 11-Jul-22 at 13:19.
    Iedereen wist dat het onmogelijk was. Behalve dan die ene dwaas die dat niet helemaal goed had begrepen en het toch deed.

  3. #18
    It seems that is works almost perfectly. But with a little problem when copying the files. I would need to upload the whole project including the files so you can see how it works and what is on my PC. I think I can upload the photos, but I need to resize them so they will take less space.

  4. #19
    Probably a better option to show ht he whole project....

    ... however, do note that I do not use/own Delphi anymore, nor do I have a windows machine or a license to run it inside a vm. So I would have to go by the code line by line and hope to see if anything is wrong (if any).

    Also note that /you/ have Delphi 7, the IDE with a fully integrated (source) debugger and fully integrated help system

    If you run into an error then it lists the line number where the issue is located, and you can set a breakpoint around that error (and re-compile and run) and inspect the values at debug. Or you can debug things the old-fashioned way by write-lining some output (just make it a console app and run your application from a CLI).
    Iedereen wist dat het onmogelijk was. Behalve dan die ene dwaas die dat niet helemaal goed had begrepen en het toch deed.

  5. #20
    Source folder is fotky_resized
    the output one is sorted.
    If the photos are too small, I can make a bit bigger one if you need. But I will watch the not resized copies.
    Just watch the photos from ./sorted/ ordered by name from top down.

    https://sourceforge.net/projects/uc-...s.zip/download


    So when you see file 05_mcs010 and then watch the 05_mcs170 which follows that is strange the jump to 170° of view missing the frames.
    There is also 05_mcs180 to 06_mhf15 big jump...

    This does not make sense to me at this moment, but maybe I just incorrectly renamed the files? I dont know.

    See the image with the list of the original files

    One small correction is order of mh and mc, mc is lower than mh.

    Code:
    const CONST_PrefixBase: Array[0..11] of String = (
     'vvtf',
     'vvtr',
     'vvt', // very very top
     'vh',  // very high
     'sh',  // slightly high
     'mh',  // medium high
     'mc',  // middle central view
     'sl',  // slightly low
     'vl',  // very low
     'b',   // botom
     'vb',  // very bottom
     'vvb'  // very very bottom
     );
    Attached Thumbnails Attached Thumbnails Click image for larger version. 

Name:	temp000.jpg 
Views:	148 
Size:	75.6 KB 
ID:	8240  
    Last edited by chlopik; 11-Jul-22 at 15:35.

  6. #21
    without having looked long/close to your source-code I have an observation for you.

    If I understand you correctly then your aim is to have the sorted directory contain the files (copied form unsorted directory) and have that list 'viewed' in the correct (sorted) order.

    How that view is presented to you as a user depends on the program that is used to view the directory with the sorted files. What I meant by that is that I can have the unsorted directory show/view the files in the correct order because the filemanager that I use can be configured to such an extend that I can create a custom view based on the pattern of a filename.

    Having said that, I am guessing that you wish your directory with sorted files to be 'viewed' in the order that you want them to be, but based on the filename. So that when you tell your filemanager to sort the directory based on the filename that the files are 'viewed; in the correct order ? Do I understand that correct ?

    If that is the case then yes there is still something wrong with your naming because most filemanagers show the file-listing based on the ASCII values that are present in the filename.

    You can solve that in many ways, but the main point what is wrong is that you still use the prefix for the sorted filenames. They are sorted based on ASCII value and, therefor causes the 'jumps' that you are talking about.

    The easiest way to solve it is by placing a continues number from 1 to xxx in front of the filename (enough prefix zeros mandatory). But if that is something you want or not is not for me to decide. So please let me know what options you have there.
    Iedereen wist dat het onmogelijk was. Behalve dan die ene dwaas die dat niet helemaal goed had begrepen en het toch deed.

  7. #22
    Quote Originally Posted by flabber View Post
    If I understand you correctly then your aim is to have the sorted directory contain the files (copied form unsorted directory) and have that list 'viewed' in the correct (sorted) order.
    That is exact.

    Quote Originally Posted by flabber View Post
    How that view is presented to you as a user depends on the program that is used to view the directory with the sorted files. What I meant by that is that I can have the unsorted directory show/view the files in the correct order because the filemanager that I use can be configured to such an extend that I can create a custom view based on the pattern of a filename.
    Yeah, you need to view them with the sorted names, sorted logic. I am using FastStone viewer. But Windows explorer should manage that too, just to select the sorting logic by name. I looks like a movie if it is sorted and viewing faster.


    Quote Originally Posted by flabber View Post
    Having said that, I am guessing that you wish your directory with sorted files to be 'viewed' in the order that you want them to be, but based on the filename. So that when you tell your filemanager to sort the directory based on the filename that the files are 'viewed; in the correct order ? Do I understand that correct ?
    Yes.

    So I got it. So my problem is the renaming. So I need to do it in the sence of:
    StrPrefixIndex+'_'+strNumber+'_'+strDescriptivePre fix
    So the result will be string number + string number + string.

    Thank you.

  8. #23
    Senior Member Wok's Avatar
    Join Date
    Dec 2002
    Location
    Alkmaar
    Posts
    2,085
    Wisselt de inhoud van de images vaak, of is het een eenmalig shot?

    Als het eenmalig is zou je kunnen overwegen om een imagelist te maken met 9 images, deze hebben dan vaste positie's.
    Het imagebestand sla je dan op onder de naam van het object.

    Voorwaarde is dan wel dat allen images even groot zijn.
    Een Prefix, nummer & sorteren zijn dan overbodig geworden, want je weet vooraf welk plaatje bij welk object hoort.

    Gr. Peter
    10.4.2, Delphi2010, of Lazarus 2.2.0

  9. #24
    OK guy, so I have finished my work. This is the copy function, which creates new files in sorted order. I'm thankful for your help.
    Code:
    procedure TForm1.buttonClick(Sender: TObject);
    var i: Integer;
        prefix: string;
        sNum, spath, opath: String;
        number: Word;
        new_filename: string;
        pi, n: integer;
        ps, newPref, newPrefixDesc: string;
    begin
      // SORT FILES WITH StringListSortCompare callback
      ListFile.CustomSort(StringListSortCompare);
      // Copy files
      for i:=0 to ListFile.count-1 do
      begin
        prefix := getPrefixSmart(ListFile[i],ps,pi);
        for n:=0 to length(CONST_PrefixBase)-1 do
          if AnsiStartsStr(CONST_PrefixBase[n], Prefix) then
            begin
              newPref := IntToStr(n);
              if length(newPref)<2 then
                newPref := '0'+newPref;
              break;
            end;
        newPrefixDesc := copy(ListFile[i],1,length(prefix));
        new_filename := copy(ListFile[i],length(prefix)+1,length(ListFile[i])-length(prefix)-CONST_extension_length);
        new_filename := newPref+'_'+new_filename+'_'+newPrefixDesc+CONST_extension;
        spath := 'U:\3D model MAN\fotky\'+ListFile[i];
        opath := 'U:\3D model MAN\sorted\'+new_filename;
        if fileexists(spath) then
          copyfile(PChar(spath), PChar(opath), false)
        else raise Exception.Create('File not found '+spath);
      end;
    showmessage('Done.');
    end;

  10. #25
    @wok:
    Je hebt helemaal gelijk als dat opgaat for OP.

    @chlopik:
    Glad to hear you got things sorted out (phun intended).

    One question that remains lingering in my head... is this not just a simple filerenamer ? Because the following code will achieve exactly the same thing (without the need for sorting anything):
    Code:
    program copysortfiles;
    
    {$mode delphi}{$H+}
    
    uses
      classes, sysutils, strutils;
    
    const
      // Known filename Prefix (letters) table. Their index is used as 'weight'
      Prefixes: array[0..11] of string = (
       'vvtf',
       'vvtr',
       'vvt', // very very top
       'vh',  // very high
       'sh',  // slightly high
       'mh',  // medium high
       'mc',  // middle central view
       'sl',  // slightly low
       'vl',  // very low
       'b',   // bottom
       'vb',  // very bottom
       'vvb'  // very very bottom
     );
    
    function getPrefixSmart(s: string; var sNum: String; var num: Integer): string;
    var.
      idx: Byte;
      got_prefix: Boolean;
    begin
      Result := '';
      sNum:= '';
      got_prefix := false;
    
      for idx:=1 to length(s) do
      begin
        case s[idx] of
          'a'..'z':
          begin
            if not got_prefix then Result:=Result+s[idx];
          end;
          '0'..'9':
          begin
            sNum := sNum+s[idx];
            if got_prefix = false then got_prefix := true;
          end;
          else
            got_prefix := true;
        end;
      end;
      if not TryStrToInt(sNum, num) then
        writeln('ERROR: sNum:"' +sNum+ '" from '+s);
    //    showmessage('sNum:"'+sNum+'" from '+s);
    end;
    
    // Get the 'weight' of a prefix based on the index of prefixes.
    function getPrefixWeight(Prefix: string): integer;
    var
      idx: integer;
    begin
      // correction for weight in case non-matching
      result := High(Prefixes) + 1;
    
      for idx := low(Prefixes) to High(Prefixes) do
      begin
        if AnsiStartsStr(Prefixes[idx], Prefix) then
        begin
          result := idx;
          exit;
        end;
      end;
    end;
    
    // snatched somewhere from some forums (c) respective owner (whomever (s)he is)
    // do not use in production code unless modified for safety and sanity.
    // Just use the delphi copyfile function instead (fpc does not have it by default, but Lazarus does)
    function VerySimpleFileCopy(Src, Dst: string; overwrite: boolean): boolean;
    var
      Buf: TMemoryStream;
    begin
      result := false;
      if not FileExists(Src) then exit;
      if FileExists(Dst) then
      begin
        if not overwrite then exit;
        if not DeleteFile(Dst) then exit;
      end;
    
      Buf := TmemoryStream.Create;
      try
        try
          Buf.LoadFromFile(Src);
          Buf.SaveToFile(Dst);
          result := true;
        except
        end;
      finally
        Buf.Free;
      end;
    end;
    
    procedure CopyAndRenameFile(FileName, SrcFolder, DstFolder: string);
    var
      OldFileName,
      NewFilename,
      OldFullName,
      NewFullName  : string;
    
      num          : integer;
      numStr       : string;
      Prefix       : String;
      prefixWeight : integer;
    begin
      OldFileName  := FileName;
      Prefix       := GetPrefixSmart(OldFileName, NumStr, Num);
      PrefixWeight := GetPrefixWeight(Prefix);
      NewFileName  := Format('%.*d', [2, PrefixWeight]) + '_' + Format('%.*d', [3, Num]) + '_' + OldFileName;
    
      OldFullName  := IncludeTrailingPathDelimiter(SrcFolder) + OldFileName;
      NewFullname  := IncludeTrailingPathDelimiter(DstFolder) + NewFileName;
      if FileExists(OldFullName)
        then VerySimpleFileCopy(OldFullName, NewFullName, false);  // copyfile(OldFullName, NewFullName, false);
    end;
    
    
    procedure CopyDirAndRenameFiles(SrcDir, DstDir: string);
    var
      SearchRec : TSearchRec;
      SearchPath : string;
    begin
      SearchPath := IncludeTrailingPathDelimiter(SrcDir) + AllFilesMask;
    
      if FindFirst(SearchPath, faAnyFile, SearchRec) = 0 then
      begin
        repeat
          if (SearchRec.Attr and faDirectory) = 0
            then CopyAndRenameFile(SearchRec.Name, SrcDir, DstDir);
        until FindNext(SearchRec) <> 0;
        FindClose(SearchRec);
      end;
    end;
    
    
    var
      AppFolderName      : string;
      UnsortedFolderName : string;
      SortedFolderName   : string;
    
    begin
      AppFolderName      := ExtractFileDir(ParamStr(0));
      UnSortedFolderName := AppFolderName + PathDelim + 'unsorted';
      SortedFolderName   := AppFolderName + PathDelim + 'sorted';
    
      CopyDirAndRenameFiles(UnsortedFolderName, SortedFolderName);
    end.
    Iedereen wist dat het onmogelijk was. Behalve dan die ene dwaas die dat niet helemaal goed had begrepen en het toch deed.

  11. #26
    Hello flabber, I could check your code later. These days I am afraid about problems with installing a package nativejpg, I will create a question about it.

  12. #27
    When I rethink it so yes, it is easy file renamer. But the custom sort function is good.

    What is the H+ directive?

  13. #28
    Quote Originally Posted by chlopik View Post
    When I rethink it so yes, it is easy file renamer. But the custom sort function is good.
    Then things can even be done simpler then I showed in my code. The hard part would be the construction of the new (sorted) name (as can be seen in my code, but it can even be done more easy) and simply call renamefile (or copyfile and renamefile in case you wish to have a backup).

    The directory parsing does not even have to be part of the actual code as it could be done by using a shell script.

    It would then allow you to make a custom rename command which you could apply to an individual file.
    What is the H+ directive?
    Sorry, my bad. I should have written that as:
    Code:
    {$ifdef FPC}
    {$mode DELPHI}{$H+}
    {$endif}
    The H+ directive is AFAIK a Free Pascal specific directive only, see also here for more detail.

    It instructs the compiler to use strings of type ansistring (instead of whatever other default setting is used for strings by Free Pascal). To my knowledge ansistring is the kind of string what Delphi 7 used as (default) string type. For instance Unicode was not supported yet by Delphi7 RTL, and you had to install specific 3-th party libraries to work with them.

    E.g. compiler settings from my hand that are used in an attempt to accommodate FPC to your Delphi 7 compiler. Tbh I had expected more limitations from the FPC compiler in mode Delphi but apparently Free Pascal's Delphi support/limitations moved on as well over the years
    Iedereen wist dat het onmogelijk was. Behalve dan die ene dwaas die dat niet helemaal goed had begrepen en het toch deed.

  14. #29
    I think no more attention is needed to this topic. The file renamer was just a help in prepraing images. One job which took one week to finish. Now I continue on Delphi project, which will use the files. I am learning how to use jpeg images when I have finally compiled SimDesign libraries for NativeJPG. It's good that everything there in core files is commented very well and demos are included. The current program I am working on should be able to crop image and make some basic drawing onto the image. Something like drawing a skeleton or femurus and humerus axis, spine axis and face area and on the final the program should perform detection of nudity on a photo.

  15. #30
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Quote Originally Posted by flabber View Post
    Then things can even be done simpler then I showed in my code. The hard part would be
    Code:
    {$ifdef FPC}
    {$mode DELPHI}{$H+}
    {$endif}
    That code is unnecesary. $mode delphi includes $H+, while $mode objfpc does not. You probably just changed a objfpc to delphi, not realising that delphi includes $H+

    The H+ directive is AFAIK a Free Pascal specific directive only, see also here for more detail.
    No it isn't'. It is just very long ago (before D2-3) when it mattered. See https://docwiki.embarcadero.com/RADS...rings_(Delphi)

    The origins for this are that Delphi mostly only supports TP for migration purposes, while FPC also supports it for keeping code in TP form running. That was more important before 2005 than it is now, but because a large body of code (including the core of lazarus) was written in that period, the modes were frozen as is to keep that running.

Page 2 of 3 FirstFirst 1 2 3 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •