FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Gestionnaire de Projets Panoramic
par Minibug Aujourd'hui à 2:10

» Mah-Jong européen new-look
par jjn4 Hier à 16:35

» Button_picture
par pascal10000 Hier à 11:41

» Pourquoi le compilateur stagne
par Minibug Hier à 11:09

» 4 (en analyse): SYNEDIT_TARGET_IS_OBJECT devient inactif
par Jack Hier à 10:09

» 3 (en analyse): Mauvaise interprétation du string "THEN"
par Jack Hier à 10:03

» KGF.dll - demandes ou suggestions de modifications ou ajouts
par Marc Hier à 10:00

» KGF_dll - nouvelles versions
par pascal10000 Mer 13 Déc 2017 - 17:27

» track_bar circulaire
par Klaus Mar 12 Déc 2017 - 13:54

» API Windows
par Klaus Mar 12 Déc 2017 - 3:21

» Cartes de voeux, menus, etc.
par JL35 Lun 11 Déc 2017 - 17:48

» a l'aide klaus
par Minibug Lun 11 Déc 2017 - 11:42

» bug SYNEDIT_TARGET_IS_OBJECT
par Jack Lun 11 Déc 2017 - 0:16

» Jukebox : Serge Reggiani
par papydall Sam 9 Déc 2017 - 5:58

» Ecouter la radio fm sur votre pc
par pascal10000 Sam 9 Déc 2017 - 3:42

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Décembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
25262728293031
CalendrierCalendrier

Partagez | 
 

 [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
papydall

avatar

Nombre de messages : 5613
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Dim 24 Avr 2016 - 19:48

Salut tout le monde

J’ai adapté un code Delphi en Panoramic.
J’ai testé le code sous Delphi : il  tourne correctement, No problem.
Mon adaptation en Panoramic tourne souvent correctement mais parfois le code se comporte d’une façon bizarre.
Le jeu de Ouest comporte une anomalie et toujours sur la même carte : la Dame de pique peut se trouver en double ou en mauvaise position !
Parfois aussi, ça me gratifie d’un message de mauvais goût :
(30) Array index overflow or underflow. Line : 153

J’ai vérifié et vérifié mon code, mais mes yeux et mes neurones refusaient de voir d’où venait l’erreur.
Je soumets à votre sagacité  mon code Panoramic et le code source Delphi.
Une tête plus calme que la mienne, des yeux moins fatigués que j'en possède et surtout une matière grise beaucoup bien meilleure que ce que j'ai dans le crâne, peuvent comprende ce que je n'arrive pas à saisir.  

NB : le code utilise cards.dll que vous  pouvez télécharger à partir de mon Webdav.

Code Panoramic:
Code:

rem ============================================================================
rem            Tirage de jeu de carte style bridge
rem          Code original en Delphi par Yves Manuel
rem            Adaptation en Panoramic par Papydall
rem ============================================================================
' Description :
' =============
' Ce programme tire et affiche quatre jeux de treize cartes (style bridge),
' mais il est facilement adaptable à tout jeu se jouant avec des cartes françaises.
' Pour certains jeux il serait nécessaire de modifier les options de tri,
' l'ordre des cartes n'étant pas pour tous les jeux le même.
' (L'ordre dans ce programme est de l'As au 2).
' Il utilise "cards.dll" : ' Si vous ne disposez pas de cette dll, vous pouvez
' la télécharger à partir de mon bebdav
rem ============================================================================
label clic
dim i,hdc%,w%,h%,cdw,cdh,posX,posY,nbc,card,ret%
dim donne(13,4) : ' les quatre jeux triés

width 0,800 : height 0,600
top 0,(screen_y - height(0))/2 : left 0,(screen_x - width(0))/2
application_title "Tirage de jeu de carte style bridge"

main_menu 10
    sub_menu 11    : parent 11,10    : caption 11 ,"Tirage"
    sub_menu 12    : parent 12,11    : caption 12, "Aléatoire"
       sub_menu 13 : parent 13,12    : caption 13, "Votre jeu"
       sub_menu 14 : parent 14,12    : caption 14, "Les quatre jeux"
    sub_menu 15    : parent 15,11    : caption 15, "Quitter"
    sub_menu 16    : parent 16,10    : caption 16, "Infos"
for i = 11 to 16   : on_click i,clic : next i
dll_on "cards"     : ' Si vous ne disposez pas de "cards.dll", vous pouvez la télécharger sur mon bebdav

END
rem ============================================================================
Clic:
    select number_click
        case 13 : Votre_Jeu()
        case 14 : Les_4_Jeux()
        case 15 : Quitter()
        case 16 : Infos()
    end_select
return
rem ============================================================================
SUB Votre_Jeu()
    dim_local x
    Tirage()   : ' Appel de la procédure
    posX = 205 : ' Ordonnée x de l'affichage
    posY = 148 : ' Ordonnée y de l'aafichage
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))

    for x = 1 to 13
        card = donne(x,1)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0) : ' Affiche votre jeu
        posX = posX + 20
    next x
END_SUB
rem ============================================================================
SUB Tirage()
    dim_local bb$,r$
    dim_local a,b,c,i,ip,ic,ik,it,j,jj,t,x,y,s
    dim_local trg(13,4), pq(13),cr(13),ka(13),tr(13) : ' des tableaux temporaires

    r$ = "123456789ABCD" : ' variable représentant 13 cartes
    r$ = r$+r$+r$+r$+"0" : ' variable d'un jeu de 52 cartes plus un caractère de contrôle pour éviter les doublons

    for j = 1 to 4       : ' Tirage des quatre jeux
        for i  = 1 to 13
            x = 53
            while mid$(r$,x,1) = "0" : ' Tant que la chaîne r$ n'est pas remplie de 0
                  x = int(rnd(53)+1) : ' on tire un nombre entre 1 et 53
            end_while

            s = Int((x-1)/13)        : ' on calcule la couleur de la carte P=0,C=1,K=2,T=3
            y  = s*13                : ' y = 0,13,26,39, fin de chaque couleur
            bb$ = Mid$(r$,x,1)       : ' le numéro tiré
            jj  =  hex(bb$) + y      : ' le nombre est hexa et convertit en entier
            trg(i,j) = (jj-1)        : ' Dans le tab temporaire, la carte
            r$ =  left$(r$,x-1) + "0" + right$(r$,len(r$)-x) : ' on remplace par 0 dans la chaîne pour ne pas avoir de doublon
        next i

    next j

' Par securité on initialise les 4 tableaux temporaires avec des valeurs impossibles
    for a = 1 to 13
        pq(a) = 99 : cr(a) = 99 : ka(a) = 99 : tr(a) = 99
    next a

    for j = 1 to 4 : ' Les 4 jeux
        ip = 0 : ic = 0 : ik = 0 : it = 0 : ' Compteurs pour les 4 couleurs
        for i = 1 to 13                   : ' Chaque jeu
            x = trg(i,j)                  : ' chaque carte
            select mod(x,4)               : ' Calcule la couleur
                 case 0                   : ' Trèfles
                     if x = 0 then x = 53 : ' L'as est la plus forte carte
                     it = it + 1 : tr(it) = x
                 case 1                   : ' Carreaux
                     if x = 1 then x = 54
                     ik = ik + 1 : ka(ik) = x
                 case 2                   : ' Coeurs
                     if x = 2 then x = 55
                     ic = ic + 1 : cr(ic) = x
                 case 3                   : ' Piques
                     if x = 3 then x = 56
                     ip = ip + 1 : pq(ip) = x
            end_select
        next i

' Typique tri à bulle. Peu de données à trier

        for a = 1 to ip-1 : ' On trie les piques
            for b = a+1 to ip
                if pq(a) < pq(b) then t = pq(a) :  pq(a) = pq(b) : pq(b) = t
            next b
        next a

       for a = 1 to ic-1 : ' On trie les coeurs
           for b = a+1 to ic
                if cr(a) < cr(b) then t = cr(a) : cr(a) = cr(b) : cr(b) = t
           next b
       next a
       for a = 1 to ik-1 : ' On trie les carreaux

          for b = a+1 to ik
             if ka(a) < ka(b) then t = ka(a) : ka(a) = ka(b) : ka(b) = t
          next b
        next a
        for a = 1 to it-1

           for b = a+1 to it : ' On trie les trèfles
              if tr(a) < tr(b) then t = tr(a) : tr(a) = tr(b) : tr(b) = t
           next b
        next a

' On rétablit les as pour leur valeur réelle pour l'affichage et on remplit le
' tableau définitif pour la donne
        for a = 1 to ip
            if pq(a) = 56 then pq(a) = 3
            donne(a,j) = pq(a)
        next a
        for a = 1 to ic
            if cr(a) = 55 then cr(a) = 2
            donne(a+ip,j) = cr(a)
        next a
        for a = 1 to ik
            if ka(a) = 54 then ka(a) = 1
            donne(a+ip+ic,j) = ka(a)
        next a
        for a = 1 to it
            if tr(a) = 53 then tr(a) = 0
            donne(a+ip+ic+ik,j) = tr(a)
        next a
    next j

' C'est fini! donne contient les quatre jeux

END_SUB
rem ============================================================================
SUB Les_4_Jeux()
    dim_local x
    Tirage()
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))
    
' Ouest
    posX = 10 : posY = 198 +50
    for x = 1 to 13
       card = donne(x,1)
       ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
       posX = posX+18
    next x

' Nord
    posX = 215 : posY = 18
    for x = 1 to 13
        card = donne(x,2)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
        posX = posX+18
    next x
' Est
   posX = 485 : posY = 198+50
   for x = 1 to 13
       card = donne(x,3)
       ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
       posX = posX+18
    next x
' Sud
    posX = 215 : posY = 400
    for x = 1 to 13
        card = donne(x,4)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
        posX = posX+18
    next x

END_SUB
rem ============================================================================
SUB Infos()
    dim_local t$
    t$ = "=======================================" + chr$(13)
    t$ = t$ +"Tirage de jeu de carte style bridge" + chr$(13)
    t$ = t$ + "=======================================" + chr$(13)
    t$ = t$ + "Code d'origine en Delphi" + chr$(13)
    t$ = t$ + "Auteur  : Yves Manuel" + chr$(13)
    t$ = t$ + "Date      : 03/08/2013" + chr$(13)
    t$ = t$ + "=======================================" + chr$(13)
    t$ = t$ + "Adaptation en Panoramic" + chr$(13)
    t$ = t$ + "Auteur  : Par Papydall" + chr$(13)
    t$ = t$ + "Date      : 24/04/2016" + chr$(13)
    t$ = t$ + "======================================="
    message t$
END_SUB
rem ============================================================================
SUB Quitter()
    dim_local ret%,hWnd
    dll_off
    hWnd = handle(0)
    dll_on "user32"
    ret% = dll_call4("PostMessageA",hWnd,16,0,0) : ' 16 c'est la constante de fermeture
END_SUB
rem ============================================================================

ça donne ça:
 

Code Delphi:

Code:

rem ============================================================================
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StrUtils, StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    irage1: TMenuItem;
    Alatoire1: TMenuItem;
    N1: TMenuItem;
    Quitter1: TMenuItem;
    Votrejeu1: TMenuItem;
    Lesquatrejeux1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Quitter1Click(Sender: TObject);
    procedure Votrejeu1Click(Sender: TObject);
    procedure Tirage;//la procédure qui fait le tirage et ordonne les jeux
    procedure Lesquatrejeux1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  wdh,hgt,cdw,cdh,posX,posY,nbc,card : integer; //taille et position des cartes
  end;

var
  Form1: TForm1;

  donne : array[1..13,1..4]of byte;// les quatre jeux triés

  implementation

{$R *.dfm}

//déclaration des fonctions de cards.dll
function cdtDraw(DC:HDC; X,Y,Card,Typ:Integer; Color:TColor):Integer; StdCall; external 'CARDS.DLL';
function cdtDrawExt(DC:HDC; X,Y,CardWidth,CardHeight,Card,Typ:Integer; Color:TColor):Integer; StdCall; external 'CARDS.DLL';
function cdtInit(var Width,Height:Integer):Integer; StdCall; external 'CARDS.DLL';
function cdtTerm:Integer; StdCall; external 'CARDS.DLL';


procedure TForm1.FormCreate(Sender: TObject);
begin
form1.Left:=0;
form1.Top:=0;
form1.Height:=600;
form1.Width:=800;
end;

procedure TForm1.Quitter1Click(Sender: TObject);
begin
cdtTerm;
Application.Terminate;
end;

procedure TForm1.Votrejeu1Click(Sender: TObject);
var
x :byte;
begin
Tirage;// Appel de la procédure
posX:=205;//Ordonnée x de l'affichage
posY:=148;//Ordonnée y de l'aafichage
cdtInit(wdh,hgt);
//J'ai employé cdtDraw le format standard des cartes convient parfaitement
for x:=1 to 13 do begin
card:=donne[x,1];
cdtDraw(Form1.Canvas.Handle,posX,posY,card,0,clWhite);// Affiche votre jeu
posX:=posX+20;
end;
end;


procedure TForm1.Tirage;
var
bb,r :String;
a,b,c,i,ip,ic,ik,it,j,jj,t,x,y : byte;
s :real;
//des tableaux temporaires
trg : array[1..13,1..4] of byte;
pq :array[1..13] of byte;
cr :array[1..13] of byte;
ka :array[1..13] of byte;
tr :array[1..13] of byte;
begin
randomize;
r:='123456789abcd';//variable représentant 13 cartes
r:=r+r+r+r+'0';//variable d'un jeu de 52 cartes plus un caractère de contrôle pour éviter les doublons
//Tirage des quatre jeux
for j:=1 to 4 do begin
  for i :=1 to 13 do begin
x:=53;
while(MidStr(r,x,1)='0') do begin //Tant que la chaîne r n'est pas remplie de 0
x:=random(length(r))+1; //on tire un chiffre entre 1 et 53
end;
s:=Int((x-1)/13);//on calcule la couleur de la carte P=0,C=1,K=2,T=3
y:=round(s)*13;//y=0,11,26,39, fin de chaque couleur
bb:= MidStr(r,x,1);//le numéro tiré
bb:='$'+bb;//on rajoute $ devant
jj:=(StrToInt(bb))+y;//Grâce au $ le nombre est hexa et convertit en byte
trg[i,j]:=(jj-1);//Dans le tab temporaire, la carte
r[x]:='0';//on remplace par 0 dans la chaîne pour ne pas avoir de doublon
end;
  end;
//Par securité on initialise les 4 tab temporaires avec des valeurs impossibles
for a:=1 to 13 do begin
pq[a]:=99;
cr[a]:=99;
ka[a]:=99;
tr[a]:=99;
end;
for j:=1 to 4 do begin //Les 4 jeux
//compteurs pour les 4 couleurs
ip:=0;
ic:=0;
ik:=0;
it:=0;
  for i:=1 to 13 do begin //Chaque jeu
x:=trg[i,j] ; //chaque carte
case x mod 4 of //Calcule la couleur
0: //Trèfles
begin
if x=0 then x:=53; //L'as est la plus forte carte
it:=it+1; //incrémente
tr[it]:=x; //dans le tab
end;
1: //Carreaux
begin
if x=1 then x:=54;
ik:=ik+1;
ka[ik]:=x;//trg[i];
end;
2: //Coeurs
begin
if x=2 then x:=55;
ic:=ic+1;
cr[ic]:=x;//trg[i];
end;
3: //Piques
begin
if x=3 then x:=56;
ip:=ip+1;
pq[ip]:=x;//trg[i];
end;
end;
end;
 //On trie les piques
    for a:=1 to ip-1 do
      for b:=a+1 to ip do
        //Typique tri à bulle. Peu de données à trier
        if (pq[a]<pq[b]) then
        begin
        t:=pq[a];
        pq[a]:=pq[b];
        pq[b]:=t;
        end;
  //On trie les coeurs
      for a:=1 to ic-1 do
      for b:=a+1 to ic do
        if (cr[a]<cr[b]) then
        begin
        t:=cr[a];
        cr[a]:=cr[b];
        cr[b]:=t;
        end;
        for a:=1 to ik-1 do
 //On trie les carreaux
      for b:=a+1 to ik do
        if (ka[a]<ka[b]) then
        begin
        t:=ka[a];
        ka[a]:=ka[b];
        ka[b]:=t;
        end;
        for a:=1 to it-1 do
 //On trie les trèfles
      for b:=a+1 to it do
        if (tr[a]<tr[b]) then
        begin
        t:=tr[a];
        tr[a]:=tr[b];
        tr[b]:=t;
        end;
 (*On rétablit les as pour leur valeur réelle pour l'affichage et on remplit le
 tab définitif pour la donne*)
 for a:=1 to ip do begin
     if pq[a]=56 then pq[a]:=3;
     donne[a,j]:=pq[a];
 end;
 for a:=1 to ic  do begin
      if cr[a]=55 then cr[a]:=2;
      donne[a+ip,j]:=cr[a];
 end;
 for a:=1 to ik do begin
      if ka[a]=54 then ka[a]:=1;
      donne[a+ip+ic,j]:=ka[a];
 end;
 for a:=1 to it do begin
      if tr[a]=53 then tr[a]:=0;
      donne[a+ip+ic+ik,j]:=tr[a];
 end;
      end;
end;
// C'est fini! donne contient les quatre jeux
procedure TForm1.Lesquatrejeux1Click(Sender: TObject);
var
x :byte;
begin
Tirage;
//Ouest
posX:=10;
posY:=198;
cdtInit(wdh,hgt);
//J'ai employé cdtDrawExt pour que les cartes soient plus petites
for x:=1 to 13 do begin
card:=donne[x,1];
cdtDrawExt(Form1.Canvas.Handle,posX,posY,60,90,card,0,clWhite);
posX:=posX+18;
end;

//Nord
posX:=215;
posY:=18;
for x:=1 to 13 do begin
card:=donne[x,2];
cdtDrawExt(Form1.Canvas.Handle,posX,posY,60,90,card,0,clWhite);
posX:=posX+18;
end;

//Est
posX:=485;
posY:=198;
for x:=1 to 13 do begin
card:=donne[x,3];
cdtDrawExt(Form1.Canvas.Handle,posX,posY,60,90,card,0,clWhite);
posX:=posX+18;
end;

//Sud
posX:=215;
posY:=400;
for x:=1 to 13 do begin
card:=donne[x,4];
cdtDrawExt(Form1.Canvas.Handle,posX,posY,60,90,card,0,clWhite);
posX:=posX+18;
end;
end;
end.
rem ============================================================================


Dernière édition par papydall le Lun 25 Avr 2016 - 3:21, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 0:07

Chouette
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Marc



Nombre de messages : 551
Age : 56
Localisation : TOURS
Date d'inscription : 18/03/2014

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 0:34

Bonsoir Papydall, bonsoir à tous,

Après multiples tirages, je n'ai pas constaté -pour l'instant- d'erreur sur le jeu ouest.

Par contre, j'ai le problème d'une manière aléatoire et uniquement sur la dame de pique
lorsque j'affiche "Votre jeu" :



Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Marc



Nombre de messages : 551
Age : 56
Localisation : TOURS
Date d'inscription : 18/03/2014

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 1:02

J'ai fait qqs essais supplémentaires :



La 9ème carte (2ème dame de pique) possède une valeur impossible : 99

Edit :
J'ai ajouté un PRINT pour visualiser les valeurs des cartes comme ceci :

Code:
SUB Votre_Jeu()
    dim_local x
    Tirage()   : ' Appel de la procédure
    posX = 205 : ' Ordonnée x de l'affichage
    posY = 148 : ' Ordonnée y de l'aafichage
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))

    for x = 1 to 13
        card = donne(x,1)

        print card : ' <======================= PRINT ajouté pour test =========
        
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0) : ' Affiche votre jeu
        posX = posX + 20
    next x
END_SUB
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
silverman

avatar

Nombre de messages : 475
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 1:21

J'ai aussi constaté que la dame de pique possède une valeur impossible par moment : 99
Après plusieurs essais, c'est quand 'ip' reste à 1, à partir de la ligne 109. (Cela semble venir du tirage, et peut se probablement se produire pour 'it', 'ik', 'ic')
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5613
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 2:00

Jicehel, Marc37 et Silverman merci pour vos essais.
Justement le problème se produit toujours avec la dame de pique.
Il parait qu’elle ne m’aime pas. Embarassed

La piste de la valeur impossible 99 est sans doute la clef du mystère.
Pourvu que je trouve la bonne serrure qui va avec. Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
silverman

avatar

Nombre de messages : 475
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 2:17

à la ligne 152, (a+ip+ic+ik)=14 par moment, c'est ce qui produit le message d'erreur 'array...'

je suis presque sûr que c'est un pb d'algorithme;
quand il n'y a que 3 couleurs dans la main, le pb se produit. C'est le tri à bulle qui produit le nombre 99 quand 'it', 'ic', 'ip' ou 'ik' = 1.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5613
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 2:40

Merci Silverman.
Je verrai ça tout à l'heure.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
papydall

avatar

Nombre de messages : 5613
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 3:19

Silverman, ton analyse est juste : c’est le tri qui pose problème.

En réalité ce n’est pas l’algorithme en lui-même qui est fautif, mais j’étais victime d’un bug sur la structure FOR … NEXT de panoramic.
J’ai d’ailleurs découvert ce bug dès ma 1ère année Panoramic et je l’ai mentionné.
Malheureusement il n’a pas été pris en considération.

Une boucle comme

Code:

dim i
for i = 1 to 0
    print "Salut"
next i

Doit être exécutée ZERO fois.
Or Panoramic, l’exécute sans broncher.


Tenant compte de ceci, j’ai réussi enfin à corriger mon code.
Il fonctionne parfaitement maintenant.

Voici la bonne version
Code:

rem ============================================================================
rem            Tirage de jeu de carte style bridge
rem          Code original en Delphi par Yves Manuel
rem            Adaptation en Panoramic par Papydall
rem ============================================================================
' Description :
' =============
' Ce programme tire et affiche quatre jeux de treize cartes (style bridge),
' mais il est facilement adaptable à tout jeu se jouant avec des cartes françaises.
' Pour certains jeux il serait nécessaire de modifier les options de tri,
' l'ordre des cartes n'étant pas pour tous les jeux le même.
' (L'ordre dans ce programme est de l'As au 2).
' Il utilise "cards.dll" : ' Si vous ne disposez pas de cette dll, vous pouvez
' la télécharger à partir de mon bebdav
rem ============================================================================
label clic
dim i,hdc%,w%,h%,cdw,cdh,posX,posY,nbc,card,ret%
dim donne(13,4) : ' les quatre jeux triés

width 0,800 : height 0,600
top 0,(screen_y - height(0))/2 : left 0,(screen_x - width(0))/2
application_title "Tirage de jeu de carte style bridge"

main_menu 10
    sub_menu 11    : parent 11,10    : caption 11 ,"Tirage"
    sub_menu 12    : parent 12,11    : caption 12, "Aléatoire"
       sub_menu 13 : parent 13,12    : caption 13, "Votre jeu"
       sub_menu 14 : parent 14,12    : caption 14, "Les quatre jeux"
    sub_menu 15    : parent 15,11    : caption 15, "Quitter"
    sub_menu 16    : parent 16,10    : caption 16, "Infos"
for i = 11 to 16   : on_click i,clic : next i
dll_on "cards"     : ' Si vous ne disposez pas de "cards.dll", vous pouvez la télécharger sur mon bebdav

END
rem ============================================================================
Clic:
    select number_click
        case 13 : Votre_Jeu()
        case 14 : Les_4_Jeux()
        case 15 : Quitter()
        case 16 : Infos()
    end_select
return
rem ============================================================================
SUB Votre_Jeu()
    dim_local x
    Tirage()   : ' Appel de la procédure
    posX = 205 : ' Ordonnée x de l'affichage
    posY = 148 : ' Ordonnée y de l'aafichage
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))

    for x = 1 to 13
        card = donne(x,1)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0) : ' Affiche votre jeu
        posX = posX + 20
    next x
END_SUB
rem ============================================================================
SUB Tirage()
    dim_local bb$,r$
    dim_local a,b,c,i,ip,ic,ik,it,j,jj,t,x,y,s
    dim_local trg(13,4), pq(13),cr(13),ka(13),tr(13) : ' des tableaux temporaires

    r$ = "123456789ABCD" : ' variable représentant 13 cartes
    r$ = r$+r$+r$+r$+"0" : ' variable d'un jeu de 52 cartes plus un caractère de contrôle pour éviter les doublons

    for j = 1 to 4       : ' Tirage des quatre jeux
        for i  = 1 to 13
            x = 53
            while mid$(r$,x,1) = "0" : ' Tant que la chaîne r$ n'est pas remplie de 0
                  x = int(rnd(53)+1) : ' on tire un nombre entre 1 et 53
            end_while

            s = Int((x-1)/13)        : ' on calcule la couleur de la carte P=0,C=1,K=2,T=3
            y  = s*13                : ' y = 0,13,26,39, fin de chaque couleur
            bb$ = Mid$(r$,x,1)       : ' le numéro tiré
            jj  =  hex(bb$) + y      : ' le nombre est hexa et convertit en entier
            trg(i,j) = (jj-1)        : ' Dans le tab temporaire, la carte
            r$ =  left$(r$,x-1) + "0" + right$(r$,len(r$)-x) : ' on remplace par 0 dans la chaîne pour ne pas avoir de doublon
        next i

    next j

' Par securité on initialise les 4 tableaux temporaires avec des valeurs impossibles
    for a = 1 to 13
        pq(a) = 99 : cr(a) = 99 : ka(a) = 99 : tr(a) = 99
    next a

    for j = 1 to 4 : ' Les 4 jeux
        ip = 0 : ic = 0 : ik = 0 : it = 0 : ' Compteurs pour les 4 couleurs
        for i = 1 to 13                   : ' Chaque jeu
            x = trg(i,j)                  : ' chaque carte
            select mod(x,4)               : ' Calcule la couleur
                 case 0                   : ' Trèfles
                     if x = 0 then x = 53 : ' L'as est la plus forte carte
                     it = it + 1 : tr(it) = x
                 case 1                   : ' Carreaux
                     if x = 1 then x = 54
                     ik = ik + 1 : ka(ik) = x
                 case 2                   : ' Coeurs
                     if x = 2 then x = 55
                     ic = ic + 1 : cr(ic) = x
                 case 3                   : ' Piques
                     if x = 3 then x = 56
                     ip = ip + 1 : pq(ip) = x
            end_select
        next i

' Typique tri à bulle. Peu de données à trier
     if ip > 1
        for a = 1 to ip-1 : ' On trie les piques
            for b = a+1 to ip
                if pq(a) < pq(b) then t = pq(a) :  pq(a) = pq(b) : pq(b) = t
            next b
        next a
     end_if
     if ic > 1
       for a = 1 to ic-1 : ' On trie les coeurs
           for b = a+1 to ic
                if cr(a) < cr(b) then t = cr(a) : cr(a) = cr(b) : cr(b) = t
           next b
       next a
     end_if
     if ik > 1
       for a = 1 to ik-1 : ' On trie les carreaux
          for b = a+1 to ik
             if ka(a) < ka(b) then t = ka(a) : ka(a) = ka(b) : ka(b) = t
          next b
        next a
       end_if
       if it > 1
        for a = 1 to it-1
           for b = a+1 to it : ' On trie les trèfles
              if tr(a) < tr(b) then t = tr(a) : tr(a) = tr(b) : tr(b) = t
           next b
        next a
      end_if
' On rétablit les as pour leur valeur réelle pour l'affichage et on remplit le
' tableau définitif pour la donne
        for a = 1 to ip
            if pq(a) = 56 then pq(a) = 3
            donne(a,j) = pq(a)
        next a
        for a = 1 to ic
            if cr(a) = 55 then cr(a) = 2
            donne(a+ip,j) = cr(a)
        next a
        for a = 1 to ik
            if ka(a) = 54 then ka(a) = 1
            donne(a+ip+ic,j) = ka(a)
        next a
        for a = 1 to it
            if tr(a) = 53 then tr(a) = 0
            donne(a+ip+ic+ik,j) = tr(a)
        next a
    next j

' C'est fini! donne contient les quatre jeux

END_SUB
rem ============================================================================
SUB Les_4_Jeux()
    dim_local x
    Tirage()
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))
    
' Ouest
    posX = 10 : posY = 198 +50
    for x = 1 to 13
       card = donne(x,1)
       ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
       posX = posX+18
    next x

' Nord
    posX = 215 : posY = 18
    for x = 1 to 13
        card = donne(x,2)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
        posX = posX+18
    next x
' Est
   posX = 485 : posY = 198+50
   for x = 1 to 13
       card = donne(x,3)
       ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
       posX = posX+18
    next x
' Sud
    posX = 215 : posY = 400
    for x = 1 to 13
        card = donne(x,4)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
        posX = posX+18
    next x

END_SUB
rem ============================================================================
SUB Infos()
    dim_local t$
    t$ = "=======================================" + chr$(13)
    t$ = t$ +"Tirage de jeu de carte style bridge" + chr$(13)
    t$ = t$ + "=======================================" + chr$(13)
    t$ = t$ + "Code d'origine en Delphi" + chr$(13)
    t$ = t$ + "Auteur  : Yves Manuel" + chr$(13)
    t$ = t$ + "Date      : 03/08/2013" + chr$(13)
    t$ = t$ + "=======================================" + chr$(13)
    t$ = t$ + "Adaptation en Panoramic" + chr$(13)
    t$ = t$ + "Auteur  : Par Papydall" + chr$(13)
    t$ = t$ + "Date      : 24/04/2016" + chr$(13)
    t$ = t$ + "======================================="
    message t$
END_SUB
rem ============================================================================
SUB Quitter()
    dim_local ret%,hWnd
    dll_off
    hWnd = handle(0)
    dll_on "user32"
    ret% = dll_call4("PostMessageA",hWnd,16,0,0) : ' 16 c'est la constante de fermeture
END_SUB
rem ============================================================================


Je mets donc RESOLU

Merci à tous ceux qui ont contribué au diagnostic. king
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Marc



Nombre de messages : 551
Age : 56
Localisation : TOURS
Date d'inscription : 18/03/2014

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 10:31

J’en étais arrivé au même constat avant de partir dans les bras de Morphée : problème de tri.

Bravo d’avoir résolu et donc trouvé cette serrure manquante !

Mais… il y a avait 2 clés mystérieuses à trouver, et malheureusement, elles n’entrent pas dans la même serrure :

Testé ce matin avec, bien sûr, la nouvelle version de tri :



Il faut rappeler le serrurier !

Le remède semble identique au premier cas : boucles FOR...NEXT parfois exécutées zéro fois si ip, ic, ik ou it = 0 :

Code:
' On rétablit les as pour leur valeur réelle pour l'affichage et on remplit le
' tableau définitif pour la donne
        for a = 1 to ip
            if pq(a) = 56 then pq(a) = 3
            donne(a,j) = pq(a)
        next a
        for a = 1 to ic
            if cr(a) = 55 then cr(a) = 2
            donne(a+ip,j) = cr(a)
        next a
        for a = 1 to ik
            if ka(a) = 54 then ka(a) = 1
            donne(a+ip+ic,j) = ka(a)
        next a
        for a = 1 to it
            if tr(a) = 53 then tr(a) = 0
            donne(a+ip+ic+ik,j) = tr(a)
        next a
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5613
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    Lun 25 Avr 2016 - 14:38

Bonjour Marc37
Merci d’avoir poussé le test.
Hier soir, quand je me suis rappelé du bug de la boucle FOR … NEXT, j’étais très content d’apporter la correction, mais dans la hâte je n’avais pas regardé plus loin.  Ne vous ai-je pas dit que ma vision s’est détérioré depuis que je n’ai plus vingt ans de moins que je ne l’avais maintenant ?

Que feront les vieux (comme moi) sans les jeunes (comme toi) ?
Une fois encore merci, et voici le code définitif.

Code:

rem ============================================================================
rem            Tirage de jeu de carte style bridge
rem          Code original en Delphi par Yves Manuel
rem            Adaptation en Panoramic par Papydall
rem ============================================================================
' Description :
' =============
' Ce programme tire et affiche quatre jeux de treize cartes (style bridge),
' mais il est facilement adaptable à tout jeu se jouant avec des cartes françaises.
' Pour certains jeux il serait nécessaire de modifier les options de tri,
' l'ordre des cartes n'étant pas pour tous les jeux le même.
' (L'ordre dans ce programme est de l'As au 2).
' Il utilise "cards.dll" : ' Si vous ne disposez pas de cette dll, vous pouvez
' la télécharger à partir de mon bebdav
rem ============================================================================
label clic
dim i,hdc%,w%,h%,cdw,cdh,posX,posY,nbc,card,ret%
dim donne(13,4) : ' les quatre jeux triés

width 0,800 : height 0,600
top 0,(screen_y - height(0))/2 : left 0,(screen_x - width(0))/2
application_title "Tirage de jeu de carte style bridge"

main_menu 10
    sub_menu 11    : parent 11,10    : caption 11 ,"Tirage"
    sub_menu 12    : parent 12,11    : caption 12, "Aléatoire"
       sub_menu 13 : parent 13,12    : caption 13, "Votre jeu"
       sub_menu 14 : parent 14,12    : caption 14, "Les quatre jeux"
    sub_menu 15    : parent 15,11    : caption 15, "Quitter"
    sub_menu 16    : parent 16,10    : caption 16, "Infos"
for i = 11 to 16   : on_click i,clic : next i
dll_on "cards"     : ' Si vous ne disposez pas de "cards.dll", vous pouvez la télécharger sur mon bebdav

END
rem ============================================================================
Clic:
    select number_click
        case 13 : Votre_Jeu()
        case 14 : Les_4_Jeux()
        case 15 : Quitter()
        case 16 : Infos()
    end_select
return
rem ============================================================================
SUB Votre_Jeu()
    dim_local x
    Tirage()   : ' Appel de la procédure
    posX = 205 : ' Ordonnée x de l'affichage
    posY = 148 : ' Ordonnée y de l'aafichage
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))

    for x = 1 to 13
        card = donne(x,1)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0) : ' Affiche votre jeu
        posX = posX + 20
    next x
END_SUB
rem ============================================================================
SUB Tirage()
    dim_local bb$,r$
    dim_local a,b,c,i,ip,ic,ik,it,j,jj,t,x,y,s
    dim_local trg(13,4), pq(13),cr(13),ka(13),tr(13) : ' des tableaux temporaires

    r$ = "123456789ABCD" : ' variable représentant 13 cartes
    r$ = r$+r$+r$+r$+"0" : ' variable d'un jeu de 52 cartes plus un caractère de contrôle pour éviter les doublons

    for j = 1 to 4       : ' Tirage des quatre jeux
        for i  = 1 to 13
            x = 53
            while mid$(r$,x,1) = "0" : ' Tant que la chaîne r$ n'est pas remplie de 0
                  x = int(rnd(53)+1) : ' on tire un nombre entre 1 et 53
            end_while

            s = Int((x-1)/13)        : ' on calcule la couleur de la carte P=0,C=1,K=2,T=3
            y  = s*13                : ' y = 0,13,26,39, fin de chaque couleur
            bb$ = Mid$(r$,x,1)       : ' le numéro tiré
            jj  =  hex(bb$) + y      : ' le nombre est hexa et convertit en entier
            trg(i,j) = (jj-1)        : ' Dans le tab temporaire, la carte
            r$ =  left$(r$,x-1) + "0" + right$(r$,len(r$)-x) : ' on remplace par 0 dans la chaîne pour ne pas avoir de doublon
        next i

    next j

' Par securité on initialise les 4 tableaux temporaires avec des valeurs impossibles
    for a = 1 to 13
        pq(a) = 99 : cr(a) = 99 : ka(a) = 99 : tr(a) = 99
    next a

    for j = 1 to 4 : ' Les 4 jeux
        ip = 0 : ic = 0 : ik = 0 : it = 0 : ' Compteurs pour les 4 couleurs
        for i = 1 to 13                   : ' Chaque jeu
            x = trg(i,j)                  : ' chaque carte
            select mod(x,4)               : ' Calcule la couleur
                 case 0                   : ' Trèfles
                     if x = 0 then x = 53 : ' L'as est la plus forte carte
                     it = it + 1 : tr(it) = x
                 case 1                   : ' Carreaux
                     if x = 1 then x = 54
                     ik = ik + 1 : ka(ik) = x
                 case 2                   : ' Coeurs
                     if x = 2 then x = 55
                     ic = ic + 1 : cr(ic) = x
                 case 3                   : ' Piques
                     if x = 3 then x = 56
                     ip = ip + 1 : pq(ip) = x
            end_select
        next i

' Typique tri à bulle. Peu de données à trier
     if ip > 1
        for a = 1 to ip-1 : ' On trie les piques
            for b = a+1 to ip
                if pq(a) < pq(b) then t = pq(a) :  pq(a) = pq(b) : pq(b) = t
            next b
        next a
     end_if
     if ic > 1
       for a = 1 to ic-1 : ' On trie les coeurs
           for b = a+1 to ic
                if cr(a) < cr(b) then t = cr(a) : cr(a) = cr(b) : cr(b) = t
           next b
       next a
     end_if
     if ik > 1
       for a = 1 to ik-1 : ' On trie les carreaux
          for b = a+1 to ik
             if ka(a) < ka(b) then t = ka(a) : ka(a) = ka(b) : ka(b) = t
          next b
        next a
       end_if
       if it > 1
        for a = 1 to it-1
           for b = a+1 to it : ' On trie les trèfles
              if tr(a) < tr(b) then t = tr(a) : tr(a) = tr(b) : tr(b) = t
           next b
        next a
      end_if
' On rétablit les as pour leur valeur réelle pour l'affichage et on remplit le
' tableau définitif pour la donne
        if ip > 0
           for a = 1 to ip
               if pq(a) = 56 then pq(a) = 3
               donne(a,j) = pq(a)
           next a
        end_if
        if ic > 0
           for a = 1 to ic
               if cr(a) = 55 then cr(a) = 2
               donne(a+ip,j) = cr(a)
           next a
        end_if
        if ik > 0
           for a = 1 to ik
               if ka(a) = 54 then ka(a) = 1
               donne(a+ip+ic,j) = ka(a)
           next a
        end_if
        if it > 0
           for a = 1 to it
               if tr(a) = 53 then tr(a) = 0
               donne(a+ip+ic+ik,j) = tr(a)
          next a
        end_if
    next j

' C'est fini! donne contient les quatre jeux

END_SUB
rem ============================================================================
SUB Les_4_Jeux()
    dim_local x
    Tirage()
    hdc% = handle_canvas(0)
    ret% = dll_call2("cdtInit",adr(w%),adr(h%))

' Ouest
    posX = 10 : posY = 198 +50
    for x = 1 to 13
       card = donne(x,1)
       ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
       posX = posX+18
    next x

' Nord
    posX = 215 : posY = 18
    for x = 1 to 13
        card = donne(x,2)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
        posX = posX+18
    next x
' Est
   posX = 485 : posY = 198+50
   for x = 1 to 13
       card = donne(x,3)
       ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
       posX = posX+18
    next x
' Sud
    posX = 215 : posY = 400
    for x = 1 to 13
        card = donne(x,4)
        ret% = dll_call6("cdtDraw",hdc%,posX,posY,card,0,0)
        posX = posX+18
    next x

END_SUB
rem ============================================================================
SUB Infos()
    dim_local t$
    t$ = "=======================================" + chr$(13)
    t$ = t$ +"Tirage de jeu de carte style bridge" + chr$(13)
    t$ = t$ + "=======================================" + chr$(13)
    t$ = t$ + "Code d'origine en Delphi" + chr$(13)
    t$ = t$ + "Auteur  : Yves Manuel" + chr$(13)
    t$ = t$ + "Date      : 03/08/2013" + chr$(13)
    t$ = t$ + "=======================================" + chr$(13)
    t$ = t$ + "Adaptation en Panoramic" + chr$(13)
    t$ = t$ + "Auteur  : Par Papydall" + chr$(13)
    t$ = t$ + "Date      : 24/04/2016" + chr$(13)
    t$ = t$ + "======================================="
    message t$
END_SUB
rem ============================================================================
SUB Quitter()
    dim_local ret%,hWnd
    dll_off
    hWnd = handle(0)
    dll_on "user32"
    ret% = dll_call4("PostMessageA",hWnd,16,0,0) : ' 16 c'est la constante de fermeture
END_SUB
rem ============================================================================


Ah ce maudit bug de la boucle FOR ... NEXT !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Contenu sponsorisé




MessageSujet: Re: [RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?    

Revenir en haut Aller en bas
 
[RESOLU] Pouvez-vous voir ce que je n'arrive pas à saisir?
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Moi c'est Mérillym, vous pouvez m'appeler Méry :D
» depart dans le sens anti horaire
» Un petit coucou, je reviens doucement vous voir....
» Un kit Erza, pouvez-vous m'aider ? :)
» Quelle partie de votre cerveau utilisez-vous ?

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: A l'aide!-
Sauter vers: