Plugicielle pour Panoramic

dim n,a$,fi$
full_space 0
dlist 133

fi$="testsort.txt":clear 133:file_load 133,fi$:sort 133

for n=1 to count(133)
a$=item_read$(133,n)
print a$
next n

for n1=33 to 90
  for n=1 to count(134)
    a$=item_read$(134,n):aa$=a$:gosub dec_string:r$=left$(element$(10),1)
    if r$=chr$(n1) then item_add 133,aa$
  next n
next n1
clear 134
for n=1 to count(133)
  a$=item_read$(133,n):ls=len(a$):aa$=mid$(a$,6,ls):item_add 134,aa$
next n
clear 133
for n=1 to count(134)
  a$=item_read$(134,n):item_add 133,a$
next n

' data "Bonjour" , "chien" , "chat" , "passoire" , "Livre" , "analyse" , "mou"
 data "Voiture","Camion","Moto","Bat_man","Avion_boeing","Train","bateau"
' data "Aeiou","Bcdef","abcde","zabcd","Maeif","_izer","I_ioup"

dim g,i,j,m$(7),a$
list 1:left 1,150
list 2:left 2,350
for i=1 to 7:read m$(i):item_add 1,m$(i):item_add 2,m$(i):next i:sort 2

for j=1 to 6
 for i=1 to 6
  for g=1 to len(m$(i))
'  if asc(mid$(m$(i),g,1))<asc(mid$(m$(i+1),g,1)) and mid$(m$(i+1),g,1)<>"" then exit_for
'  if asc(mid$(m$(i),g,1))>asc(mid$(m$(i+1),g,1)) and mid$(m$(i+1),g,1)<>""
  if asc(lower$(mid$(m$(i),g,1)))<asc(lower$(mid$(m$(i+1),g,1))) and mid$(m$(i+1),g,1)<>"" then exit_for
  if asc(lower$(mid$(m$(i),g,1)))>asc(lower$(mid$(m$(i+1),g,1))) and mid$(m$(i+1),g,1)<>""
    a$=m$(i):m$(i)=m$(i+1):m$(i+1)=a$
    exit_for
  end_if
  next g
 next i
next j

for i=1 to 7:print m$(i):next i

IF a$ > b$ THEN ...

data  "MemoChoixStyle","MemoValideEdit","Memo_applique_Style","MemoStyleEdit","MemoClicEditStyle"
data  "Memo_Cde_Style","MemoListeStyle","Memo_Zoom","Memo_Scroll_color","Memo_Show","Memo_Hide"
data  "Memo_Size","Memo_Fonte","Memo_Color","Memo_Alpha","Memo_Fond","Memo_Attribut","Memo_Copie","Memo_Fichier"
data  "MemoCalcul","MemoData","MemoChange","Memo_Lecture_Style","quite_Memo_Include","LIRE_MemoRich","$$$"

list 1:width 1,120:height 1,350
dim a$ ,l% ,a  ,b$ , c$ , swap$ , flag%
while a$ <> "$$$"
  read a$:item_add 1,a$
  if l%< len(a$) then l%=len(a$)
end_while
item_delete 1,count(1)


list 2: left 2,130:width 2,160:height 2,350 :font_name 2,"Bitstream Vera Sans Mono"
for a = 1 to count(1)
  a$ = item_read$(1,a)
  a$ = left$(a$+ string$(l%," "),l%) + str$(a)
  item_add 2,a$
next a
' ----
list 3:left 3,300:width 3,160:height 3,350  :font_name 3,"Bitstream Vera Sans Mono"
for a = 1 to count(2)
  a$ = item_read$(2,a) : item_add 3,a$
next a

dlist 4

repeat
flag%=0 :hide 3
for a = 1 to count(3)-1
  a$ = item_read$(3,a)
  b$ = item_read$(3,a+1)
  clear 4
  item_add 4,a$
  item_add 4,b$
  sort 4
  if a$<> item_read$(4,1)
      flag% = 1
      item_delete 3,a:item_insert 3,a,b$
      item_delete 3,a+1:item_insert 3,a+1,a$
  end_if

next a
until flag% = 0 or scancode = 27
show 3
message "maintenant on compare le tri, avec l'instruction sort de Panoramic"

sort 2
' SORT de Panoramic, marche mieux que celui d'AutoIt, à moins qu'il y a des réglages sur une option
' que je ne connais pas.

' Tri de chaînes suivant la valeur Ascii des caractères
DIM a$, h$, i%, j%, f1$, f2$, t1, t2
DIM scr$, script$: scr$ = "Tri.vbs"
LABEL Trih, Trivbs

DATA "Tri.vbs"
DATA "Option Explicit"
DATA "' Tri de chaînes dans l'ordre des valeurs Ascii"
DATA "' Paramètres: fichieràtrier fichierrésultat"
DATA "' (peuvent être identiques)"
DATA "Dim objFso, objTextFile"
DATA "Dim arrLines "
DATA "Dim bpermute, cprovisoire, i, j"
DATA "Dim MyFile, MySortedFile"
DATA "MyFile = wscript.Arguments(0)"
DATA "MySortedFile = wscript.Arguments(1) "
DATA ""
DATA "Set objFso = CreateObject("+CHR$(34)+"Scripting.FileSystemObject"+CHR$(34)+")"
DATA "Set objTextFile = objFso.OpenTextFile(MyFile, 1)"
DATA "arrLines = Split(objTextFile.ReadAll,vbCrLf)"
DATA "objTextFile.Close "
DATA ""
DATA "bpermute = True"
DATA "Do While bpermute = True                    "
DATA "  bpermute = False          "
DATA "  For i = UBound(arrLines) To 1 Step -1 "
DATA "      If Len(arrLines(i)) > 1 Then"
DATA "          For j = 0 To i - 1 "
DATA "              If Len(arrLines(j)) > 1 Then"
DATA "                If Split(arrLines(j), Chr(44))(0) > _"
DATA "                    Split(arrLines(j + 1), Chr(44))(0) Then "
DATA "                    cprovisoire = arrLines(j)      "
DATA "                    arrLines(j) = arrLines(j + 1)    "
DATA "                    arrLines(j + 1) = cprovisoire    "
DATA "                    bpermute = True "
DATA "                End If"
DATA "              End If "
DATA "          Next "
DATA "      End If "
DATA "  Next  "
DATA "Loop"
DATA "'Write File"
DATA "Set objTextFile = objFso.CreateTextFile(MySortedFile, 2)"
DATA "For i = 0 To UBound(arrLines) "
DATA "    objTextFile.WriteLine arrLines(i)"
DATA "Next"
DATA "objTextFile.Close"
DATA "Set objTextFile = Nothing"
DATA "Set objFso = Nothing"
DATA "f"
READ script$
WHILE script$ <> scr$: READ script$: END_WHILE: ' rephasage sur les datas
FILE_OPEN_WRITE 9, "C:\Temp" + scr$
    READ script$
    WHILE script$ <> "f"
        FILE_WRITELN 9, script$: READ script$
    END_WHILE
FILE_CLOSE 9
script$ = "C:\Temp" + scr$: ' script à exécuter

HEIGHT 0, 900: WIDTH 0, 840
LIST 1: HEIGHT 1, 800: WIDTH 1, 400
DLIST 2
LIST 3: HEIGHT 3, 800: LEFT 3, 410: WIDTH 3, 400
' =================================================== A VOIR ! ================
f1$ = "C:\Temp\Test.txt": ' ***** Fichier à trier
f2$ = "C:\Temp\FTrie.txt": ' ***** Fichier résultat
' =============================================================================
FILE_LOAD 1, f1$
t1 = VAL(RIGHT$(TIME$,2))+60*VAL(MID$(TIME$,4,2))+3600*VAL(LEFT$(TIME$,2))
' GOSUB Trih: ' tri par la méthode conversion hexa
GOSUB Trivbs: ' tri par la méthode script vbs
t2 = VAL(RIGHT$(TIME$,2))+60*VAL(MID$(TIME$,4,2))+3600*VAL(LEFT$(TIME$,2))
FILE_LOAD 3, f2$
MESSAGE "Durée= " + STR$(t2-t1) + " s."
END

Trih:
FILE_LOAD 1, f1$
FOR i% = 1 TO COUNT(1)
    a$ = ITEM_READ$(1, i%): h$ = ""
    FOR j% = 1 TO LEN(a$)
        h$ = h$ + RIGHT$("0"+HEX$(ASC(MID$(a$, j%, 1))), 2)
    NEXT j%
    ITEM_ADD 2, h$
NEXT i%
SORT 2
FOR i% = 1 TO COUNT(2)
    h$ = ITEM_READ$(2, i%): a$ = ""
    FOR j% = 1 TO LEN(h$) STEP 2
        a$ = a$ + CHR$(HEX(MID$(h$, j%, 2)))
    NEXT j%
    ITEM_ADD 3, a$
NEXT i%
FILE_SAVE 3, f2$
RETURN

Trivbs:
EXECUTE_WAIT "Wscript.exe " + script$ + " " + f1$ + " " + f2$
RETURN

data  "MemoChoixStyle","MemoValideEdit","Memo_applique_Style","MemoStyleEdit","MemoClicEditStyle"
data  "Memo_Cde_Style","MemoListeStyle","Memo_Zoom","Memo_Scroll_color","Memo_Show","Memo_Hide"
data  "Memo_Size","Memo_Fonte","Memo_Color","Memo_Alpha","Memo_Fond","Memo_Attribut","Memo_Copie","Memo_Fichier"
data  "MemoCalcul","MemoData","MeMO_applique_Style","MEmoChoixStyle","quite_Memo_Include","LIRE_MemoRich","$$$"
width 0,900
list 1:width 1,120:height 1,350
alpha 11:left 11,000:top 11,355:caption 11,"lecture data"
dim a$ ,l% ,a  ,b$ , c$ , swap$ , flag% ,b ,a1$,b1$
while a$ <> "$$$"
  read a$:item_add 1,a$
  if l%< len(a$) then l%=len(a$)
end_while
item_delete 1,count(1)
l%=l%*2

list 2: left 2,130:width 2,300:height 2,350 :font_name 2,"Bitstream Vera Sans Mono"
alpha 12:left 12,130:top 12,355:caption 12,"transformation"
for a = 1 to count(1)
  a$ = item_read$(1,a)  :b$=""
  for b =1 to len(a$)
      if mid$(a$,b,1) <>"_" then b$=b$ + upper$(mid$(a$,b,1))+ mid$(a$,b,1)
  next b : a$=b$
  a$ = left$(a$+ string$(l%," "),l%) + right$("  "+str$(a),3)
  item_add 2,a$
next a
sort 2

' ----
list 5:left 5,450:width 5,120: height 5,350
alpha 15:left 15,450:top 15,355:caption 15,"tri original"
for a = 1 to count(2):item_add 5,"":next a  :' on rempli les item pour pouvoir insérer à différente hauteur
for a = 1 to count(2)
  a$=item_read$(2,a)      :' on lit le data
  b = val(right$(a$,3))  :' et la position
  item_delete 5,a:item_insert 5,a, item_read$(1,b)
next a

' --------
list 6:left 6,600:width 6,120:height 6,350
alpha 16:top 16,355:left 16,600:caption 16,"list 1 + SORT 1 pour comparaison"
for a = 1 to count(1)
  item_add 6, item_read$(1,a)
next a
sort 6