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

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 ============================================================================

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 ============================================================================

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

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

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 ============================================================================

' 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

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 ============================================================================