Forum Liberty Basic France

Général » [Réglé] GUI Gauss Jordan tableau éditable de données, genre tableur
Visiteur
Le 11/12/2011 à 12h14

Libertynaute Inactif

Groupe: Visiteur



Bonjour,

Je n'ai pas vu de GRID dans LB.

Tant mieux si je me trompe et merci de le signaler avec les détails utiles.

Si ce composant n'existe pas "prêt à l'emploi", on pourrait certainement en bricoler un à partir d'une volée de TextBox. Y a-t-il moyen de créer un tableau de TextBox ?

Merci

Claude
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 12/12/2011 à 11h06

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Tu veux dire un truc de ce genre par exemple ?

Code VB :
'kind of grid control. tsh73 January 2009
    'Cells are selected by mouse.
    'I tried to change window to Dialog so I could use Default button
    'to trap Enter (to move in a grid), but it went plain weird - tiny font etc, so I gave up

    nomainwin
 
    WindowWidth = 420
    WindowHeight = 250
 
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)
    fontLine$ = "font courier_new 10"
    charW = 8 'have to measure that
    lineH = 16  'actually could be determined later, but needed now
    txtFieldLen = 10
    fmt$ = right$("##############.##", txtFieldLen)
 
    graphicbox #main.graphicbox1, 0, 0, 408, 235
    tb.x = 70
    tb.y = 246
    tb.w = txtFieldLen*charW + charW
    tb.h = lineH + 8
    textbox #main.textbox2, tb.x, tb.y, tb.w, tb.h
 
    open "grid thing - select by mouse" for window as #main
 
    #main, "trapclose [quit.main]"
    #main.graphicbox1 "down; fill white; flush"
    #main.graphicbox1 "when leftButtonDown [setPos]"
    #main.graphicbox1 fontLine$
    #main.textbox2 "!"+fontLine$
 
'    #main.graphicbox1 "set 0 0 "
'    #main.graphicbox1 "\"
'    #main.graphicbox1 "posxy dummy lineH"
'    print "lineH =" ,lineH
'    #main.graphicbox1 "\"+fontLine$
'    #main.graphicbox1 "\"+fontLine$

'    #main.textbox2  fontLine$ 

    cols = 4
    rows = 5
    dim arr$(cols, rows)
    dim arr(cols, rows)
 
    for j = 1 to rows
        for i = 1 to cols
            arr(i,j)=rnd(1)*1000
            arr$(i,j)=using(fmt$,arr(i,j))
        next
    next
 
    gosub [redrawGrid]
 
    MouseX = 1
    MouseY = 1
    currI=1
    currJ=1
    #main.textbox2 arr$(currI, currJ)
    gosub [setPos]
 
    wait
 
[redrawGrid]
    #main.graphicbox1 "cls"
    #main.graphicbox1 "set 0 0 "
    #main.graphicbox1 "\"
 
    for j = 1 to rows
        aString$ = ""
        for i = 1 to cols
            aString$ = aString$ + right$("                 "+trim$(arr$(i,j)), txtFieldLen)
        next
        #main.graphicbox1 "\"+aString$
    next
    #main.graphicbox1 "flush"
return
 
[setPos]
    'MouseX; " "; MouseY
    i = int(MouseX/(txtFieldLen*charW))+1
    j = int(MouseY/lineH)+1
   ' print i,j
    if i<=cols and j <=rows then
        'save old vals
        #main.textbox2 "!contents? varName$"
        isChanged = (arr$(currI, currJ) <> varName$)
        arr$(currI, currJ) = varName$
 
        tb.x = (i-1)*txtFieldLen*charW
        tb.y = (j-1)*lineH
        #main.textbox2 arr$(i,j)
        #main "refresh"
        currI=i: currJ=j
 
        if isChanged then gosub [redrawGrid]
    end if
    WAIT
 
[quit.main]
    Close #main
    END




Edité par cassiope01 Le 12/12/2011 à 15h32
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Visiteur
Le 12/12/2011 à 12h20

Libertynaute Inactif

Groupe: Visiteur



Ce genre-là, oui.
C'est un TextBox divisé en cellules éditables par des lignes et des colonnes.
Les données dans les cellules sont enregistrées dans un tableau.
A chaque modification toutes les données sont rafraîchies.
A part afficher des données et permettre leur modification, ce programme (au stade de projet inachevé) ne fait rien d'autre.

Je pense qu'on pourrait plus efficacement placer un TextBox pour chaque cellule, si possible avec les bords, c'est plus clair; à condition de faire plus petit qu'Excel bien sûr.

Si on pouvait gérer une nichée de TextBox par un tableau, ce serait peut-être assez pratique.

Sinon on prendra le temps...

Claude
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Visiteur
Le 12/12/2011 à 14h17

Libertynaute Inactif

Groupe: Visiteur



Premiers essais décourageants.

FOR i = 1 TO 11 'lignes
FOR j = 1 TO 10 'colonnes
num = i*10 + j
TextBox #w.num, x, y, w, h
NEXT j
NEXT i

Le #w.num (= i*10 + j) n'est pas accepté.
Le #w.num$ (= STR$(i) + STR$(j) ) n'est pas accepté non plus.

Je ne vois pas comment numéroter les cellules ni comment les retrouver par un calcul
sur les lignes et les colonnes.

Claude
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 12/12/2011 à 15h15

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
C'est normal.
Je crois bien qu'il n'est pas possible d'utiliser une variable dans la DECLARATION initiale des noms des Textbox et autres... en fait ce qui est avant le 'open' ...
Ensuite si.

Mais quel est ton but exactement ?



Edité par cassiope01 Le 12/12/2011 à 15h40
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Visiteur
Le 12/12/2011 à 15h34

Libertynaute Inactif

Groupe: Visiteur



Mon but est de créer un tableau de cellules où encoder facilement et sans erreur les coefficients des inconnues d'un système d'équations linéaires (+ le terme indépendant).

Je connais la recette pour la résolution-éclair de ce problème, mais je ne connais pas la méthode pour le présenter en GUI.



Edité par Visiteur Le 12/12/2011 à 15h36
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 12/12/2011 à 15h44

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Ah ! donc il n'y aurait QUE des cellules dans la GUI ?

Et aussi il te faudrait peut-être utiliser la fonction eval$(), mais qui n'existe que dans LB et pas dans JB...

Quant à numéroter les cellules et les retrouver par un calcul sur les lignes et les colonnes, c'est vraiment pas un problème...!





PS: y a ça aussi sur le forum anglophone : c'est là.



Edité par cassiope01 Le 12/12/2011 à 18h14
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Visiteur
Le 12/12/2011 à 16h56

Libertynaute Inactif

Groupe: Visiteur



Vu. Mais il s'agit là de résoudre *une* équation linéaire.

Mon objectif est de produire un GUI qui résout un *système* d'équations linéaires à n lignes et n inconnues, pas 1x1, ni 3 x 3, mais 10 x 10 par exemple
(j'ai justement un exemple que j'ai produit moi-même, et dont je connais évidemment les solutions).

Donc on pourrait identifier après déclaration les cellules par un calcul assez direct ?
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 12/12/2011 à 17h48

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
claudevdw:
Donc on pourrait identifier après déclaration les cellules par un calcul assez direct ?


À vrai dire je ne comprend pas très bien ta question !?

Les variables tableaux à 2 dimensions existe parfaitement en JB/LB !

Quant à les retrouver par calcul ligne/colonne, si tu ne veux qu'un seul chiffre pour les identifier, bien que je n'en vois par bien l'intérêt ici, ben il suffit de faire l'inverse de ce que tu as écrit toi-même plus haut par exemple...
Soit cell = 10*y+x pour un nbre de cellule < 100 bien sûr...!
puis x = cell mod 10, et y = int(cell/10)

Nul besoin d'une grande quantité de TexBox si une seule suffit à éditer la cellule visée : tu ne peux physiquement pas éditer plusieures cellules en même temps ;)
C'est donc ce que le petit programme que je t'ai indiqué fait.
Il faut juste l'esthétiser un peu plus à ta convenance.



Edité par cassiope01 Le 12/12/2011 à 18h18
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Visiteur
Le 13/12/2011 à 09h55

Libertynaute Inactif

Groupe: Visiteur



OK. Merci pour tes avis.
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 13/12/2011 à 13h47

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Je t'en prie claude :top

Par contre je m'aperçois que de customiser le code de tsh73 est plus compliqué qu'il n'y paraît, car il est vraiment très minimaliste...

Tu nous montreras ta GUI finale j'espère !? :)
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Visiteur
Le 16/12/2011 à 14h35

Libertynaute Inactif

Groupe: Visiteur



Voila ce que je veux dire.

Les TextBox sont des cellules dans lesquelles on peut entrer ce qu'on veut (ici de préférence des nombres mais on pourrait aussi en faire une saisie de base de données).
Les différentes cellules sont identifiées d'après leur ligne et leur colonne.
A la déclaration: TextBox #w.11...#w.12...etc...
A l'identification en ligne i et colonne j: var$ = "#w." + STR$(10 * i + j)
et on récupère le contenu par PRINT #var$, "!contents? n$". (uniquement en LB4)
Ici [CALC] ne fait qu'additionner les données des cellules, mais si on les transcrit dans un tableau,
n'importe quel calcul devient possible.
On navigue dans les textbox par la touche TAB ou MAJ+TAB ou la souris, et on y écrit les données que l'on veut.
CALC est le bouton par défaut (dans le DIALOG), <ENTER> exécute le calcul.
C'est simplet mais c'est une base.
Dommage que TextBox ne prenne pas de variables comme paramètres (sauf pour un seul textbox).

Claude


Code :

'GRID.BAS               LB404     16-12-2011
'========

NOMAINWIN

[WIDGETS]

TEXTBOX #w.11, 20, 20, 50, 25
TEXTBOX #w.12, 80, 20, 50, 25
TEXTBOX #w.13, 140, 20, 50, 25

TEXTBOX #w.21, 20, 50, 50, 25
TEXTBOX #w.22, 80, 50, 50, 25
TEXTBOX #w.23, 140, 50, 50, 25

BUTTON #w.RAZ, "NEW", [RAZ], UL, 20, 200, 50, 50
BUTTON #w.DEFAULT, "CALC", [CALC], UL, 100, 200, 50, 50
BUTTON #w.EXIT, "EXIT", [EXIT], UL, 180, 200, 50, 50

'dimensionner la fenêtre
WindowHeight = 300
WindowWidth = 300

'et la centrer
UpperLeftX = INT(DisplayWidth - WindowWidth) /2
UpperLeftY = INT(DisplayHeight - WindowHeight) /2

OPEN "GRID" FOR DIALOG AS #w

'focus dans la première cellule
  PRINT #w.11, "!setfocus"

WAIT

[CALC]

FOR i = 1 TO 2          'lignes
  FOR j = 1 TO 3        'colonnes

'créer un variable représentant le handle avec la numérotation des textbox
'en fonction de i (les lignes) et de j (les colonnes)
  var$ = "#w." + STR$(10*i + j)

'récupérer le contenu
  PRINT #var$, "!contents? n$"

'et l'utiliser pour quelque chose
'p ex additionner toutes les cellules
  Total = Total + VAL(n$)

  NEXT j
NEXT i

'vérifions le résultat de l'addition
  NOTICE "Total = " + STR$(Total)

WAIT

[RAZ]

Total = 0

FOR i = 1 TO 2
  FOR j = 1 TO 3
    var$ = "#w." + STR$(10 * i + j)
    PRINT #var$, ""
  NEXT j
NEXT i

PRINT #w.11, "!setfocus"

WAIT

[EXIT]

CLOSE #w
END





Edité par Visiteur Le 17/12/2011 à 08h53
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 16/12/2011 à 22h16

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 362
Tu cherches à faire le GUI d'un aglo basé sur le pivot de Gauss ?
Le premier code que t'as passé Cassiope01 à un assez bon type je trouve.
Il suffit de rajouter un bouton [+] et [-] pour rajouter/enlever une inconnue/équation. Un peu de modification et ça ne devrais pas être trop dur.
Tu peux rajouter aussi le nom des inconnues (x,y,z....) avec la forme des équations.

Je n'arrive pas à saisir ton problème ?

Cordialement
Jagang
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    
Visiteur
Le 17/12/2011 à 08h52

Libertynaute Inactif

Groupe: Visiteur



Je cherche à faire un gui pour saisir des nombres qui serviront à des calculs, et notamment Gauss-Jordan. Au lieu de le faire en mode console ou texte (ce que j'ai déjà fait).
Maintenant que je sais récupérer facilement les valeurs entrées dans les textbox et donc les verser dans un tableau, il n'y a donc plus de problème.
On peut le voir en faisant "tourner" le code que j'ai posté hier, il ne fait pas d'opération compliquée (c'est un modèle) mais il fonctionne enfin.
Par contre j'ai abandonné les textbox découpés en cellules; il y en a d'ailleurs un bel exemple sur LB Encyclopédie, dont on ne sait rien faire, de l'aveu même de l'auteur. Et l'auteur du code que casssiope01 a posté, a également abandonné (c'est dans son texte).

Bonne journée,

Claude



Edité par Visiteur Le 17/12/2011 à 08h54
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 21/12/2011 à 22h52

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
J'ai essayé de faire le GUI, un mélange du petit code de tsh73 que je t'ai proposé au début et le tien, mais pour l'instant je ne parviens pas à afficher le résultat aux cellules de la colonne 11 !?

C'est dû, je pense, à l'ordre de la première affectation des valeurs (read ... data)

Code VB :
'GAUSS-JORDAN_XL - système de 10 équations linéaires et 10 inconnues
'résolution d'un système d'équations linéaires par la méthode
'd'élimination de Gauss-Jordan.

'GUI par cassiope01 d'après les codes de tsh73 et claudevdw.  22 Déc 2011.

    nomainwin
 
    mois$ = "Jan Fév Mar Avr Mai Jun Jui Aou Sep Oct Nov Déc"
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
    jsem$ = word$("Mar Mer Jeu x Ven Sam x Dim Lun",int((j/7-int(j/7))*10)+1)
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+"   "+left$(time$(),5)'right$(today$,4)

    Global fmt$, fontLine$, txtFieldLen, dimCell.X, dimCell.Y, nCellX, nCellY, currX, currY
    fontLine$ = "font courier_new 12"
    charW = 9 'have to measure that
    lineH = 20  'actually could be determined later, but needed now
    txtFieldLen = 8
    fmt$ = right$("#############", txtFieldLen) 'right$("############.#", txtFieldLen)
    dimCell.X = 10*charW
    dimCell.Y = 30
    nCellX = 11
    nCellY = 10
    currX = 1
    currY = 1
 
    DIM info$(10,10), A(nCellX,nCellX), matrice$(nCellX,nCellX)
 
    WindowWidth = nCellX*dimCell.X+30
    WindowHeight = nCellY*dimCell.Y+120
    UpperLeftX = int((DisplayWidth-WindowWidth) / 3)
    UpperLeftY = int((DisplayHeight-WindowHeight) / 2)
    for x=1 to nCellX :titre$ = titre$ + str$(x)+space$(charW+1) :next
    statictext #g.titreX, titre$, 20+dimCell.X/2, 2, dimCell.X*nCellX, dimCell.Y/2
    statictext #g.titreY1, "1", 3, 28+(1-1)*dimCell.Y, 15, 20
    statictext #g.titreY2, "2", 3, 28+(2-1)*dimCell.Y, 15, 20
    statictext #g.titreY3, "3", 3, 28+(3-1)*dimCell.Y, 15, 20
    statictext #g.titreY4, "4", 3, 28+(4-1)*dimCell.Y, 15, 20
    statictext #g.titreY5, "5", 3, 28+(5-1)*dimCell.Y, 15, 20
    statictext #g.titreY6, "6", 3, 28+(6-1)*dimCell.Y, 15, 20
    statictext #g.titreY7, "7", 3, 28+(7-1)*dimCell.Y, 15, 20
    statictext #g.titreY8, "8", 3, 28+(8-1)*dimCell.Y, 15, 20
    statictext #g.titreY9, "9", 3, 28+(9-1)*dimCell.Y, 15, 20
    statictext #g.titreY10, "10", 3, 28+(10-1)*dimCell.Y, 15, 20
   ' for y=1 to nCellY
   '     ty$ = "#g.titreY";str$(y)
   '     statictext #ty$, str$(y), 3, 28+(y-1)*dimCell.Y, 15, 20    'ne fonctionne pas.
   ' next
    graphicbox #g.tableau, 20, 20, nCellX*dimCell.X+2, nCellY*dimCell.Y+2
    tb.x = 22+(currX-1)*dimCell.X
    tb.y = 22+(currY-1)*dimCell.Y
    tb.w = txtFieldLen*charW + charW + 7
    tb.h = lineH + 8
    textbox #g.textbox2, tb.x, tb.y, tb.w, tb.h
    statictext #g.mess "message : ", 20, 28+(12-1)*dimCell.Y, (nCellX-3)*dimCell.X, 30
    BUTTON #g.reset, " Reset ", setMatrice, UL, (nCellX-2)*dimCell.X, (13-1)*dimCell.Y
    BUTTON #g.calcul, "  CALCUL  ", [calcul], UL, (nCellX-1)*dimCell.X, (13-1)*dimCell.Y
    OPEN "    Gauss Jordan..."+space$(20)+date$ for window_nf as #g  ''graphics_nf_nsb
    #g "trapclose quit"
    #g "font courier_new 10"
    #g.tableau "down"
    #g.tableau fontLine$
    #g.textbox2 "!";fontLine$
 
    call Grille
    call setMatrice "#g.tableau"
    call message "Cellule ";currY;",";currX;"    ATTENTION : pour valider une cellule sélectionnez en une autre."
 
    #g.tableau "setfocus"
    #g.tableau "when leftButtonDown [setPos]"
    #g.tableau "when characterInput [Touche]"
 
    WAIT
 
    sub setMatrice handle$
        '"Matrice des coefficients et des termes independants:"
        restore
        DATA   1, -1,  2, -1,  1,  1, -1,  1, -1,  1,  -33
        DATA   3,  2,  1,  1, -1, -1,  2, -1,  1, -2,   60
        DATA   2, -3, -2, -2, -3, -2, -3,  2, -3,  3,  -88
        DATA   4, -1, -3,  3,  2,  4,  1, -2,  3,  4,    7
        DATA  -6,  5, -1,  4, -6, -3, -2,  3,  2, -3,   23
        DATA  -5,  1,  1,  1,  1,  1,  3, -3, -2, -4,   43
        DATA   1,  1,  1,  1,  1,  1,  4,  4,  4,  1,   21
        DATA  -2, -2, -3, -4, -5,  6,  7, -8, -5,  1,   29
        DATA   1,  1,  1, -2, -2, -2,  3,  3,  3, -2,   53
        DATA   2, -2,  3,  4, -5,  6, -7,  8, -3,  2, -170
        n = 10
        FOR i = 1 TO n
            FOR j = 1 TO n + 1
                READ m
                A(i, j) = m   '<--  !?!?!?
               ' print m,
            NEXT
            'print
        NEXT
        call redrawGrid
        call message "Cellule ";currY;",";currX;"    ATTENTION : pour valider une cellule sélectionnez en une autre."
    end sub
 
    [calcul]
        '---vérifier s'il n'y a pas de zéro sur la diagonale des coefficients,
        '--- sinon problème insoluble
        n = 10
        FOR i = 1 TO n
            IF A(i,i) = 0 THEN call message "Un coefficient diagonal nul, cas insoluble" :wait
        NEXT i
 
        '---Calcul (en 17 instructions)
        '---(i  et  k  indices de lignes,  j  indice des colonnes)

        t1 = TIME$("ms")
 
        '---réduire chaque pivot diagonal A(i,i) à 1  en divisant toute la ligne par A(i,i)
        FOR i = 1 TO n
            p = A(i, i)   'c'est le "pivot" de Gauss, sur la diagonale principale des coefficients
            FOR j = 1 TO n + 1
                q = A(i, j)
                A(i, j) = q / p
            NEXT j
 
            'combiner la ligne i avec toutes les autres lignes (donc sauf si  k = i)
            'en soustrayant de la ligne k, la ligne i multipliée par le coefficient de X(i)
            ' à la ligne k, càd A(k,i) ;
            '  la ligne i reste intacte.

            FOR k = 1 TO n
                p = A(k, i)
                IF k <> i THEN
                    FOR j = 1 TO n + 1
                        q = A(i, j)
                        r = A(k, j)
                        A(k, j) = r - p*q
                    NEXT j
                END IF
            NEXT k
        NEXT i
 
        'NB: éviter de diviser ou de multiplier les A(i,j) / A(m,n) ou A(i,j) * A(m,n),
        '       résultats aberrants surtout avec des décimales et deux dimensions

        t2 = TIME$("ms")
 
        '--- *** Fin du calcul *** --- voyons la matrice-résultat

        '[MATRCE_RESULTAT]

        'PRINT "Apres transformation de Gauss-Jordan :" : PRINT

       ' FOR i = 1 TO n
       '     FOR j= 1 TO n+1
       '         PRINT A(i, j),
       '     NEXT
       '     PRINT
       ' NEXT

        call redrawGrid
 
        '[RESULTAT_FINAL]

        '---Afficher les valeurs des inconnues      'x(i) = A(i, n+1)
        '---Il y a une complication à l'affichage parce que les nombres entiers
        '---sont transformés par LB en 'float' en cours de calcul,
        '---par les divisions répétées je suppose, et affichent 1.0 au lieu de 1
        '---Les corrections meilleures conduisent à des résultats erronés.

        'call message "Solutions des 10 équations à 10 inconnues:"
        'PRINT
        'FOR i = 1 TO n
        '    x = A(i, n+1)
        '    x$ = STR$(x)
        '    IF RIGHT$(x$, 2) = ".0" THEN
        '        PRINT "x"; STR$(i); " = ", USING("#####", x)
        '    ELSE
        '        PRINT "x"; STR$(i); " = ", x
        '    END IF
        'NEXT i
        'PRINT

        call message "Solutions des 10 équations à 10 inconnues -> temps de calcul = "; t2 - t1; " millisecondes"
    WAIT
 
    [setPos]
        x = int(MouseX/(tb.w+1))+1
        y = int(MouseY/(tb.h+2))+1
        if x <= nCellX and y <= nCellY then
            #g.textbox2 "!contents? varName$"
            isChanged = (matrice$(currY, currX) <> varName$)
            A(currY, currX) = val(varName$)
            matrice$(currY, currX) = using(fmt$,A(currY, currX))
            tb.x = 22+(x-1)*dimCell.X
            tb.y = 22+(y-1)*dimCell.Y
            #g.textbox2 matrice$(y,x)
            #g "refresh"
            currX = x :currY = y
            if isChanged then call redrawGrid
        end if
        call message "Cellule ";currY;",";currX;"    ATTENTION : pour valider une cellule sélectionnez en une autre."
    WAIT
 
    [Touche]
        key$ = left$(Inkey$,2)   'Shift = 4,  Ctrl = 8,  Alt = 16
        select case
        case key$=chr$(0)+chr$(_VK_UP)    :currY = currY - 1 +1*(currY=1)
        case key$=chr$(0)+chr$(_VK_DOWN)  :currY = currY + 1 -1*(currY=nCellY)
        case key$=chr$(0)+chr$(_VK_RIGHT) :currX = currX + 1 -1*(currX=nCellX)
        case key$=chr$(0)+chr$(_VK_LEFT)  :currX = currX - 1 +1*(currX=1)
       ' case key$=chr$(0)+chr$(13) :#g.textbox2 "!setfocus"   'Entrée
       ' case instr("0123456789",key$)>0 :#g.textbox2 "!setfocus"  'Pav Num
        end select
        tb.x = 22+(currX-1)*dimCell.X
        tb.y = 22+(currY-1)*dimCell.Y
        #g.textbox2 matrice$(currY, currX)
        #g "refresh"
        call message "Cellule ";currY;",";currX;"    ATTENTION : pour valider une cellule sélectionnez en une autre."
    WAIT
 
    sub redrawGrid
        for y = 1 to nCellY   'lignes
            for x = 1 to nCellX     'colonnes
                #g.tableau "place ";(x-1)*dimCell.X+2;" ";y*dimCell.Y-8
                matrice$(y,x) = using(fmt$,A(y,x))
                #g.tableau "\";right$("                 "+trim$(matrice$(y,x)), txtFieldLen)
            next
        next
        #g.textbox2 matrice$(currY,currX)
        #g.tableau "flush; discard"
    end sub
 
    sub message mess$
        #g.mess "message : ";mess$
    end sub
 
    sub Grille
        #g.tableau "color lightgray"
        for cy = 1 to nCellY
            for cx = 1 to nCellX
                #g.tableau "place ";(cx-1)*dimCell.X;" ";(cy-1)*dimCell.Y
                #g.tableau "box ";(cx-1)*dimCell.X+dimCell.X;" ";(cy-1)*dimCell.Y+dimCell.Y
            next
        next
        #g.tableau "color black"
    end sub
 
    sub quit handle$
        close #handle$
        END
    end sub




Edité par cassiope01 Le 22/12/2011 à 11h20
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Visiteur
Le 22/12/2011 à 12h31

Libertynaute Inactif

Groupe: Visiteur



Ca fonctionne ! C'est extra !

J'avais laissé un message ce jeudi vers 9 heures, mais il a disparu.

Je pensais que peut-être les données de la dernière colonne n'avaient peut-être pas été enregistrées dans A( ). Qu'est-ce que c'était finalement ?

(s) Le Libertynaute Timide



Edité par Visiteur Le 22/12/2011 à 12h32
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 22/12/2011 à 19h56

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Je suis content que ça te plaise ;)

Le pb était juste que dans ton code, tu adresses tout en lignes,colonnes et moi j'ai plutôt l'habitude d'adresser comme les coordonnées graphiques en JB ou autre c'est à dire x,y (donc colonnes,lignes) ... !!
Bref je me suis beaucoup mélangé les pinceaux avec ça...!

Ah, et aussi, malheureusement en JB les flêches (touches) ne permettent pas de sortir d'un TEXTBOX, ce qui m'empêche de mettre #g.textbox2 "!setfocus" juste avant #g.textbox2 "!contents? varName$" dans [setPos] si je veux pouvoir utiliser les flêches pour me déplacer dans le tableau...
Et je peste aussi contre le fait que JB n'accepte pas d'utiliser des variables pour déclarer les noms des TEXTBOX et autre trucs de ce genre... ( je l'ai écrit dans le code d'ailleur :( )

Bon, le seul pb, c'est que ce code n'est pas du tout universel... je veux dire par là que ce n'est pas du tout un mini Excel.
Il ne fait QUE ce que tu voulais...!
Mais c'est une base sympa qui peut être facilement modifiable pour faire autre chose... ;)

@+


PS: Ah mais j'avais pas vu que tu avais aussi écrit le tien en version GUI !!! Si tu veux une adaptation de ma version pour charger des exercices via des petits fichiers de données par exemple : dis moi le.
Tu vois maintenant qu'un seul TEXTBOX suffisait :siffle
Mais tu m'as appris que JB avait cette limite de 100 TEXTBOX !!



Edité par cassiope01 Le 23/12/2011 à 09h06
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 23/12/2011 à 11h48

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Code revu et corrigé pour:
- accepter les nombres à virgule ( 5 décimales à décider ? ) en respectant le format d'affichage dont tu parlais ICI.
- pouvoir charger des petits fichiers de données à fabriquer... au format *.txt pur avec les nombres séparés par ; sans espaces.

ex:
2.36;0.2;3.56;-4.12;3.56;-8.90412
-2.4;-0.6;1.45;0.458;-0.21;-4.08403
0.24;0.65;-0.36;-2.5;4.25;-4.57245
3.41;0.23;1.2;-1.3;-1.6;1.3887
0.36;-1.69;0.56;-3.45;-6.24;-9.77202

ou

1;2;3;-4;-4.99
-2;-1;1;1;-3.08
1;1;-1;-2;-0.32
3;3;2;-3;2.49

ou

1;-1;2;-1;1;1;-1;1;-1;1;-33
3;2;1;1;-1;-1;2;-1;1;-2;60
2;-3;-2;-2;-3;-2;-3;2;-3;3;-88
4;-1;-3;3;2;4;1;-2;3;4;7
-6;5;-1;4;-6;-3;-2;3;2;-3;23
-5;1;1;1;1;1;3;-3;-2;-4;43
1;1;1;1;1;1;4;4;4;1;21
-2;-2;-3;-4;-5;6;7;-8;-5;1;29
1;1;1;-2;-2;-2;3;3;3;-2;53
2;-2;3;4;-5;6;-7;8;-3;2;-170

Note: en JB la commande val() ne sait interpréter que le "." comme séparateur de décimales... donc ne pas écrire 8,56 par exemple mais 8.56

@+

Code VB :
'GAUSS-JORDAN_XL - système de 10 équations linéaires et 10 inconnues
'résolution d'un système d'équations linéaires par la méthode
'd'élimination de Gauss-Jordan.

'GUI par cassiope01 d'après les codes de tsh73 et claudevdw.  22 Déc 2011.

    nomainwin
 
    mois$ = "Jan Fév Mar Avr Mai Jun Jui Aou Sep Oct Nov Déc"
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
    jsem$ = word$("Mar Mer Jeu x Ven Sam x Dim Lun",int((j/7-int(j/7))*10)+1)
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+"   "+left$(time$(),5)'right$(today$,4)

    Global fmt$, fontLine$, txtFieldLen, dimCell.X, dimCell.Y, nCellX, nCellY, currX, currY, tb.x, tb.y, tb.w, tb.h
    fontLine$ = "font courier_new 12"
    charW = 9 'have to measure that
    lineH = 20  'actually could be determined later, but needed now
    txtFieldLen = 8
    dimCell.X = 10*charW
    dimCell.Y = 30
    nCellY = 10
    nCellX = nCellY + 1
    currX = 1
    currY = 1
 
    DIM info$(10,10), A(nCellX,nCellX), matrice$(nCellX,nCellX)
 
    WindowWidth = nCellX*dimCell.X+30
    WindowHeight = nCellY*dimCell.Y+120
    UpperLeftX = int((DisplayWidth-WindowWidth) / 3)
    UpperLeftY = int((DisplayHeight-WindowHeight) / 2)
    for x=1 to nCellX :titre$ = titre$ + str$(x)+space$(charW+1) :next
    statictext #g.titreX, titre$, 20+dimCell.X/2, 2, dimCell.X*nCellX, dimCell.Y/2
    statictext #g.titreY1, "1", 3, 28+(1-1)*dimCell.Y, 15, 20
    statictext #g.titreY2, "2", 3, 28+(2-1)*dimCell.Y, 15, 20
    statictext #g.titreY3, "3", 3, 28+(3-1)*dimCell.Y, 15, 20
    statictext #g.titreY4, "4", 3, 28+(4-1)*dimCell.Y, 15, 20
    statictext #g.titreY5, "5", 3, 28+(5-1)*dimCell.Y, 15, 20
    statictext #g.titreY6, "6", 3, 28+(6-1)*dimCell.Y, 15, 20
    statictext #g.titreY7, "7", 3, 28+(7-1)*dimCell.Y, 15, 20
    statictext #g.titreY8, "8", 3, 28+(8-1)*dimCell.Y, 15, 20
    statictext #g.titreY9, "9", 3, 28+(9-1)*dimCell.Y, 15, 20
    statictext #g.titreY10, "10", 3, 28+(10-1)*dimCell.Y, 15, 20
   ' for y=1 to nCellY
   '     ty$ = "#g.titreY";str$(y)
   '     statictext #ty$, str$(y), 3, 28+(y-1)*dimCell.Y, 15, 20    'malheureusement pas accepté par JB.
   ' next
    graphicbox #g.tableau, 20, 20, nCellX*dimCell.X+2, nCellY*dimCell.Y+2
    tb.x = 22+(currX-1)*dimCell.X
    tb.y = 22+(currY-1)*dimCell.Y
    tb.w = txtFieldLen*charW + charW + 7
    tb.h = lineH + 8
    textbox #g.textbox2, tb.x, tb.y, tb.w, tb.h
    statictext #g.mess "message : ", 20, 28+(12-1)*dimCell.Y, 8*dimCell.X, 30
    BUTTON #g.reset, " Reset ", Charge, UL, (nCellX-2)*dimCell.X, (13-1)*dimCell.Y
    BUTTON #g.calcul, "  CALCUL  ", [calcul], UL, (nCellX-1)*dimCell.X, (13-1)*dimCell.Y
    OPEN "    Gauss Jordan..."+space$(20)+date$ for window_nf as #g  ''graphics_nf_nsb
    #g "trapclose quit"
    #g "font courier_new 10"
    #g.tableau "down"
    #g.tableau fontLine$
    #g.textbox2 "!";fontLine$
 
    call Grille
    call setMatrice "#g.tableau"
    call message "Cellule ";currY;",";currX;chr$(13);"ATTENTION : pour valider une cellule sélectionnez en une autre."
 
    #g.tableau "setfocus"
    #g.tableau "when leftButtonDown [setPos]"
    #g.tableau "when characterInput [Touche]"
 
    WAIT
 
    sub setMatrice handle$
        '"Matrice des coefficients et des termes independants:"
        restore
        DATA   1, -1,  2, -1,  1,  1, -1,  1, -1,  1,  -33
        DATA   3,  2,  1,  1, -1, -1,  2, -1,  1, -2,   60
        DATA   2, -3, -2, -2, -3, -2, -3,  2, -3,  3,  -88
        DATA   4, -1, -3,  3,  2,  4,  1, -2,  3,  4,    7
        DATA  -6,  5, -1,  4, -6, -3, -2,  3,  2, -3,   23
        DATA  -5,  1,  1,  1,  1,  1,  3, -3, -2, -4,   43
        DATA   1,  1,  1,  1,  1,  1,  4,  4,  4,  1,   21
        DATA  -2, -2, -3, -4, -5,  6,  7, -8, -5,  1,   29
        DATA   1,  1,  1, -2, -2, -2,  3,  3,  3, -2,   53
        DATA   2, -2,  3,  4, -5,  6, -7,  8, -3,  2, -170
        FOR i = 1 TO nCellY
            FOR j = 1 TO nCellY + 1
                READ m
                A(i, j) = m   '<--  !?!?!?
               ' print m,
            NEXT
            'print
        NEXT
        call redrawGrid
        call message "Cellule ";currY;",";currX;chr$(13);"ATTENTION : pour valider une cellule sélectionnez en une autre."
    end sub
 
    [calcul]
        '---vérifier s'il n'y a pas de zéro sur la diagonale des coefficients,
        '--- sinon problème insoluble

        FOR i = 1 TO nCellY
            IF A(i,i) = 0 THEN call message "Un coefficient diagonal nul, cas insoluble" :wait
        NEXT i
 
        '---Calcul (en 17 instructions)
        '---(i  et  k  indices de lignes,  j  indice des colonnes)

        t1 = TIME$("ms")
 
        '---réduire chaque pivot diagonal A(i,i) à 1  en divisant toute la ligne par A(i,i)
        FOR i = 1 TO nCellY
            p = A(i, i)   'c'est le "pivot" de Gauss, sur la diagonale principale des coefficients
            FOR j = 1 TO nCellY + 1
                q = A(i, j)
                A(i, j) = q / p
            NEXT j
 
            'combiner la ligne i avec toutes les autres lignes (donc sauf si  k = i)
            'en soustrayant de la ligne k, la ligne i multipliée par le coefficient de X(i)
            ' à la ligne k, càd A(k,i) ;
            '  la ligne i reste intacte.

            FOR k = 1 TO nCellY
                p = A(k, i)
                IF k <> i THEN
                    FOR j = 1 TO nCellY + 1
                        q = A(i, j)
                        r = A(k, j)
                        A(k, j) = r - p*q
                    NEXT j
                END IF
            NEXT k
        NEXT i
 
        'NB: éviter de diviser ou de multiplier les A(i,j) / A(m,n) ou A(i,j) * A(m,n),
        '       résultats aberrants surtout avec des décimales et deux dimensions

        t2 = TIME$("ms")
 
        '--- *** Fin du calcul *** --- voyons la matrice-résultat

        '[MATRCE_RESULTAT]

        'PRINT "Apres transformation de Gauss-Jordan :" : PRINT

       ' FOR i = 1 TO n
       '     FOR j= 1 TO n+1
       '         PRINT A(i, j),
       '     NEXT
       '     PRINT
       ' NEXT

        call redrawGrid
 
        '[RESULTAT_FINAL]

        '---Afficher les valeurs des inconnues      'x(i) = A(i, n+1)
        '---Il y a une complication à l'affichage parce que les nombres entiers
        '---sont transformés par LB en 'float' en cours de calcul,
        '---par les divisions répétées je suppose, et affichent 1.0 au lieu de 1
        '---Les corrections meilleures conduisent à des résultats erronés.

        'call message "Solutions des 10 équations à 10 inconnues:"
        'PRINT
        'FOR i = 1 TO n
        '    x = A(i, n+1)
        '    x$ = STR$(x)
        '    IF RIGHT$(x$, 2) = ".0" THEN
        '        PRINT "x"; STR$(i); " = ", USING("#####", x)
        '    ELSE
        '        PRINT "x"; STR$(i); " = ", x
        '    END IF
        'NEXT i
        'PRINT

        call message "Solutions des 10 équations à 10 inconnues -> temps de calcul = "; t2 - t1; " millisecondes"
    WAIT
 
    [setPos]
        x = int(MouseX/(tb.w+1))+1
        y = int(MouseY/(tb.h+2))+1
        if x <= nCellX and y <= nCellY then
           ' #g.textbox2 "!setfocus"
            #g.textbox2 "!contents? varName$"
            isChanged = (val(matrice$(currY, currX)) <> val(varName$))
            A(currY, currX) = val(varName$)
            fmt$ = format$(A(currY, currX))
            matrice$(currY, currX) = using(fmt$,A(currY, currX))
            tb.x = 22+(x-1)*dimCell.X
            tb.y = 22+(y-1)*dimCell.Y
            #g.textbox2 matrice$(y, x)
            #g "refresh"
            currX = x :currY = y
            if isChanged then call redrawGrid
        end if
        call message "Cellule ";currY;",";currX;chr$(13);"ATTENTION : pour valider une cellule sélectionnez en une autre."
    WAIT
 
    [Touche]
        key$ = left$(Inkey$,2)   'Shift = 4,  Ctrl = 8,  Alt = 16
        select case
        case key$=chr$(0)+chr$(_VK_UP)    :currY = currY - 1 +1*(currY=1)
        case key$=chr$(0)+chr$(_VK_DOWN)  :currY = currY + 1 -1*(currY=nCellY)
        case key$=chr$(0)+chr$(_VK_RIGHT) :currX = currX + 1 -1*(currX=nCellX)
        case key$=chr$(0)+chr$(_VK_LEFT)  :currX = currX - 1 +1*(currX=1)
       ' case key$=chr$(0)+chr$(13) :#g.textbox2 "!setfocus"   'Entrée
       ' case instr("0123456789",key$)>0 :#g.textbox2 "!setfocus"  'Pav Num
        end select
        tb.x = 22+(currX-1)*dimCell.X
        tb.y = 22+(currY-1)*dimCell.Y
        #g.textbox2 matrice$(currY, currX)
        #g "refresh"
        call message "Cellule ";currY;",";currX;chr$(13);"ATTENTION : pour valider une cellule sélectionnez en une autre."
    WAIT
 
    sub redrawGrid
        for y = 1 to nCellY   'lignes
            for x = 1 to nCellX     'colonnes
                #g.tableau "place ";(x-1)*dimCell.X+2;" ";y*dimCell.Y-8
                fmt$ = format$(A(y, x))
                matrice$(y,x) = using(fmt$,A(y,x))
                #g.tableau "\";right$("                 "+trim$(matrice$(y,x)), txtFieldLen)
            next
        next
        #g.textbox2 matrice$(currY,currX)
        #g.tableau "flush; discard"
    end sub
 
    function format$(value)  'formatage de l'affichage des nombres dans les cellules...
        format$ = "#############"
        if value <> 0 then
            p = instr(str$(value),".")
            if p > 0 then
                for c = 1 to p-1 :format$ = format$+"#" :next
                format$ = format$ + "."
                decimal = len(str$(value))-p
                if decimal > 5 then decimal = 5    ' <-- nombre de décimales acceptées après la virgule: à décider.
                for c = 1 to decimal :format$ = format$+"#" :next
            end if
        end if
        format$ = right$(format$, txtFieldLen)
    end function
 
    sub message mess$
        #g.mess "message : ";mess$
    end sub
 
    sub Grille
        #g.tableau "color lightgray"
        for cy = 1 to nCellY
            for cx = 1 to nCellX
                #g.tableau "place ";(cx-1)*dimCell.X;" ";(cy-1)*dimCell.Y
                #g.tableau "box ";(cx-1)*dimCell.X+dimCell.X;" ";(cy-1)*dimCell.Y+dimCell.Y
            next
        next
        #g.tableau "color black"
    end sub
 
    SUB Charge handle$
        filedialog "Fichiers de données", "*.txt", fileName$
        if fileName$ <> "" then
            open fileName$ for input as #show
            while eof(#show) = 0 and ligne < 10
                line input #show, ln$
                ligne = ligne + 1
                tb$(ligne) = ln$
            wend
            close #show
            redim A(11,11)
            nCellY = ligne :nCellX = nCellY+1
            FOR i = 1 TO nCellY
                FOR j = 1 TO nCellY + 1
                    A(i, j) = val(word$(tb$(i),j,";"))
                NEXT
            NEXT
            currX = 1
            currY = 1
            tb.x = 22+(currX-1)*dimCell.X
            tb.y = 22+(currY-1)*dimCell.Y
            #g "refresh"
            call redrawGrid
            call message "Cellule ";currY;",";currX;chr$(13);"ATTENTION : pour valider une cellule sélectionnez en une autre."
        end if
    end sub
 
    sub quit handle$
        close #handle$
        END
    end sub




Edité par cassiope01 Le 23/12/2011 à 15h36
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Général » [Réglé] GUI Gauss Jordan tableau éditable de données, genre tableur  

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie