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 4. Index Sorting using translation table. Load, display, sort, and save yo

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

  • Array Sort 4. Index Sorting using translation table. Load, display, sort, and save yo

    ' array sort 4. index sorting using translation table. load, display,
    ' sort, and save your data base. applies listview and combo boxes.
    '
    ' hi fellows,
    '
    ' this program demonstrates index sorting of a data base using
    ' your own translation tables to determine the sequence
    ' of sorting. the idea of using translation tables for this purpose
    ' was provided by semen matusovski in the poverbasic forum.
    ' with this elegant technique any sorting problem can be solved.
    ' the assembler routines for translation and back translation are
    ' extremely fast.
    '
    ' computers compare characters according to their internal position
    ' which is indicated by their ascii code (0 to 255). the ascii code
    ' is thus a code of position. each position is translated to its
    ' corresponding character by the computer using a predefined
    ' translation table e.g. the ansi character set. since any comparison
    ' made by the computer is done according to the internal position, you
    ' can influence the results by changing the internal representation
    ' of the characters i.e. their ascii positions or - equivalently -
    ' the translation table. e.g. by swapping the internal representations
    ' of "a" and "b" making "a" occupy position 66 (zero based) and "b"
    ' occupy position 65 in the translation table, then "b" will in effect
    ' be considered "less" than "a" in any comparison made by the computer
    ' including any sorting procedure. you can therefore determine your
    ' own sorting sequence by designing your own character translation
    ' table. this is of particular interest for languages having special
    ' characters which need to be considered in the sorting process.
    ' in order to regain correct presentation of the characters after
    ' comparison and sorting, the characters should again occupy their
    ' normal position i.e. they should be translated back again to the
    ' normal translation table.
    '
    ' thus the steps in the procedure are:
    ' 1. translation of characters
    ' 2. sorting
    ' 3. back-translation of characters
    '
    ' you can easily design, edit and save your own translation table
    ' and the corresponding reverse translation table using the last of the
    ' two programs at this address:
    ' http://www.powerbasic.com/support/pb...ad.php?t=22936
    '
    ' the index sorting routine previously presented in the forum
    ' performs sorting without moving the data. an index holds the
    ' correct sequence after sorting. you can specify a sorting
    ' priority of up to 5 variables. for each variable you can specify
    ' sorting to be ascending or descending and alphabetical or
    ' numerical. the program will suggest which of the latter
    ' alternatives to use.
    '
    ' the listview part was inspired by ideas and code provided to the
    ' powerbasic forum by peter redei, david l morris, semen matusovski,
    ' jules marchildon and borje hagsten.

    ' the initial skeleton code was generated using the ezgui freeware
    ' dialog designer by christopher r. boss. see web site at ezgui.com.
    ' unused code has been removed to improve clarity.

    ' erik christensen, copenhagen, denmark. e.chr@email.dk
    [CODE]
    #compile exe
    #register none
    #dim all
    %noanimate = 1
    %nodraglist = 1
    %noheader = 1
    %noimagelist = 1
    %nostatusbar = 1
    %notoolbar = 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"
    ' *************************************************************
    ' some supplementary listview styles that you may not have in your
    ' commctrl.inc file.
    ' they are not all used in this program
    %lvm_first = &h1000
    %lvm_setextendedlistviewstyle = %lvm_first + 54
    %lvm_getextendedlistviewstyle = %lvm_first + 55
    %lvs_ex_fullrowselect = &h20
    %lvs_ex_gridlines = &h1
    %lvs_ex_checkboxes = &h4
    %lvs_ex_trackselect = &h8
    %lvs_ex_headerdragdrop = &h10
    %lvm_getitemstate = (%lvm_first + 44)
    %lvm_getitemtext = (%lvm_first + 45)
    %lvis_stateimagemask = &hf000
    %lvbkif_source_none = &h0
    %lvbkif_source_hbitmap = &h1
    %lvbkif_source_url = &h2
    %lvbkif_source_mask = &h3
    %lvbkif_style_normal = &h0
    %lvbkif_style_tile = &h10
    %lvbkif_style_mask = &h10
    %lvm_setbkimagea = %lvm_first + 68
    %lvm_setbkimage = %lvm_setbkimagea
    %lvm_settextbkcolor = %lvm_first + 38
    %lvm_setbkimagea = %lvm_first + 68
    %lvm_setbkimage = %lvm_setbkimagea
    %clr_none = &hffffffff

    ' application constants and declares
    %form1_start = 500
    %form1_data = 505
    %form1_openfile = 510
    %form1_saveas = 515
    %form1_separator_520 = 520
    %form1_exit = 525
    %form1_label6 = 100
    %form1_label5 = 105
    %form1_label4 = 110
    %form1_label3 = 115
    %form1_label2 = 120
    %form1_label1 = 125
    %form1_label8 = 130
    %form1_label7 = 135
    %form1_label9 = 137
    %form1_combobox1 = 140
    %form1_combobox2 = 145
    %form1_combobox3 = 150
    %form1_combobox4 = 155
    %form1_combobox5 = 157
    %form1_combobox12 = 160
    %form1_combobox22 = 165
    %form1_combobox32 = 170
    %form1_combobox42 = 175
    %form1_combobox52 = 180
    %form1_combobox13 = 185
    %form1_combobox23 = 190
    %form1_combobox33 = 195
    %form1_combobox43 = 200
    %form1_combobox53 = 205
    %form1_listbox2 = 210
    %form1_listbox1 = 225
    %form1_original = 230
    %form1_sort = 235
    %form1_end = 240
    ' --------------------------------------------------
    declare sub showdialog_form1(byval hparent&)
    declare callback function form1_dlgproc
    declare sub form1_data_select()
    declare sub form1_openfile_select()
    declare sub form1_saveas_select()
    declare sub form1_exit_select()
    declare callback function cbf_form1_combobox1()
    declare callback function cbf_form1_combobox2()
    declare callback function cbf_form1_combobox3()
    declare callback function cbf_form1_combobox4()
    declare callback function cbf_form1_combobox5()
    declare callback function cbf_form1_listbox1()
    declare callback function cbf_form1_listbox2()
    declare callback function cbf_form1_sort()
    declare callback function cbf_form1_end()
    declare callback function cbf_form1_original()

    declare function filnameopen() as long
    declare function filnamesave() as long
    declare function filepath(byval src as string) as string
    declare function filenam(byval src as string) as string
    declare sub appendlistview (hlist as long, rec() as string )
    declare function makefont(byval fonttypesize as long,byval fontweight as long, _
    byval italic as long, byval underline as long,byval strikeout as long, _
    byval facename as string) as long
    declare sub translate (tr as string)
    declare sub reversetranslate (tr as string)

    global brush&
    global hform1& ' dialog handle
    ' global handles for menus
    global hform1_menu0&
    global hform1_menu1&
    global pafu as string ' path and file for input
    global pafuout as string ' path and file for output
    global collates as string ' collate string
    global dat() as string ' array to hold the data in listbox 1
    global head() as string ' array to hold the headers in listbox 1
    global indx() as integer ' indx(1:rows)
    global prio() as integer ' prio(0:2,1:columns)
    global maxlen() as integer ' (1:columns)
    global alphnum() as integer ' (1:columns)
    global rows as long ' number of rows in array
    global columns as long ' number of columns in array
    global horizbaseu as long
    global vertbaseu as long
    global sortflag as long ' added march 11th
    global delim as string ' delimiter for saving and loading files
    ' set to $tab (=chr$(9)) in this program.
    ' you may change this.
    global rowheadcorrect as long
    global lffont as logfont ' logfont structure
    global combobox1_list() as string
    global combobox2_list() as string
    global combobox3_list() as string
    global combobox4_list() as string
    global combobox5_list() as string

    global combobox12_list() as string
    global combobox22_list() as string
    global combobox32_list() as string
    global combobox42_list() as string
    global combobox52_list() as string

    global combobox13_list() as string
    global combobox23_list() as string
    global combobox33_list() as string
    global combobox43_list() as string
    global combobox53_list() as string
    global listbox2_list() as string

    ' *************************************************************
    ' application entrance
    ' *************************************************************

    function pbmain
    local count&
    local cc1 as init_common_controlsex
    cc1.dwsize=sizeof(cc1)
    cc1.dwicc=%icc_win95_classes
    initcommoncontrolsex cc1
    brush&=createsolidbrush(rgb(196,196,196)) ' light gray
    showdialog_form1 0
    do
    dialog doevents to count&
    loop until count&=0
    deleteobject brush&
    end function

    ' application dialogs

    sub showdialog_form1(byval hparent&)
    local style&, exstyle& ,hctl&
    local combostyle&, labelstyle&
    local n&, ct&, r&, hfont&, xfact as single, xp as long,yp as long
    ' hparent& = 0 if no parent dialog
    local hlistview as long
    local lstyle as long
    local result as long
    sortflag=0 ' added march 11th
    redim combobox12_list(1)
    redim combobox22_list(1)
    redim combobox32_list(1)
    redim combobox42_list(1)
    redim combobox52_list(1)

    redim combobox13_list(1)
    redim combobox23_list(1)
    redim combobox33_list(1)
    redim combobox43_list(1)
    redim combobox53_list(1)

    combobox12_list(0)="ascending (smallest or a first)"
    combobox12_list(1)="descending (largest or z first)"
    combobox22_list(0)="ascending (smallest or a first)"
    combobox22_list(1)="descending (largest or z first)"
    combobox32_list(0)="ascending (smallest or a first)"
    combobox32_list(1)="descending (largest or z first)"
    combobox42_list(0)="ascending (smallest or a first)"
    combobox42_list(1)="descending (largest or z first)"
    combobox52_list(0)="ascending (smallest or a first)"
    combobox52_list(1)="descending (largest or z first)"

    combobox13_list(0)="alphabetical"
    combobox13_list(1)="numerical"
    combobox23_list(0)="alphabetical"
    combobox23_list(1)="numerical"
    combobox33_list(0)="alphabetical"
    combobox33_list(1)="numerical"
    combobox43_list(0)="alphabetical"
    combobox43_list(1)="numerical"
    combobox53_list(0)="alphabetical"
    combobox53_list(1)="numerical"

    style& = %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or %ds_center
    exstyle& = 0
    dialog new hparent&, "index sort using translation table", 0, 0, 376, 253, 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&, "use &default data", %form1_data, %mf_enabled
    menu add string, hform1_menu1&, "&open file", %form1_openfile, %mf_enabled
    menu add string, hform1_menu1&, "save file &as", %form1_saveas, %mf_grayed
    menu add string, hform1_menu1&, "-", %form1_separator_520, %mf_enabled
    menu add string, hform1_menu1&, "e&xit", %form1_exit, %mf_enabled
    menu attach hform1_menu0&, hform1&

    labelstyle& = %ws_child or %ws_visible or %ss_center
    control add label, hform1&, %form1_label6, "5th:", 0, 70, 14, 10,labelstyle&
    control add label, hform1&, %form1_label5, "4th:", 0, 56, 14, 10,labelstyle&
    control add label, hform1&, %form1_label4, "3rd:", 0, 42, 14, 10,labelstyle&
    control add label, hform1&, %form1_label3, "2nd:", 0, 28, 14, 10,labelstyle&
    control add label, hform1&, %form1_label2, "1st:", 0, 14, 14, 10,labelstyle&
    control add label, hform1&, %form1_label1, "variable sorting priority:", 14, 2, 116, 10,labelstyle&
    control add label, hform1&, %form1_label8, "alphabetic or numerical:", 270, 2, 86, 10,labelstyle&
    control add label, hform1&, %form1_label7, "ascending or descending:", 146, 2, 100, 10,labelstyle&
    control add label, hform1&, %form1_label9, "row", 5, 87, 26, 12,labelstyle&
    ' - - - - - - - - - - - - - - - - - - - - - - - - -
    combostyle&=%ws_child or %ws_visible or %cbs_dropdownlist or %ws_vscroll or %cbs_nointegralheight or %ws_tabstop
    control add combobox, hform1&, %form1_combobox1, combobox1_list(), 16, 12, 120, 48, combostyle& _
    call cbf_form1_combobox1
    control add combobox, hform1&, %form1_combobox2, combobox2_list(), 16, 26, 120, 48, combostyle& _
    call cbf_form1_combobox2
    control add combobox, hform1&, %form1_combobox3, combobox3_list(), 16, 40, 120, 48, combostyle& _
    call cbf_form1_combobox3
    control add combobox, hform1&, %form1_combobox4, combobox4_list(), 16, 54, 120, 48, combostyle& _
    call cbf_form1_combobox4
    control add combobox, hform1&, %form1_combobox5, combobox5_list(), 16, 68, 120, 48, combostyle& _
    call cbf_form1_combobox5
    ' - - - - - - - - - - - - - - - - - - - - - - - - -
    control add combobox, hform1&, %form1_combobox12, combobox12_list(), 144, 12, 114, 48,combostyle&
    control add combobox, hform1&, %form1_combobox22, combobox22_list(), 144, 26, 114, 48, combostyle&
    control add combobox, hform1&, %form1_combobox32, combobox32_list(), 144, 40, 114, 48,combostyle&
    control add combobox, hform1&, %form1_combobox42, combobox42_list(), 144, 54, 114, 48, combostyle&
    control add combobox, hform1&, %form1_combobox52, combobox52_list(), 144, 68, 114, 48,combostyle&
    ' - - - - - - - - - - - - - - - - - - - - - - - - -
    control add combobox, hform1&, %form1_combobox13, combobox13_list(), 266, 12, 106, 48,combostyle&
    control add combobox, hform1&, %form1_combobox23, combobox23_list(), 266, 26, 106, 48,combostyle&
    control add combobox, hform1&, %form1_combobox33, combobox33_list(), 266, 40, 106, 48,combostyle&
    control add combobox, hform1&, %form1_combobox43, combobox43_list(), 266, 54, 106, 48,combostyle&
    control add combobox, hform1&, %form1_combobox53, combobox53_list(), 266, 68, 106, 48,combostyle&
    ' select items for initial presentation in middle and right side combo boxes
    control handle hform1&, %form1_combobox12 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox22 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox32 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox42 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox52 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox13 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox23 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox33 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox43 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    control handle hform1&, %form1_combobox53 to hctl& : sendmessage hctl&,%cb_setcursel,0,0
    ' - - - - - - - - - - - - - - - - - - - - - - - - -
    ' an attempt to accomodate both large and small windows font setting
    dialog units hform1&, 200, 200 to pixels xp, yp
    xfact=xp/200
    if xfact>1.75 then ' large font
    hfont&=makefont(9,300,0,1,0,"arial")
    rowheadcorrect = 0
    else ' small font
    hfont&=makefont(8,300,0,1,0,"arial")
    rowheadcorrect = 2
    end if
    ' the font gives the same vertical spacing as in the listview box
    ' the left listbox works as a simulated row header which scrolls
    ' in parallel with the listview box

    control add "syslistview32", hform1&, %form1_listbox1,",29,84,343,134+rowheadcorrect, _
    %ws_border or %ws_child or %ws_tabstop or %lvs_report , %ws_ex_clientedge
    control handle hform1&,%form1_listbox1 to hlistview
    lstyle = sendmessage(hlistview, _
    %lvm_getextendedlistviewstyle, 0, 0)
    lstyle = lstyle or %lvs_ex_gridlines
    call sendmessage(hlistview, %lvm_setextendedlistviewstyle, _
    0, byval lstyle)
    r& = showwindow(hlistview,%sw_show)

    result = getdialogbaseunits
    'horizontal dialog box base unit
    'this is equal to the average width, in pixels, of the characters
    'in the system font.
    horizbaseu = lowrd(result)

    'vertical dialog box base unit
    'this is equal to the height, in pixels, of the font.
    vertbaseu = hiwrd(result)

    ' row idenfification (row header simulation)
    control add listbox, hform1&, %form1_listbox2, listbox2_list(), 6, 95+rowheadcorrect, 24, 122, _
    %ws_child or %ws_visible or %lbs_notify or %lbs_nointegralheight, _
    %ws_ex_clientedge

    control send hform1&, %form1_listbox2, %wm_setfont, hfont&, %true

    control add "button", hform1&, %form1_original, "show &original sequence", 60, 224, 118, 12, _
    %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled call cbf_form1_original
    control add "button", hform1&, %form1_sort, "&sort", 190, 224, 118, 12, _
    %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled call cbf_form1_sort
    control add "button", hform1&, %form1_end, "&end", 320, 224, 42, 12, _
    %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_form1_end
    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 as long
    local top as long
    select case cbmsg
    ' -----------------------------------------------
    case %wm_ctlcolormsgbox , %wm_ctlcolorbtn, %wm_ctlcoloredit,_
    %wm_ctlcolorstatic, %wm_ctlcolorscrollbar, %wm_ctlcolorlistbox
    ' control colors
    select case getdlgctrlid(cblparam)
    case %form1_listbox2
    setbkcolor cbwparam, rgb(196,196,196) ' light gray
    function=brush&
    case else
    function=0
    end select
    case %wm_notify
    ' this code ensures parallel scrolling of the "row header"
    ' originally suggested by borje hagsten
    control handle hform1&, %form1_listbox1 to hctl
    top = sendmessage(hctl, %lvm_gettopindex, 0, 0)
    control handle hform1&, %form1_listbox2 to hctl
    sendmessage hctl,%lb_settopindex,top,0
    case %wm_command
    ' process messages to controls that have no callback function
    ' and process messages to menu items
    select case cbctl
    case %form1_data ' popup menu item selected
    form1_data_select
    case %form1_openfile ' popup menu item selected
    form1_openfile_select
    case %form1_saveas ' popup menu item selected
    form1_saveas_select
    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_data_select()
    local i&,j&,fl&,y&
    ' make default test data set.
    data "surname","first name","city","weight (kg)","height (cm)","body mass index (bmi)","sorting test string"
    data "andersen","jones","smith","evans","nielsen","petersen"
    data "holmes","burton","monroe","watson","goethe","hals"
    data "schiller","rembrandt","bonaparte","wells","verne","shakespeare"
    data "hans","peter","eric","alan","alain","jean"
    data "john","william","claude","michael","carl","james"
    data "eve","marilyn","claudia","maria","susan","karin"
    data "los angeles","new york","washington","san diego","san francisco","chicago"
    data "paris","london","berlin","copenhagen","oslo","stockholm"
    data "amsterdam","brussels","moscow","saint petersburg","shanghai","tokyo"
    columns=7 ' number of columns
    rows=1000 ' number of rows
    redim head(1:rows)
    redim dat(1:columns,1:rows)
    for i&=1 to columns
    head(i&)=read$(i&)
    next
    randomize 1.634 ' ensures same data set each time you selects default data
    for i&=1 to rows
    dat(1,i&)=read$(rnd(8,25))
    dat(2,i&)=read$(rnd(26,43))
    dat(3,i&)=read$(rnd(44,61))
    dat(4,i&)=ltrim$(str$(rnd(50,130)))
    dat(5,i&)=ltrim$(str$(rnd(160,210)))
    dat(6,i&)=ltrim$(str$(round(val(dat(4,i&))*10000/val(dat(5,i&))^2,1)))
    fl&=0
    do
    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
    fl&=1
    dat(7,i&)=string$(rnd(9,10),y&)
    case else
    end select
    loop until fl&=1
    next

    call checkanddisplaydata()
    msgbox "any similarity to known persons is accidental !",%mb_iconinformation,"random data base"

    enablemenuitem hform1_menu1&, %form1_saveas, %mf_bycommand or %mf_enabled
    end sub
    ' ------------------------------------------------
    sub form1_openfile_select()
    if filnameopen() then
    if rows>=2 then
    call checkanddisplaydata()
    end if
    end if
    end sub
    ' ------------------------------------------------
    sub form1_saveas_select()
    if filnamesave() then
    end if
    end sub
    ' ------------------------------------------------
    sub form1_exit_select()
    local res&
    res&=msgbox ("are you sure?",%mb_yesno or %mb_iconquestion ,"exit")
    if res&=%idyes then dialog end hform1&
    end sub
    ' ------------------------------------------------
    callback function cbf_form1_combobox1
    local cval&,hctl&,i&
    ' return current selection in cval&
    control send cbhndl , cbctl, %cb_getcursel, 0,0 to cval&
    if (cbctlmsg=%cbn_selchange) or (cbctlmsg=%cbn_editchange) or (cbctlmsg=%cbn_editupdate) then
    ' set numerical or alphabetical acccording to the type of the variable
    control handle hform1&, %form1_combobox13 to hctl& : sendmessage hctl&,%cb_setcursel,alphnum(cval&+1),0
    ' empty comboboxes 2-5
    control handle hform1&, %form1_combobox2 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    control handle hform1&, %form1_combobox3 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    control handle hform1&, %form1_combobox4 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    control handle hform1&, %form1_combobox5 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    ' put all variables minus the selected in combobox2
    for i&=0 to columns-1
    if columns>=2 and i&<>cval& then combobox add hform1&, %form1_combobox2, head(i&+1)
    next
    control enable hform1&, %form1_sort
    end if
    end function
    ' ------------------------------------------------
    callback function cbf_form1_combobox2
    local cval&,hctl&,res&,txt$,i&
    ' return current selection in cval&
    control send cbhndl , cbctl, %cb_getcursel, 0,0 to cval&
    if (cbctlmsg=%cbn_selchange) or (cbctlmsg=%cbn_editchange) or (cbctlmsg=%cbn_editupdate) then
    ' set numerical or alphabetical acccording to the type of the variable
    control handle hform1&, %form1_combobox2 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    txt$=combo_getlbtext(hctl&,cval&)
    txt$=left$(txt$,res&)
    for i&=1 to columns
    if txt$=head(i&) then
    control handle hform1&, %form1_combobox23 to hctl&
    sendmessage hctl&,%cb_setcursel,alphnum(i&),0
    end if
    next
    ' empty comboboxes 3-5
    control handle hform1&, %form1_combobox3 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    control handle hform1&, %form1_combobox4 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    control handle hform1&, %form1_combobox5 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    ' put remaining variables in combobox 3
    for i&=0 to columns-2
    control handle hform1&, %form1_combobox2 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,i&,0)
    txt$=combo_getlbtext(hctl&,i&)
    txt$=left$(txt$,res&)
    if i&<>cval& then
    control handle hform1&, %form1_combobox3 to hctl&
    res&=combo_addstring(hctl&,txt$)
    end if
    next

    end if
    end function
    ' ------------------------------------------------
    callback function cbf_form1_combobox3
    local cval&,hctl&,res&,txt$,i&
    ' return current selection in cval&
    control send cbhndl , cbctl, %cb_getcursel, 0,0 to cval&
    if (cbctlmsg=%cbn_selchange) or (cbctlmsg=%cbn_editchange) or (cbctlmsg=%cbn_editupdate) then
    ' set numerical or alphabetical acccording to the type of the variable
    control handle hform1&, %form1_combobox3 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    txt$=combo_getlbtext(hctl&,cval&)
    txt$=left$(txt$,res&)
    for i&=1 to columns
    if txt$=head(i&) then
    control handle hform1&, %form1_combobox33 to hctl&
    sendmessage hctl&,%cb_setcursel,alphnum(i&),0
    end if
    next
    ' empty comboboxes 4-5
    control handle hform1&, %form1_combobox4 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    control handle hform1&, %form1_combobox5 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    ' put remaining variables in combobox 4
    for i&=0 to columns-3
    control handle hform1&, %form1_combobox3 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,i&,0)
    txt$=combo_getlbtext(hctl&,i&)
    txt$=left$(txt$,res&)
    if i&<>cval& then
    control handle hform1&, %form1_combobox4 to hctl&
    res&=combo_addstring(hctl&,txt$)
    end if
    next
    end if
    end function
    ' ------------------------------------------------
    callback function cbf_form1_combobox4
    local cval&,hctl&,res&,txt$,i&
    ' return current selection in cval&
    control send cbhndl , cbctl, %cb_getcursel, 0,0 to cval&
    if (cbctlmsg=%cbn_selchange) or (cbctlmsg=%cbn_editchange) or (cbctlmsg=%cbn_editupdate) then
    ' set numerical or alphabetical acccording to the type of the variable
    control handle hform1&, %form1_combobox4 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    txt$=combo_getlbtext(hctl&,cval&)
    txt$=left$(txt$,res&)
    for i&=1 to columns
    if txt$=head(i&) then
    control handle hform1&, %form1_combobox43 to hctl&
    sendmessage hctl&,%cb_setcursel,alphnum(i&),0
    end if
    next
    ' empty combobox 5
    control handle hform1&, %form1_combobox5 to hctl& : sendmessage hctl&,%cb_resetcontent,0,0
    ' put remaining variables in combobox 5
    for i&=0 to columns-4
    control handle hform1&, %form1_combobox4 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,i&,0)
    txt$=combo_getlbtext(hctl&,i&)
    txt$=left$(txt$,res&)
    if i&<>cval& then
    control handle hform1&, %form1_combobox5 to hctl&
    res&=combo_addstring(hctl&,txt$)
    end if
    next
    end if
    end function
    ' ------------------------------------------------
    callback function cbf_form1_combobox5
    local cval&,hctl&,res&,txt$,i&
    ' return current selection in cval&
    control send cbhndl , cbctl, %cb_getcursel, 0,0 to cval&
    if (cbctlmsg=%cbn_selchange) or (cbctlmsg=%cbn_editchange) or (cbctlmsg=%cbn_editupdate) then
    ' set numerical or alphabetical acccording to the type of the variable
    control handle hform1&, %form1_combobox5 to hctl&
    res&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    txt$=combo_getlbtext(hctl&,cval&)
    txt$=left$(txt$,res&)
    for i&=1 to columns
    if txt$=head(i&) then
    control handle hform1&, %form1_combobox53 to hctl&
    sendmessage hctl&,%cb_setcursel,alphnum(i&),0
    end if
    next
    end if
    end function
    ' ------------------------------------------------
    callback function cbf_form1_sort
    local i&,j&,jj&,k&,kk&,l&,hctl&,cvartx$,calnu&,casds&,imax&,res&,cval&,length&
    local t1 as double
    local t2 as double
    if cbctlmsg=%bn_clicked then
    redim indx(1:rows)
    redim prio(0:2,1:columns)

    imax&=5
    if columns<5 then imax&=columns

    for i&=1 to imax&
    select case i&
    case 1
    control handle hform1&, %form1_combobox1 to hctl&
    cval&=combo_getcursel(hctl&) ' get current selection index
    length&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    ' get selected text without extra spaces
    cvartx$=left$(combo_getlbtext(hctl&,cval&),length&)
    control handle hform1&, %form1_combobox12 to hctl&
    casds&=combo_getcursel(hctl&)
    control handle hform1&, %form1_combobox13 to hctl&
    calnu&=combo_getcursel(hctl&)
    case 2
    control handle hform1&, %form1_combobox2 to hctl&
    cval&=combo_getcursel(hctl&) ' get current selection index
    length&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    ' get selected text without extra spaces
    cvartx$=left$(combo_getlbtext(hctl&,cval&),length&)
    control handle hform1&, %form1_combobox22 to hctl&
    casds&=combo_getcursel(hctl&)
    control handle hform1&, %form1_combobox23 to hctl&
    calnu&=combo_getcursel(hctl&)
    case 3
    control handle hform1&, %form1_combobox3 to hctl&
    cval&=combo_getcursel(hctl&) ' get current selection index
    length&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    ' get selected text without extra spaces
    cvartx$=left$(combo_getlbtext(hctl&,cval&),length&)
    control handle hform1&, %form1_combobox32 to hctl&
    casds&=combo_getcursel(hctl&)
    control handle hform1&, %form1_combobox33 to hctl&
    calnu&=combo_getcursel(hctl&)
    case 4
    control handle hform1&, %form1_combobox4 to hctl&
    cval&=combo_getcursel(hctl&) ' get current selection index
    length&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    ' get selected text without extra spaces
    cvartx$=left$(combo_getlbtext(hctl&,cval&),length&)
    control handle hform1&, %form1_combobox42 to hctl&
    casds&=combo_getcursel(hctl&)
    control handle hform1&, %form1_combobox43 to hctl&
    calnu&=combo_getcursel(hctl&)
    case 5
    control handle hform1&, %form1_combobox5 to hctl&
    cval&=combo_getcursel(hctl&) ' get current selection index
    length&=sendmessage (hctl&,%cb_getlbtextlen,cval&,0)
    ' get selected text without extra spaces
    cvartx$=left$(combo_getlbtext(hctl&,cval&),length&)
    control handle hform1&, %form1_combobox52 to hctl&
    casds&=combo_getcursel(hctl&)
    control handle hform1&, %form1_combobox53 to hctl&
    calnu&=combo_getcursel(hctl&)
    case else
    end select

    'prio(0,n) holds the n-th sorting prio

  • #2
    Hi

    If I compiled it with PBDLL 6.0 THAT GIVE error:
    IF SaveFileDialog(0, "Save File", f, Path,"Text Files|*.txt|All Files|*.*", "txt", Style) THEN

    Greetings
    Stephane

    Ps: Can you please send me the exe file????
    email: brainsoft@pandora.be

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

    Comment


    • #3
      After some small additional changes (se above), the program
      should now be OK, I hope.

      Erik

      August 2001
      P.S. Further improvements have been made to accomodate both small
      and large fonts settings in Windows.
      In addition the program is made compatible with the new version
      of the COMDLG32.INC winapi file.

      Regards,
      Erik


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

      Comment


      • #4
        The program has been adjusted to work also with PBWin7.0x.
        The present translation table does work with English characters
        without any problems.

        If you work only with English characters, the translation table
        bits may be deleted. If you work with other character sets, the
        idea of making your own translation table for correct sorting of
        items in your own language may be useful to you.

        Good luck!

        Erik


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

        Comment

        Working...
        X