Announcement

**Erik Christensen** · 23 Feb 2001, 09:52 AM

' Character translation table, reverse translation table and collate string for array sort.
' ***********************************************************************************************
' Code adjusted April 6, 2003 to work also with PBWin7.0x.
'
' This is an improved version of the above program. Using this
' program you can edit, save and load your own user defined
' COLLATE STRING as a CHARACTER TRANSLATION TABLE.
' This last facility was inspired by comments in the PowerBasic
' Forum by Semen Matusovski

' The suggested collate string in the program can be taken as a
' starting point for more easy development of new strings. This
' string is based on the ANSI character set.

' Slight modification could be necessary for some European
' languages. If so, I would be happy to know the specific changes
' needed. All comments and suggestions are welcome.

' Erik Christensen, Copenhagen, Denmark. [email protected]
'

Code:

' *************************************************************
'       Code Generated by EZGUI Freeware Dialog Designer
'       by Christopher R. Boss
'       see web site at EZGUI.COM
'       Unused code has been removed to improve clarity.
' *************************************************************
#COMPILE EXE
#REGISTER NONE
#DIM ALL      '  This is helpful to prevent errors in coding
 ' Remark out the Constants for Controls you Will use in your program !
    %NOANIMATE    = 1
 '%NOBUTTON     = 1
    %NOCOMBO      = 1
    %NODRAGLIST   = 1
    %NOHEADER     = 1
    %NOIMAGELIST  = 1
 '%NOLIST       = 1
    %NOLISTVIEW   = 1
    %NOSTATUSBAR  = 1
    %NOTABCONTROL = 1
 '    %NOTOOLBAR    = 1
 '    %NOTOOLTIPS   = 1
    %NOTRACKBAR   = 1
    %NOTREEVIEW   = 1
    %NOUPDOWN     = 1
#INCLUDE "win32api.inc"   ' Must come first before other include files !
#INCLUDE "commctrl.inc"  ' The Common Controls include file !
#INCLUDE "COMDLG32.INC"

' *************************************************************
'              Application Constants and Declares
' *************************************************************
' ----------------------------------------------------------
%Form1_START                                    = 500
%Form1_SCRATCH                                  = 505
%Form1_NORMAL                                   = 507
%Form1_SUGG                                     = 510
%Form1_OPEN                                     = 515
%Form1_SAVE                                     = 520
%Form1_SEPARATOR_525                            = 525
%Form1_EXIT                                     = 530

%FORM1_LABEL5             = 101
%FORM1_LABEL6             = 102
%FORM1_LABEL4             = 100
%FORM1_LABEL3             = 105
%FORM1_LABEL2             = 110
%FORM1_LABEL1             = 115
%FORM1_LISTBOX1           = 120
%FORM1_LISTBOX2           = 125
%FORM1_MAKESTRING         = 130
%FORM1_END                = 135
%FORM1_LISTBOX3           = 140
%FORM1_LISTBOX4           = 142
%FORM1_TEXT1              = 145
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
DECLARE SUB Form1_SCRATCH_Select()
DECLARE SUB Form1_NORMAL_Select()
DECLARE SUB Form1_SUGG_Select()
DECLARE SUB Form1_OPEN_Select()
DECLARE SUB Form1_SAVE_Select()
DECLARE SUB Form1_EXIT_Select()
DECLARE CALLBACK FUNCTION CBF_FORM1_LISTBOX1()
DECLARE CALLBACK FUNCTION CBF_FORM1_LISTBOX2()
DECLARE CALLBACK FUNCTION CBF_FORM1_MAKESTRING()
DECLARE CALLBACK FUNCTION CBF_FORM1_END()
DECLARE CALLBACK FUNCTION CBF_FORM1_LISTBOX3()
DECLARE CALLBACK FUNCTION CBF_FORM1_LISTBOX4()
DECLARE CALLBACK FUNCTION CBF_FORM1_TEXT1()

DECLARE FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
DECLARE FUNCTION FileNam(BYVAL Src AS STRING) AS STRING

' *************************************************************
'            Application Global Variables and Types
' *************************************************************

GLOBAL hForm1&    ' Dialog handle
' Global Handles for menus
GLOBAL hForm1_Menu0&
GLOBAL hForm1_Menu1&
GLOBAL List_2_sel&
GLOBAL CollateS AS STRING ' collate string
GLOBAL PAFU AS STRING     ' path and file for input
GLOBAL PAFUout AS STRING  ' path and file for output

' *************************************************************
'                    Application Entrance
' *************************************************************
FUNCTION PBMAIN
    LOCAL Count&
    LOCAL CC1 AS INIT_COMMON_CONTROLSEX
    CC1.dwSize=SIZEOF(CC1)
    CC1.dwICC=%ICC_WIN95_CLASSES
    InitCommonControlsEX CC1
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
END FUNCTION
' *************************************************************
'                    Application Dialogs
' *************************************************************
SUB ShowDialog_Form1(BYVAL hParent&)
    DIM List_1(255) AS GLOBAL STRING
    DIM List_2(255) AS GLOBAL STRING
    DIM List_4(255) AS GLOBAL STRING
    DIM List_3(1000) AS GLOBAL STRING
    LOCAL Style&, ExStyle&, t$
    LOCAL N&,hFont&
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Make Collate String and Translation Table (+ Reverse T T) for Array Sort (Version 2)", 0, 0,  350,  242, Style&, ExStyle& TO hForm1&
    MENU NEW BAR TO hForm1_Menu0&
    MENU NEW POPUP TO hForm1_Menu1&
    MENU ADD POPUP, hForm1_Menu0& ,"&Start", hForm1_Menu1&, %MF_ENABLED
    MENU ADD STRING, hForm1_Menu1&, "Start From S&cratch",  %Form1_SCRATCH, %MF_ENABLED
    MENU ADD STRING, hForm1_Menu1&, "Start With &Normal Sequence",  %Form1_NORMAL, %MF_ENABLED
    MENU ADD STRING, hForm1_Menu1&, "&Start With S&uggested Collate String",  %Form1_SUGG, %MF_ENABLED
    MENU ADD STRING, hForm1_Menu1&, "&Load Collate String From File",  %Form1_OPEN, %MF_ENABLED
    MENU ADD STRING, hForm1_Menu1&, "Save Collate String &As",  %Form1_SAVE, %MF_GRAYED
    MENU ADD STRING, hForm1_Menu1&, "-",  %Form1_SEPARATOR_525, %MF_ENABLED
    MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %MF_ENABLED
    MENU ATTACH hForm1_Menu0&, hForm1&
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL4,  "Instruction:", 158, 4, 60, 10, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL3,  "Random Data Sorted:", 260, 4, 72, 10, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL2,  "New sequence:", 63, 4, 81, 10, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL1,  "Original:", 5, 4, 35, 10, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL5,  "Code:  Char.:", 3, 16, 40, 10, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL6,  "Code:  Char.:           Rank:", 64, 16, 80, 10, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
    CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOX1,List_1(), 3, 26, 57, 175, _
        %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_SORT OR %WS_VSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_FORM1_LISTBOX1
    hFont&=GetStockObject(%SYSTEM_FIXED_FONT)
    CONTROL SEND hForm1&,  %FORM1_LISTBOX1, %WM_SETFONT, hFont&, %TRUE
    CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOX2, List_2(), 64, 26, 54, 175, _
        %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_VSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_FORM1_LISTBOX2
    CONTROL SEND hForm1&,  %FORM1_LISTBOX2, %WM_SETFONT, hFont&, %TRUE
    CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOX4, List_4(), 118, 26, 24, 175, _
        %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE
    CONTROL SEND hForm1&,  %FORM1_LISTBOX4, %WM_SETFONT, hFont&, %TRUE
      ' fill listbox4 with rank values
    FOR N&=32 TO 255
        LISTBOX ADD hForm1&, %FORM1_LISTBOX4, RIGHT$("  "+STR$(N&),3)
    NEXT N&
    CONTROL ADD "Button", hForm1&,  %FORM1_MAKESTRING,  "&Make and Test New Sequence for Collate String", 8, 210, 284, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_DISABLED OR %WS_TABSTOP CALL CBF_FORM1_MAKESTRING
    CONTROL ADD "Button", hForm1&,  %FORM1_END,  "&End", 302, 210, 40, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_END
    CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOX3, List_3(), 245, 26, 102, 175, _
        %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_VSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE
    CONTROL SEND hForm1&,  %FORM1_LISTBOX3, %WM_SETFONT, hFont&, %TRUE
   t$="Click on an original item to append it to the new sequence list."+$CRLF+$CRLF+ _
      "To insert an original item in the new sequence list: Click on the new "+ _
      "sequence list item above which the original item should be inserted "+ _
      "and then on the original item."+$CRLF+$CRLF+"Double click to remove items in "+ _
      "the new sequence list."+$CRLF+$CRLF+"You cannot save the new sequence to file "+ _
      "before having made and tested the new sequence by pressing that button."+$CRLF+$CRLF+ _
      "You cannot do this before all characters have been moved to the new sequence list."
    CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXT1, t$, 146, 26, 95, 162, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_READONLY OR %ES_LEFT OR %ES_AUTOVSCROLL OR %WS_VSCROLL, _
        %WS_EX_CLIENTEDGE
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************
CALLBACK FUNCTION Form1_DLGPROC
    LOCAL hCtl&,r&
    ' these statements ensure that the ranks list (listbox 4)
    ' always is scrolled in parallel with the new sequences list
    ' (listbox 2)
    CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&
    r&=SendMessage (hCtl&,%LB_GETTOPINDEX,0,0)
    CONTROL HANDLE hForm1&, %FORM1_LISTBOX4 TO hCtl&
    SendMessage hCtl&,%LB_SETTOPINDEX,r&,0

    SELECT CASE CBMSG
        CASE %WM_NOTIFY
        CASE %WM_COMMAND
            ' Process Messages to Controls that have no Callback Function
            ' and Process Messages to Menu Items
            SELECT CASE CBCTL
                CASE  %Form1_SCRATCH                                      ' Popup Menu Item Selected
                    Form1_SCRATCH_Select
                CASE  %Form1_NORMAL                                       ' Popup Menu Item Selected
                    Form1_NORMAL_Select
                CASE  %Form1_SUGG                                         ' Popup Menu Item Selected
                    Form1_SUGG_Select
                CASE  %Form1_OPEN                                         ' Popup Menu Item Selected
                    Form1_OPEN_Select
                CASE  %Form1_SAVE                                         ' Popup Menu Item Selected
                    Form1_SAVE_Select
                CASE  %Form1_SEPARATOR_525                                ' Popup Menu Item Selected
                CASE  %Form1_EXIT                                         ' Popup Menu Item Selected
                    Form1_EXIT_Select
                CASE ELSE
            END SELECT
        CASE ELSE
    END SELECT
END FUNCTION

' *************************************************************
'  Application Callback Functions (or Procedures) for Controls
' *************************************************************
SUB Form1_SCRATCH_Select()
    LOCAL N&,hCtl&
    CONTROL HANDLE hForm1&, %FORM1_LISTBOX1 TO hCtl&
    ' empty listbox1
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&
    ' empty listbox2
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    ' fill listbox 1 with normal sequence character data
    FOR N&=32 TO 255
        List_1(N&-32)=RIGHT$(" "+STR$(N&),3)+"  "+CHR$(N&)
        LISTBOX ADD hForm1&, %FORM1_LISTBOX1, List_1(N&-32)
    NEXT N&
    ' keep makestring button disabled until new sequence string
    ' is finished
    CONTROL DISABLE hForm1&, %FORM1_MAKESTRING
END SUB
' ------------------------------------------------
SUB Form1_NORMAL_Select()
    LOCAL N&,hCtl&
    CONTROL HANDLE hForm1&, %FORM1_LISTBOX1 TO hCtl&
    ' empty listbox1
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&
    ' empty listbox2
    SendMessage hCtl&,%LB_RESETCONTENT,0,0
    ' fill array List_2 with normal sequence data
    FOR N&=32 TO 255
        List_2(N&-32)=RIGHT$(" "+STR$(N&),3)+"  "+CHR$(N&)
    NEXT N&
    ' fill listbox2 with the string items
    FOR N&=32 TO 255
        LISTBOX ADD hForm1&, %FORM1_LISTBOX2, List_2(N&-32)
    NEXT N&
    ' enable the makestring button
    CONTROL ENABLE hForm1&, %FORM1_MAKESTRING
END SUB
' ------------------------------------------------
SUB Form1_SUGG_Select()
    LOCAL N&, SR$,SP$,L&,hCtl&,Position&
    ' get suggestet collate string
    CALL SuggestedCollateString(CollateS)

    CONTROL HANDLE hForm1&, %FORM1_LISTBOX1 TO hCtl&
    ' empty listbox1
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&
    ' empty listbox2
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    IF LEN(CollateS)=224 THEN
        ' fill array List_2 with the collate string data
        FOR N&=33 TO 256
            L&=ASC(CollateS,N&-32)
            List_2(L&-32)=RIGHT$(" "+STR$(N&-1),3)+"  "+CHR$(N&-1)
        NEXT N&
        ' fill listbox2 with the string items
        FOR N&=33 TO 256
            LISTBOX ADD hForm1&, %FORM1_LISTBOX2, List_2(N&-33)
        NEXT N&
        ' enable the makestring button
        CONTROL ENABLE hForm1&, %FORM1_MAKESTRING
    ELSE
        MSGBOX "Suggested Collate String Corrupted !",,"Problem:
    END IF
END SUB
' ------------------------------------------------

' ------------------------------------------------
SUB Form1_OPEN_Select()
    LOCAL N&, SR$,SP$,L&,hCtl&,Position&
    ' read collate string from file
    CALL FilNameOpen()
    CONTROL HANDLE hForm1&, %FORM1_LISTBOX1 TO hCtl&
    ' empty listbox1
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&
    ' empty listbox2
    SendMessage hCtl&,%LB_RESETCONTENT,0,0

    IF LEN(CollateS)=224 THEN

        ' fill array List_2 with the collate string data
        FOR N&=33 TO 256
            L&=ASC(CollateS,N&-32)
            List_2(L&-32)=RIGHT$(" "+STR$(N&-1),3)+"  "+CHR$(N&-1)
        NEXT N&
        ' fill listbox2 with the string items
        FOR N&=33 TO 256
            LISTBOX ADD hForm1&, %FORM1_LISTBOX2, List_2(N&-33)
        NEXT N&
        ' enable the makestring button
        CONTROL ENABLE hForm1&, %FORM1_MAKESTRING
    END IF
END SUB
' ------------------------------------------------

' ------------------------------------------------
SUB Form1_SAVE_Select()
    CALL FilNameSave()
END SUB
' ------------------------------------------------

' ------------------------------------------------
SUB Form1_EXIT_Select()
    LOCAL r&
    r&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Collate End?")
    IF r&=%IDYES THEN DIALOG END hForm1&
END SUB
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_LISTBOX1
    LOCAL CVal&,hCtl&,re&
    LOCAL buffer AS ASCIIZ * 256

    ' Return Current Selection in CVal&
    CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
    IF CBCTLMSG=%LBN_SELCHANGE THEN

       ' get handle of listbox1
       CONTROL HANDLE hForm1&, %FORM1_LISTBOX1 TO hCtl&

       ' put selected item in buffer
       SendMessage hCtl&,%LB_GETTEXT,CVal&,VARPTR(Buffer)

       ' delete selected item from listbox1
       SendMessage hCtl&,%LB_DELETESTRING,CVal&,0

       ' get total number of items in listbox1
       re&=SendMessage (hCtl&,%LB_GETCOUNT,0,0)

       ' when finished, then enable making of string
       IF re&=0 THEN
          CONTROL ENABLE hForm1&, %FORM1_MAKESTRING
       ELSE
       ' if not finished, disable makestring button and saving
          CONTROL DISABLE hForm1&, %FORM1_MAKESTRING
          EnableMenuItem hForm1_Menu1&, %Form1_SAVE, %MF_BYCOMMAND OR %MF_GRAYED
       END IF

       ' get handle of listbox2
       CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&
       IF List_2_sel&<0 THEN ' no selection in listbox2

          ' ad item from buffer to listbox2
          SendMessage hCtl&,%LB_ADDSTRING,0,VARPTR(Buffer)

          ' get total number of items in listbox2
          re&=SendMessage (hCtl&,%LB_GETCOUNT,0,0)

          ' ensure visibility of item - scroll if necessary
          SendMessage hCtl&,%LB_SETCURSEL,re&-1,0

          ' deselect item
          SendMessage hCtl&,%LB_SETCURSEL,-1,0

       ELSE  ' selection made in listbox2

          ' insert item from buffer at the selected place
          ' the previous item at that place will move one place down
          SendMessage hCtl&,%LB_INSERTSTRING,List_2_sel&,VARPTR(Buffer)

          ' ensure visibility of inserted item - scroll if necessary
          SendMessage hCtl&,%LB_SETCURSEL,List_2_sel&,0

          ' deselect item
          List_2_sel&=-1
          SendMessage hCtl&,%LB_SETCURSEL,-1,0
       END IF

    END IF
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_LISTBOX2
    LOCAL hCtl&,r&,bb$,re&
    LOCAL buffer AS ASCIIZ * 256

    ' get handle of listbox2
    CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&

    ' get total number of items in listbox1
    re&=SendMessage (hCtl&,%LB_GETCOUNT,0,0)

    ' when finished, then enable making of string
    IF re&=224 THEN
       CONTROL ENABLE hForm1&, %FORM1_MAKESTRING
    ELSE
    ' if not finished, disable makestring button and saving
       CONTROL DISABLE hForm1&, %FORM1_MAKESTRING
       EnableMenuItem hForm1_Menu1&, %Form1_SAVE, %MF_BYCOMMAND OR %MF_GRAYED
    END IF

    ' Return Current Selection in List_2_sel&
    CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO List_2_sel&

    IF CBCTLMSG=%LBN_DBLCLK THEN
       ' get handle of listbox2
       CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&

       ' put selected item in buffer
       SendMessage hCtl&,%LB_GETTEXT,List_2_sel&,VARPTR(Buffer)

       ' delete selected item from listbox2
       SendMessage hCtl&,%LB_DELETESTRING,List_2_sel&,0

       ' get handle of listbox1
       CONTROL HANDLE hForm1&, %FORM1_LISTBOX1 TO hCtl&

       ' ad item from buffer to listbox1, which will sort the items
       SendMessage hCtl&,%LB_ADDSTRING,0,VARPTR(Buffer)

       ' find index of added item after sorting
       bb$ = Buffer
       r& = SendMessage(hCtl&,%LB_FINDSTRINGEXACT,0,STRPTR(bb$))

       ' ensure visibility of item - scroll if necessary
       SendMessage hCtl&,%LB_SETCURSEL,r&,0

       ' deselect item
       SendMessage hCtl&,%LB_SETCURSEL,-1,0
       EnableMenuItem hForm1_Menu1&, %Form1_SAVE, %MF_BYCOMMAND OR %MF_GRAYED
       CONTROL DISABLE hForm1&, %FORM1_MAKESTRING
    END IF
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_MAKESTRING
    LOCAL hCtl&
    LOCAL Buffer AS ASCIIZ * 256
    LOCAL I AS LONG
    LOCAL J AS LONG
    LOCAL Y AS INTEGER

    IF CBCTLMSG=%BN_CLICKED THEN
       CollateS=STRING$(256,CHR$(255)) ' TEMPLATE OF COLLATE STRING
       ' make first 32 characters of string
       ' these characters are never moved in this program
       FOR I=0 TO 31
           ASC(CollateS,I+1) = I
       NEXT

       ' get handle of listbox2
       CONTROL HANDLE hForm1&, %FORM1_LISTBOX2 TO hCtl&

       ' use data from listbox2 to make remaining part of collate string
       FOR I=32 TO 255
           SendMessage hCtl&,%LB_GETTEXT,I-32,VARPTR(Buffer)
           J=VAL(LTRIM$(RTRIM$(LEFT$(Buffer,3))))
           ASC(CollateS,J+1) = I
       NEXT

       CONTROL HANDLE hForm1&, %FORM1_LISTBOX3 TO hCtl&
       ' empty listbox3
       SendMessage hCtl&,%LB_RESETCONTENT,0,0

       ' test collate string on random string data
       FOR I=0 TO 1000
            List_3(I)=""
            FOR J=1 TO 26
                Y = RND(65, 255)
                SELECT CASE Y

                    'All characters filter
                    CASE 65 TO 90,97 TO 122,192 TO 214, 216 TO 221, 224 TO 246, 248 TO 253,255

                    'English character set filter
                    'CASE 65 TO 90,97 TO 122

                    'Scandinavian character set filter
                    'CASE 65 TO 90,97 TO 122, 196 TO 198,214,216,228 TO 230,246,248

                        List_3(I)=list_3(I)+CHR$(Y)

                END SELECT
            NEXT
       NEXT
       ' sort array according to the collate string
       ARRAY SORT List_3(), COLLATE CollateS, ASCEND

       ' display sorted array in the listbox
       FOR I=0 TO 1000
           LISTBOX ADD hForm1&,%FORM1_LISTBOX3,List_3(I)
       NEXT
       ' enable saving
       EnableMenuItem hForm1_Menu1&, %Form1_SAVE, %MF_BYCOMMAND OR %MF_ENABLED

    END IF

END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_END
    LOCAL r&
    IF CBCTLMSG=%BN_CLICKED THEN
        r&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Collate End?")
        IF r&=%IDYES THEN DIALOG END hForm1&
    END IF
END FUNCTION
' ------------------------------------------------
SUB FilNameSave()
   LOCAL Path   AS STRING
   LOCAL f      AS STRING
   LOCAL Style  AS DWORD
   LOCAL hFile  AS LONG
   LOCAL r&,i%,j%,b$,k%
   LOCAL CS AS STRING
   DIM Tr1(255) AS INTEGER, Tr2(255) AS INTEGER
igen:
   PAFUout=""
   Path=FilePath(PAFU)
   f=""
   Style = %OFN_HIDEREADONLY OR %OFN_LONGNAMES
   IF SaveFileDialog(0, "Save File", f, Path, _
       "Text Files|*.txt|All Files|*.*", "txt", Style) THEN

       PAFUout=f
       IF PAFU=PAFUout THEN
           r& = MSGBOX ("Output file name the same as input file name. Do you want this ?",%MB_ICONHAND OR %MB_YESNO, "Problem:")
           IF r&=%IDNO THEN GOTO igen
       END IF
       hFile = FREEFILE

       OPEN PAFUout FOR OUTPUT AS hFile
       ' Transformation of collate string to translation table format.
       ' inspired by Semen Matusovski
       CS=CollateS
       IF LEN(CS)=256 THEN CS=MID$(CS,33)

       b$="TrtTable:"+$CRLF
       FOR i%=0 TO 15
         b$=b$+"    ! DB "
            FOR j%=i%*16 TO i%*16+15
                IF i%<=1 THEN k%=j%
                IF i%>=2 THEN k%=ASC(CS,j%-31)
                Tr1(j%)=k%
                b$=b$+RIGHT$("000"+LTRIM$(STR$(k%)),3)+","
            NEXT
            b$=LEFT$(b$,LEN(b$)-1)+$CRLF
       NEXT

       ' Make reverse translation table
       ' Code inspired by Semen Matusovsky
       FOR i%=0 TO 255
            Tr2(Tr1(i%))=i%
       NEXT

       b$=b$+$CRLF+"ReverseTrtTable:"+$CRLF

       FOR i%=0 TO 15
         b$=b$+"    ! DB "
            FOR j%=i%*16 TO i%*16+15
                b$=b$+RIGHT$("000"+LTRIM$(STR$(Tr2(j%))),3)+","
            NEXT
            b$=LEFT$(b$,LEN(b$)-1)+$CRLF
       NEXT

       PRINT# hFile, b$

       CLOSE hFile

   END IF

END SUB

SUB FilNameOpen()
   LOCAL Path   AS STRING
   LOCAL f      AS STRING
   LOCAL Style  AS DWORD
   LOCAL A$
   LOCAL hFile  AS LONG
   LOCAL b$,i%,j%,k%,c$
   Path     = CURDIR$
   f        = "*.TXT"
   Style    = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
   IF OpenFileDialog(0, "Open File", f, Path, _
     "Text Files|*.txt|All Files|*.*", "txt", Style) THEN
      PAFU=f
      hFile = FREEFILE
      OPEN PAFU FOR INPUT AS hFile
      LINE INPUT# hFile, b$

      IF b$<> "TrtTable:" THEN
          MSGBOX "This file is not a Translation Table (collate string) file! "+$CRLF+" Try again.",%MB_ICONHAND,"Problem:"
          CollateS=""
      ELSE
          'Skip the first two lines. They are being added later.
          'These two lines contain the first 32 (0-31) codes
          'which are never changed.
          LINE INPUT# hFile, b$
          LINE INPUT# hFile, b$
          CollateS=""
          FOR i%=2 TO 15
              LINE INPUT# hFile, b$
              b$=MID$(b$,10) ' remove: "    ! DB "
              FOR j%=1 TO 16
                  CollateS=CollateS+CHR$(VAL(PARSE$(b$,j%)))
              NEXT
          NEXT
      END IF
      ' The Reverse Translation Table is not being read.
      CLOSE hFile
   END IF
END SUB

FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
  LOCAL x AS LONG
  FOR x = LEN(Src) TO 1 STEP -1
    IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
  NEXT x
  FUNCTION = MID$(Src, x + 1)
END FUNCTION

FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
  LOCAL x AS LONG
  FOR x = LEN(Src) TO 1 STEP -1
    IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
  NEXT x
  FUNCTION = LEFT$(Src, x)
END FUNCTION

SUB SuggestedCollateString(BYREF CS AS STRING)
    LOCAL I%
    ' The data forming this collate string is made form the
    ' translation table below which has been made using this
    ' program. The table was saved and then pasted into this
    ' subroutine each line being transformed to a DATA statement.

    CS=""
    FOR I%=1 TO 256
        CS=CS+CHR$(VAL(READ$(I%)))
    NEXT

    DATA 000,001,002,003,004,005,006,007,008,009,010,011,012,013,014,015
    DATA 016,017,018,019,020,021,022,023,024,025,026,027,028,029,030,031
    DATA 160,161,034,162,163,164,165,166,167,168,042,043,044,045,046,047
    DATA 048,049,050,051,052,053,054,055,056,057,169,170,171,172,173,174
    DATA 175,032,059,061,068,069,079,081,083,085,096,098,099,101,103,107
    DATA 117,119,121,123,125,127,135,137,139,141,148,176,177,178,179,180
    DATA 181,033,060,062,067,070,080,082,084,086,095,097,100,102,104,108
    DATA 118,120,122,124,126,128,136,138,140,142,149,182,183,184,185,186
    DATA 187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202
    DATA 203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218
    DATA 219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234
    DATA 235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250
    DATA 035,037,039,041,152,158,150,063,071,073,075,077,087,089,091,093
    DATA 065,105,109,111,113,115,156,251,154,129,133,131,146,143,252,253
    DATA 036,038,040,058,153,159,151,064,072,074,076,078,088,090,092,094
    DATA 066,106,110,112,114,116,157,254,155,130,134,132,147,144,255,145
    ' Only characters 32-255 - positioned in places 33-256 in the
    ' string - are used initially. The remaining characters 0-31 are
    ' added later. They are never changed by this program.
    CS=MID$(CS,33)

END SUB

[This message has been edited by Erik Christensen (edited April 06, 2003).]

Announcement

Forum Guidelines

ARRAY SORT 2. Edit, save, and load your own unique "weights" COLLATE STRING

ARRAY SORT 2. Edit, save, and load your own unique "weights" COLLATE STRING

Comment