Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Array Sort and Collate cString

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • Jurgen Huhn
    replied
    ARRAY SORT statement

    PowerBASIC
    http://www.powerbasic.com/support/help/pbcc/array_sort_statement.htm

    Leave a comment:

  • Pierre Bellisle
    replied
     If you do not have PBWin8/PBCC4 or need a separate way to convert string,
    here is another way that show how to sort while ignoring letters with accent...

    It is based on the blazing fast MacrCase code by Börje

    Code:
    #COMPILE EXE '#Win 8.03#
#DIM ALL
#INCLUDE "WIN32API.INC" '# 2005-01-14 # 
 
'______________________________________________________________________________
 
FUNCTION AccentCase(BufferIn AS STRING)AS STRING 
 'Based on blazing fast MacrCase by Börje Hagsten, April 2003
 'Return a lowercase string with accent removed, 
 'ideal for parallel array sorting routine, 
 'Ex: Börge is translated to borge
 LOCAL  BufferOut      AS STRING
 STATIC NoAccentTable  AS STRING 
 LOCAL  sBuff          AS STRING * 2
 STATIC pNoAccentTable AS BYTE POINTER 
 LOCAL  pBuff          AS BYTE POINTER 
 LOCAl  pByte          AS BYTE POINTER
 LOCAL  pBufferOut     AS DWORD
 LOCAL  LenBuffer      AS DWORD
 
 IF pNoAccentTable = 0 THEN
   '                  '  0 to 64  AZ <- az   91 to 191
   'NoAccentTable = CHR$(0 TO 64, 97 TO 122, 91 TO 191, _
   '                _ ' Àa  Áa  Âa  Ãa  Äa  Åa   Æ   Çc  Èe   Ée   Êe   Ëe   Ìi   Íi   Îi   Ïi
   '                    97, 97, 97, 97, 97, 97, 198, 99, 101, 101, 101, 101, 105, 105, 105, 105, _
   '                _ '  Ð   Ñn   Òo   Óo   Ôo   Õo   Öo    ×    Ø   Ùu   Úu   Ûu   Üu   Ýy    Þ    ß
   '                    208, 110, 111, 111, 111, 111, 111, 215, 216, 117, 117, 117, 117, 121, 222, 223, _
   '                _ ' àa  áa  âa  ãa  äa  åa   æ   çc  èe   ée   êe   ëe   ìi   íi   îi   ïi    ð   ñn
   '                    97, 97, 97, 97, 97, 97, 230, 99, 101, 101, 101, 101, 105, 105, 105, 105, 240, 110, _
   '                _ ' òo   óo   ôo   õo   öo    ÷    ø   ùu   úu   ûu   üu   ýy    þ    ÿy
   '                    111, 111, 111, 111, 111, 247, 248, 117, 117, 117, 117, 121, 254, 121) 
   '
   NoAccentTable  = CHR$(0 TO 255)
   pNoAccentTable = STRPTR(NoAccentTable) 
   pBuff          = VARPTR(sBuff)  
   FOR pByte = pNoAccentTable + 127 TO pNoAccentTable + LEN(NoAccentTable) - 1 'Start at char 127 becose no accent before 
     'If FoldString return = 2 then an accentued char is found so, split it in 2 
     'First char in Buff is a character like "e", second char is an accent like "`"
     IF FoldString(%MAP_COMPOSITE, BYVAL pByte, 1, BYVAL pBuff, 2) = 2 THEN
       @pByte = @pBuff 'Copy only first character in sDest and leave the "accent character" 
     END IF  
   NEXT  
   CharLower BYVAL(STRPTR(NoAccentTable) + 1) '+ 1 to skip first CHR$(0)
   'MSGBOX MID$(NoAccentTable, 2)
 END IF
 
 LenBuffer = LEN(BufferIn)  
 IF LenBuffer THEN
   #REGISTER NONE
   BufferOut = BufferIn
   pBufferOut = STRPTR(BufferOut)
 
   ! mov esi, pBufferOut       ;'Pointer to string data
   ! mov ecx, LenBuffer        ;'Move length of string into ecx  
   ! mov ebx, pNoAccentTable   ;'Move pointer to translation table into ebx
     Accent_Loop:               'Loop label
   ! mov al, [esi]             ;'Move current character into al
   ! xlatb                     ;'Translate character
   ! mov [esi], al             ;'Move translated character back into string
   ! inc esi                   ;'Next character
   ! dec ecx                   ;'Decr counter
   ! jnz Accent_Loop           ;'Exit when ecx = 0
 
   FUNCTION = BufferOut
 END IF
 
END FUNCTION
 
'______________________________________________________________________________
 
FUNCTION PBMAIN() AS LONG
 LOCAL I              AS LONG
 LOCAL Buffer         AS STRING
 LOCAL Lower          AS LONG
 LOCAL Higher         AS LONG    
 
 Lower  = 0
 Higher = 6
 DIM SomeArray(Lower TO Higher) AS STRING 
 DIM RefArray (Lower TO Higher) AS STRING 
 
 SomeArray(0)  = "Börge" 
 SomeArray(1)  = "BOB" 
 SomeArray(2)  = "Bôris" 
 SomeArray(3)  = "Burt" 
 SomeArray(4)  = "Baptist" 
 SomeArray(5)  = "Bobby"  
 SomeArray(6)  = "Ben" 
 
 Buffer = "Unsorted data..." + $CRLF + $CRLF
 FOR I = Lower TO Higher
   Buffer = Buffer & SomeArray(I) & $CRLF
 NEXT   
 
 Buffer = Buffer & $CRLF & $CRLF & "Sorted, with collate UCase" & $CRLF & $CRLF
 ARRAY SORT SomeArray(), COLLATE UCASE
 FOR I = Lower TO Higher
   Buffer = Buffer & SomeArray(I) & $CRLF
 NEXT
 
 Buffer = Buffer & $CRLF & $CRLF & "Sorted, with parallel array," & $CRLF & _
                                   "ignoring accent"              & $CRLF & _
                                   "and case insensitive"         & $CRLF & $CRLF
 FOR I = Lower TO Higher
   RefArray(I) = AccentCase(SomeArray(I))
 NEXT
 ARRAY SORT RefArray(), TAGARRAY SomeArray()
 FOR I = Lower TO Higher
   Buffer = Buffer & SomeArray(I) & $CRLF
 NEXT
 MSGBOX Buffer,, "ArraySort, no accent, no case"
 
END FUNCTION
'______________________________________________________________________________

    [This message has been edited by Pierre Bellisle (edited December 18, 2006).]

    Leave a comment:

  • Pierre Bellisle
    started a topic Array Sort and Collate cString

    Array Sort and Collate cString

     I suspect a Bob and Börge complicity for the addition
    of <ARRAY SORT ... , COLLATE cString> in PBWin8 and PBCC4,
    it is very nice an allow us to do sorting in a powerfull way.
    Here is a small demo to show how to sort while ignoring letters with accent...

    Have fun

    Pierre

    Code:
    #COMPILE EXE '# Win 8.03 #
#DIM ALL
#INCLUDE "WIN32API.INC" '# 2005-01-14 # 
 
'______________________________________________________________________________
 
FUNCTION PBMAIN() AS LONG
 LOCAL I              AS LONG
 LOCAL Lower          AS LONG
 LOCAL Higher         AS LONG    
 LOCAL Buffer         AS STRING
 LOCAL NoAccentTable  AS STRING
 LOCAL sBuff          AS STRING * 2
 LOCAL pNoAccentTable AS BYTE POINTER 
 LOCAL pBuff          AS BYTE POINTER 
 LOCAl pByte          AS BYTE POINTER
 
 '                    ' 0 to 64  AZ <- az   91 to 191
 'NoAccentTable  = CHR$(0 TO 64, 97 TO 122, 91 TO 191, _
 '                  _ ' Àa  Áa  Âa  Ãa  Äa  Åa   Æ   Çc  Èe   Ée   Êe   Ëe   Ìi   Íi   Îi   Ïi
 '                      97, 97, 97, 97, 97, 97, 198, 99, 101, 101, 101, 101, 105, 105, 105, 105, _
 '                  _ '  Ð   Ñn   Òo   Óo   Ôo   Õo   Öo    ×    Ø   Ùu   Úu   Ûu   Üu   Ýy    Þ    ß
 '                      208, 110, 111, 111, 111, 111, 111, 215, 216, 117, 117, 117, 117, 121, 222, 223, _
 '                  _ ' àa  áa  âa  ãa  äa  åa   æ   çc  èe   ée   êe   ëe   ìi   íi   îi   ïi    ð   ñn
 '                      97, 97, 97, 97, 97, 97, 230, 99, 101, 101, 101, 101, 105, 105, 105, 105, 240, 110, _
 '                  _ ' òo   óo   ôo   õo   öo    ÷    ø   ùu   úu   ûu   üu   ýy    þ    ÿy
 '                      111, 111, 111, 111, 111, 247, 248, 117, 117, 117, 117, 121, 254, 121) 
 NoAccentTable  = CHR$(0 TO 255)
 pNoAccentTable = STRPTR(NoAccentTable) 
 pBuff          = VARPTR(sBuff)  
 FOR pByte = pNoAccentTable + 127 TO pNoAccentTable + LEN(NoAccentTable) - 1 'Start at char 127 becose no accent before 
   'If FoldString return = 2 then an accentued char is found so, split it in 2 
   'First char in Buff is a character like "e", second char is an accent like "`"
   IF FoldString(%MAP_COMPOSITE, BYVAL pByte, 1, BYVAL pBuff, 2) = 2 THEN
     @pByte = @pBuff 'Copy only first character in sDest and leave the "accent character" 
   END IF  
 NEXT  
 CharLower BYVAL(STRPTR(NoAccentTable) + 1) '+ 1 to skip first CHR$(0)
 'MSGBOX MID$(NoAccentTable, 2)
 
 Lower  = 0
 Higher = 6
 DIM SomeArray(Lower TO Higher) AS STRING 
 
 SomeArray(0)  = "Börge" 
 SomeArray(1)  = "BOB" 
 SomeArray(2)  = "Bôris" 
 SomeArray(3)  = "Burt" 
 SomeArray(4)  = "Baptist" 
 SomeArray(5)  = "Bobby"  
 SomeArray(6)  = "Ben" 
 
 Buffer = "Unsorted data..." + $CRLF + $CRLF
 FOR I = Lower TO Higher
   Buffer = Buffer & SomeArray(I) & $CRLF
 NEXT   
 
 Buffer = Buffer & $CRLF & $CRLF & "Sorted, with collate UCase" & $CRLF & $CRLF
 ARRAY SORT SomeArray(), COLLATE UCASE
 FOR I = Lower TO Higher
   Buffer = Buffer & SomeArray(I) & $CRLF
 NEXT
 
 Buffer = Buffer & $CRLF & $CRLF & "Sorted, with collate String," & $CRLF & _
                                   "ignoring accent"              & $CRLF & _
                                   "and case insensitive"         & $CRLF & $CRLF
 ARRAY SORT SomeArray(), COLLATE NoAccentTable
 FOR I = Lower TO Higher
   Buffer = Buffer & SomeArray(I) & $CRLF
 NEXT
 MSGBOX Buffer,, "ArraySort, no accent, no case"
 
END FUNCTION
'______________________________________________________________________________



    [This message has been edited by Pierre Bellisle (edited December 18, 2006).]
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree