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 2. Edit, save, and load your own unique "weights" COLLATE STRING

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

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

    ' The correction made August 11, 2001 is to make the program
    ' compatible with the new version of the COMDLG32.INC winapi file.

    ' This program is a sequel to the program I posted to the
    ' PowerBasic source code forum on January 29, 2001 on ARRAY
    ' SORT using a COLLATE STRING. That program devised a collate
    ' string where a number of similar characters (including upper
    ' and lower case) obtained the same sorting "weight".

    ' In some instances it is desirable that each character has its
    ' own unique sorting "weight" in order to obtain complete sorting
    ' where each item in the list always will obtain a unique relative
    ' positions after being sorted.

    ' The following program makes such collate strings.

    ' The program enables you to easily edit, save, and load your
    ' own collate string to be used by ARRAY SORT.

    ' 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. e.chr@email.dk
    Code:
    ' *************************************************************
    '       Code Generated by EZGUI Freeware Dialog Designer
    ' *************************************************************
    
    #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"
    ' *************************************************************
    
    ' *************************************************************
    '              EZGUI Library Constants and Declares
    ' *************************************************************
    
    DECLARE SUB EZLIB_InitFonts()
    DECLARE SUB EZLIB_DeleteFonts()
    DECLARE SUB EZLIB_FixSize(BYVAL hDlg&, BYVAL Style&, BYVAL HasMenu&)
    DECLARE FUNCTION EZLIB_IsTooltip(BYVAL lParam AS LONG) AS LONG
    DECLARE FUNCTION EZLIB_TooltipID(BYVAL lParam AS LONG) AS LONG
    DECLARE SUB EZLIB_SetTooltipText(BYVAL lParam AS LONG, TipText$)
    DECLARE FUNCTION EZLIB_IsTab(BYVAL lParam AS LONG) AS LONG
    DECLARE FUNCTION EZLIB_TabID(BYVAL lParam AS LONG) AS LONG
    DECLARE FUNCTION EZLIB_TabNum(BYVAL lParam AS LONG) AS LONG
    DECLARE SUB EZLIB_AddTabs(BYVAL hDlg AS LONG, BYVAL IDNum&, BYVAL TabText$)
    DECLARE SUB EZLIB_DefColors()
    DECLARE SUB EZLIB_DeleteBrushes()
    DECLARE FUNCTION EZLIB_QBColor(N&) AS LONG
    DECLARE SUB EZLIB_ShowControl(BYVAL hWnd&, BYVAL ID&, BYVAL SFlag&)
    
    ' *************************************************************
    '              Application Constants and Declares
    ' *************************************************************
    
    
    ' ----------------------------------------------------------
    %Form1_START                                    = 500
    ' ----------------------------------------------------------
    %Form1_SCRATCH                                  = 505
    %Form1_SUGG                                     = 510
    %Form1_OPEN                                     = 515
    %Form1_SAVE                                     = 520
    %Form1_SEPARATOR_525                            = 525
    %Form1_EXIT                                     = 530
    %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_TEXT1              = 145
    ' --------------------------------------------------
    DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION Form1_DLGPROC
    ' --------------------------------------------------
    ' ------------------------------------------------
    
    DECLARE SUB Form1_SCRATCH_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_TEXT1()
    
    
    ' (1) Put NEXT DIALOG Constant and Declare code after here :
    DECLARE FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
    DECLARE FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
    
    ' *************************************************************
    '            Application Global Variables and Types
    ' *************************************************************
    
    GLOBAL App_Brush&()
    GLOBAL App_Color&()
    GLOBAL App_Font&()
    
    
    GLOBAL hForm1&    ' Dialog handle
    ' Global Handles for menus
    GLOBAL hForm1_Menu0&
    GLOBAL hForm1_Menu1&
    
    
    ' (2) Put NEXT DIALOG Globals code after here :
    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
        EZLIB_DefColors
        EZLIB_InitFonts
    
        ShowDialog_Form1 0
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
    
    
        EZLIB_DeleteBrushes
        EZLIB_DeleteFonts
    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_3(1000) AS GLOBAL STRING
    
        LOCAL Style&, ExStyle&, t$
        LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
        '   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 for Array Sorting", 0, 0,  284,  160, Style&, ExStyle& TO hForm1&
        EZLIB_FixSize hForm1&, Style&, 1
        ' ---------------------------
        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, hMenu, text$, id, state
    
    
        MENU ADD STRING, hForm1_Menu1&, "Start From S&cratch",  %Form1_SCRATCH, %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&
        ' Layer # 0
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL4,  "Instruction:", 128, 4, 60, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL3,  "Random Data Sorted:", 204, 4, 72, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL2,  "New sequence:", 62, 4, 60, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL1,  "Original:", 10, 4, 44, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        ' - - - - - - - - - - - - - - - - - - - - - - - - -
        CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOX1,List_1(), 2, 14, 58, 114, _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_SORT OR %LBS_NOINTEGRALHEIGHT OR %WS_VSCROLL OR %WS_TABSTOP, _
            %WS_EX_CLIENTEDGE CALL CBF_FORM1_LISTBOX1
        CONTROL SEND hForm1&,  %FORM1_LISTBOX1, %WM_SETFONT, App_Font&(1), %TRUE
        ' - - - - - - - - - - - - - - - - - - - - - - - - -
        CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOX2, List_2(), 64, 14, 58, 114, _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_NOINTEGRALHEIGHT OR %WS_VSCROLL OR %WS_TABSTOP, _
            %WS_EX_CLIENTEDGE CALL CBF_FORM1_LISTBOX2
        CONTROL SEND hForm1&,  %FORM1_LISTBOX2, %WM_SETFONT, App_Font&(1), %TRUE
        CONTROL ADD "Button", hForm1&,  %FORM1_MAKESTRING,  "&Make and Test Collate String", 6, 140, 224, 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", 238, 140, 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(), 200, 14, 82, 114, _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_NOINTEGRALHEIGHT OR %WS_VSCROLL OR %WS_TABSTOP, _
            %WS_EX_CLIENTEDGE CALL CBF_FORM1_LISTBOX3
        CONTROL SEND hForm1&,  %FORM1_LISTBOX3, %WM_SETFONT, App_Font&(1), %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."
          
        CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXT1, t$, 124, 14, 74, 114, _
            %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_READONLY OR %ES_LEFT OR %ES_AUTOVSCROLL OR %WS_VSCROLL, _
            %WS_EX_CLIENTEDGE CALL CBF_FORM1_TEXT1
        DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
    END SUB
    
    ' *************************************************************
    '                             Dialog Callback Procedure
    '                             for Form Form1
    '                             uses Global Handle - hForm1&
    ' *************************************************************
    
    CALLBACK FUNCTION Form1_DLGPROC
        SELECT CASE CBMSG
            ' Common Windows Messages you may want to process
            ' -----------------------------------------------
            CASE %WM_TIMER
            CASE %WM_HSCROLL
            CASE %WM_VSCROLL
            CASE %WM_SIZE
            CASE %WM_CLOSE
            CASE %WM_DESTROY
            CASE %WM_SYSCOMMAND
            CASE %WM_PAINT
            ' -----------------------------------------------
            CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
                 %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
                ' Control colors
                SELECT CASE GetDlgCtrlID(CBLPARAM)
                    CASE ELSE
                        FUNCTION=0
                END SELECT
            CASE %WM_NOTIFY
                IF EZLIB_IsTooltip(CBLPARAM) THEN
                    SELECT CASE EZLIB_TooltipID(CBLPARAM)
                        CASE  %FORM1_MAKESTRING
                            EZLIB_SetTooltipText CBLPARAM, "Control -  %FORM1_MAKESTRING"
                        CASE  %FORM1_END
                            EZLIB_SetTooltipText CBLPARAM, "Control -  %FORM1_END"
                        CASE ELSE
                    END SELECT
                END IF
                IF EZLIB_IsTab(CBLPARAM) THEN
                    SELECT CASE EZLIB_TabID(CBLPARAM)
                        CASE ELSE
                    END SELECT
                END IF
            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_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
    
    
    ' (3) Put NEXT DIALOG Creation / Dialog Procedure code after here :
    
    
    ' *************************************************************
    '              EZGUI Freeware Dialog Designer Library
    '
    '                   see web site at EZGUI.COM
    '
    ' Copyright (C) 2000, Christopher R. Boss , All Rights Reserved !
    '
    ' This code was Generated by the EZGUI Freeware Dialog Designer
    ' and may be used ROYALTY FREE, as long as this Copyright notice
    ' is kept with the source code.
    ' The Author also gives you the right to post this code on a
    ' web site and to distribute it to others.
    ' *************************************************************
    
    SUB EZLIB_InitFonts()
        REDIM App_Font(0 TO 5)
        App_Font(0)=GetStockObject(%SYSTEM_FONT)
        App_Font(1)=GetStockObject(%SYSTEM_FIXED_FONT)
        App_Font(2)=GetStockObject(%ANSI_VAR_FONT)
        App_Font(3)=GetStockObject(%ANSI_FIXED_FONT)
        App_Font(4)=GetStockObject(%DEFAULT_GUI_FONT)    ' MS Sans Serif
        App_Font(5)=GetStockObject(%OEM_FIXED_FONT)      ' Terminal Font
        END SUB
    
    ' -------------------------------------------------------------
    
    SUB EZLIB_DeleteFonts()
        LOCAL N&
        ' Fonts 0 to 5 do not need to be deleted
        FOR N&=6 TO UBOUND(App_Font)
            IF App_Font(N&)<>0 THEN DeleteObject App_Font(N&)
        NEXT N&
        END SUB
    
    ' -------------------------------------------------------------
    
    SUB EZLIB_FixSize(BYVAL hDlg&, BYVAL Style&, BYVAL HasMenu&)
        LOCAL X&, Y&, W&, H&, XX&, YY&
        DIALOG GET SIZE hDlg& TO X&, Y&
        IF (Style& AND %WS_CAPTION) = %WS_CAPTION THEN
            IF HasMenu& THEN
                H&=H&+GetSystemMetrics(%SM_CYCAPTION)
            END IF
        END IF
        IF (Style& AND %WS_HSCROLL) = %WS_HSCROLL THEN
            H&=H&+GetSystemMetrics(%SM_CYHSCROLL)
        END IF
        IF (Style& AND %WS_VSCROLL) = %WS_VSCROLL THEN
            W&=W&+GetSystemMetrics(%SM_CYVSCROLL)
        END IF
        DIALOG PIXELS hDlg&, W&, H& TO UNITS XX&, YY&
        X&=X&+XX&
        Y&=Y&+YY&
        DIALOG SET SIZE hDlg&, X&, Y&
    END SUB
    
    ' -------------------------------------------------------------
    
    FUNCTION EZLIB_IsTooltip(BYVAL lParam AS LONG) AS LONG
        LOCAL pNM AS NMHDR PTR
        pNM=lParam
        IF @pNM.code=%TTN_NEEDTEXT THEN FUNCTION=1 ELSE FUNCTION=0
    END FUNCTION
    
    ' -------------------------------------------------------------
    
    FUNCTION EZLIB_TooltipID(BYVAL lParam AS LONG) AS LONG
        LOCAL pNM AS NMHDR PTR, pTT AS TOOLTIPTEXT PTR
        LOCAL IDNum&, UF&
        IDNum&=0
        pNM=lParam
        IF @pNM.code=%TTN_NEEDTEXT THEN
            ' Check for Tooltip message
            pTT=lParam
            UF&=@pTT.uFlags AND %TTF_IDISHWND
            IF UF&=%TTF_IDISHWND THEN
                IDNum&=GetDlgCtrlID(@pTT.hdr.idfrom)
            ELSE
                IDNum&=@pTT.hdr.idfrom
            END IF
        END IF
        FUNCTION=IDNum&
    END FUNCTION
    
    ' -------------------------------------------------------------
    
    SUB EZLIB_SetTooltipText(BYVAL lParam AS LONG, TipText$)
        LOCAL pNM AS NMHDR PTR, pTT AS TOOLTIPTEXT PTR
        pNM=lParam
        IF @pNM.code=%TTN_NEEDTEXT THEN
            ' Check for Tooltip message
            pTT=lParam
            IF TipText$<>"" THEN
                @pTT.szText=LEFT$(TipText$, 79)+CHR$(0)
            END IF
        END IF
    END SUB
    
    ' -------------------------------------------------------------
    
    FUNCTION EZLIB_IsTab(BYVAL lParam AS LONG) AS LONG
        LOCAL pNM AS NMHDR PTR
        pNM=lParam
        IF @pNM.code=%TCN_SELCHANGE THEN FUNCTION=1 ELSE FUNCTION=0
    END FUNCTION
    
    ' -------------------------------------------------------------
    
    FUNCTION EZLIB_TabID(BYVAL lParam AS LONG) AS LONG
        LOCAL pNM AS NMHDR PTR
        LOCAL IDNum&
        pNM=lParam
        IF @pNM.code=%TCN_SELCHANGE THEN
            IDNum&=@pNM.idfrom
        END IF
        FUNCTION=IDNum&
    END FUNCTION
    
    ' -------------------------------------------------------------
    
    FUNCTION EZLIB_TabNum(BYVAL lParam AS LONG) AS LONG
        LOCAL RV&, pNM AS NMHDR PTR
        LOCAL hCtrl AS LONG
        pNM=lParam
        IF @pNM.code=%TCN_SELCHANGE THEN
        hCtrl=@pNM.hwndFrom
            RV&=SendMessage(hCtrl, %TCM_GETCURSEL, 0, 0)+1
        END IF
        FUNCTION=RV&
    END FUNCTION
    
    ' -------------------------------------------------------------
    
    SUB EZLIB_AddTabs(BYVAL hDlg AS LONG, BYVAL IDNum&, BYVAL TabText$)
        LOCAL pItem AS TC_ITEM, hCtrl&
        LOCAL zText AS ASCIIZ*80
        LOCAL D$, P&, TB&
        IF IDNum&<>0 THEN
            hCtrl&=GetDlgItem(hDlg,IDNum&)
            IF hCtrl&<>0 THEN
                TB&=0
                DO
                    IF TabText$="" THEN EXIT DO
                    P&=INSTR(TabText$,"|")
                    IF P&>0 THEN
                        D$=LEFT$(TabText$,P&-1)
                        TabText$=MID$(TabText$,P&+1)
                    ELSE
                        D$=TabText$
                        IF TabText$="" THEN EXIT DO
                        TabText$=""
                    END IF
                    pItem.Mask=%TCIF_TEXT
                    zText=D$+CHR$(0)
                    pItem.pszText=VARPTR(zText)
                    SendMessage hCtrl&, %TCM_INSERTITEM, TB&, VARPTR(pItem)
                    TB&=TB&+1
                LOOP
            END IF
        END IF
    END SUB
    
    ' -------------------------------------------------------------
    
    SUB EZLIB_DefColors()
        LOCAL T&
        REDIM App_Brush&(0 TO 31)
        REDIM App_Color&(0 TO 31)
        FOR T&=0 TO 31
            App_Brush&(T&)=CreateSolidBrush(EZLIB_QBColor(T&))
            App_Color&(T&)=EZLIB_QBColor(T&)
        NEXT T&
    END SUB
    
    ' -------------------------------------------------------------
    
    SUB EZLIB_DeleteBrushes()
        LOCAL T&
        FOR T&=0 TO 31
            DeleteObject App_Brush&(T&)
        NEXT T&
    END SUB
    
    ' -------------------------------------------------------------
    
    FUNCTION EZLIB_QBColor(N&) AS LONG
        LOCAL RV&
        SELECT CASE N&
            CASE 0
            RV&=RGB(0,0,0)       ' Black
        CASE 1
            RV&=RGB(0,0,128)     ' Blue
        CASE 2
            RV&=RGB(0,128,0)     ' Green
        CASE 3
            RV&=RGB(0,128,128)   ' Cyan
        CASE 4
            RV&=RGB(196,0,0)     ' Red
        CASE 5
            RV&=RGB(128,0,128)   ' Magenta (Purple)
        CASE 6
            RV&=RGB(128,64,0)    ' Brown
        CASE 7
            RV&=RGB(196,196,196) ' White
        CASE 8
            RV&=RGB(128,128,128) ' Gray
        CASE 9
            RV&=RGB(0,0, 255)    ' Lt. Blue
        CASE 10
            RV&=RGB(0,255,0)     ' Lt. Green
        CASE 11
            RV&=RGB(0,255,255)   ' Lt. Cyan
        CASE 12
            RV&=RGB(255,0,0)     ' Lt. Red
        CASE 13
            RV&=RGB(255,0,255)   ' Lt. magenta (Purple)
        CASE 14
            RV&=RGB(255,255,0)   ' Yellow
        CASE 15
            RV&=RGB(255,255,255) ' Bright White
        CASE 16   ' - Extended QB colors Pastel version -
            RV&=RGB(164,164,164)
        CASE 17
            RV&=RGB(128,160,255)
        CASE 18
            RV&=RGB(160,255,160)
        CASE 19
            RV&=RGB(160,255,255)
        CASE 20
            RV&=RGB(255,160,160)
        CASE 21
            RV&=RGB(255,160,255)
        CASE 22
            RV&=RGB(255,255,160)
        CASE 23
            RV&=RGB(212,212,212)
        CASE 24
            RV&=RGB(180,180,180)
        CASE 25
            RV&=RGB(188,220,255)
        CASE 26
            RV&= RGB(220,255,220)
        CASE 27
            RV&=RGB(220,255,255)
        CASE 28
            RV&=RGB(255,220,220)
        CASE 29
            RV&=RGB(255,220,255)
        CASE 30
            RV&=RGB(255,255,220)
        CASE 31
            RV&=RGB(228,228,228)
        CASE ELSE
            RV&=RGB(0,0,0)
        END SELECT
        FUNCTION=RV&
    END FUNCTION
     ' -------------------------------------------------------------
    SUB EZLIB_ShowControl(BYVAL hWnd&, BYVAL ID&, BYVAL SFlag&)
        LOCAL hCtrl&
        IF IsWindow(hWnd&) THEN
            IF ID&<>0 THEN
                hCtrl&=GetDlgItem(hWnd&,ID&)
                IF SFlag&=0 THEN
                    ShowWindow hCtrl&, %SW_HIDE
                ELSE
                    ShowWindow hCtrl&, %SW_SHOW
                END IF
            END IF
        END IF
    END SUB
     ' -------------------------------------------------------------
    ' *************************************************************
    '             End of EZGUI Dynamic Dialogs Library
    ' *************************************************************
    
    
    ' *************************************************************
    '  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
    
        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&
    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&
    
            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&
    
            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
              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
        IF CBCTLMSG=%LBN_DBLCLK THEN
    
        END IF
        IF CBCTLMSG=%LBN_SETFOCUS THEN
    
        END IF
        IF CBCTLMSG=%LBN_KILLFOCUS THEN
    
        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
              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_SELCHANGE THEN
    
    
        END IF
        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
        IF CBCTLMSG=%LBN_SETFOCUS THEN
    
        END IF
        IF CBCTLMSG=%LBN_KILLFOCUS THEN
    
        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
           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
    
           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
    
           EnableMenuItem hForm1_Menu1&, %Form1_SAVE, %MF_BYCOMMAND OR %MF_ENABLED
    
        END IF
    
        IF CBCTLMSG=%BN_SETFOCUS THEN
    
        END IF
        IF CBCTLMSG=%BN_KILLFOCUS THEN
    
        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
    ' ------------------------------------------------
    
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FORM1_LISTBOX3
    
    END FUNCTION
    ' ------------------------------------------------
    
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FORM1_TEXT1
    
    END FUNCTION
    ' ------------------------------------------------
    
    
    ' (4) Put NEXT DIALOG Callback / Subs code after here :
    
    ' *************************************************************
    '                     Put Your Code Here
    ' *************************************************************
    SUB FilNameSave()
       LOCAL Path   AS STRING
       LOCAL f      AS STRING
       LOCAL Style  AS DWORD
       LOCAL hFile  AS LONG
       LOCAL r&
    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
           IF LEN(CollateS)=256 THEN
               PRINT# hFile, MID$(CollateS,33)
           ELSE
               PRINT# hFile, CollateS
           END IF
    
           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
       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, CollateS
          CLOSE hFile
          IF LEN(CollateS)<>224 THEN
              MSGBOX "This file is not a collate string file! "+$CRLF+" Try again.",%MB_ICONHAND,"Problem:"
              CollateS=""
          END IF
       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)
    
       ' This is a user defined collate string devised by this program,
       ' saved and then pasted in this subroutine. It covers the last
       ' 224 characters (from 32 to 255) of the collate string. The
       ' first 32 characters (from 0 to 31), which are never changed
       ' when using this program, are added later.
    
       ' The double quote "" near the beginning of the string is to enable
       ' a single " to be included in the string.
       ' See the PowerBasic help file on String Data Types.
       CS=" !""#$%&'()*+,-./1579:;<=>?@ABCDEFHRTX\fhjlvxz|~‚ŒŽ’”–ž*¢¤«¶·¸¹º»GQSW[egikuwy{}‹‘“•Ÿ¡£ª¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïð0ñ68òóôõö÷øù234úJLNP¯µ*V^`bdnp  rtZ€„†Šˆ³û±˜šœ¦¨üýIKMO®´¬U]_acmoqsYƒ…‰‡²þ°—™›¥§ÿ©"
       ' The sorting sequence cannot easily be seen from the string.
       ' The string needs deciphering as in "SUB Form1_SUGG_Select()"
       ' before the sorting sequence can be displayed in Listbox2.
     
       'MSGBOX STR$(LEN(CS))
    
    END SUB
    The correction made August 11, 2001 is to make the program
    compatible with the new version of the COMDLG32.INC winapi file.

    ------------------


    [This message has been edited by Erik Christensen (edited August 11, 2001).]

  • #2
    ' 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. e.chr@email.dk
    '
    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).]

    Comment

    Working...
    X