Publicité
+ Répondre à la discussion
Page 1 sur 2 12 DernièreDernière
Affichage des résultats 1 à 20 sur 22
  1. #1
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut Virtual Pascal et Delphi

    Bonjour !

    Je m'intéresse depuis quelque temps à la programmation Win32 que j'ai essayée, avec VP d'un côté, avec Delphi de l'autre. Maintenant j'essaie de fondre les deux versions de mes programmes dans un seul fichier.

    Je n'ai pas trouvé comment compiler un fichier PAS avec Delphi ; en revanche j'ai constaté que Virtual Pascal compile les fichiers DPR.

    Je vous propose un programme qui affiche la date de Pâques pour l'année courante (à partir d'une table contenant les années 1900 à 2199). La compilation a été testée avec Virtual Pascal 2.1 et Delphi 6.

    La seule partie du code que j'ai dédoublée est relative à l'année courante. Virtual Pascal ne reconnaissant pas, apparemment, le type SystemTime, j'ai bricolé ce que j'ai pu provisoirement.

    Autre chose que je n'ai pas trouvée, l'équivalent Delphi du $IfDef VPascal ou du $IfDef FPC. J'ai vu comment on pouvait indiquer une version de Delphi mais pas l'environnement Delphi en général.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    // PAQUES.DPR
    // Delphi 6, Free Pascal 2.6, Virtual Pascal 2.1
     
    program Paques;
     
    {$IFDEF VPASCAL}
      {&PMTYPE PM}
    {$ELSE}
      {$APPTYPE GUI}
    {$ENDIF}
     
    uses
      Windows, Messages, SysUtils;
     
    {$I Paques.inc}
    {$I Couleurs.inc}
     
    var
      t: tSystemTime;
      c: array[0..99] of char;
     
    procedure MainPaint(hWindow: HWND; ps: TPaintStruct);
     
      function f(s: string): string;
      var
        temp: string;
      begin
        temp := Copy(s, 1, 1);
        if temp = 'M' then temp := 'mars' else temp := 'avril';
        temp := Copy(s, 2, 2) + ' ' + temp;
        f := temp;
      end;
     
    var
      NewFont, OldFont: hFont;
      s: string;
      r: tRect;
     
    begin
      NewFont := CreateFont(20,
                            0,0,0,
                            FW_LIGHT,
                            0,0,0,
                            DEFAULT_CHARSET,
                            0,0,0,0,
                            'Courier New');
     
      OldFont := SelectObject(ps.hdc, NewFont);
     
      SetTextColor(ps.hdc, White);
      SetBkMode(ps.hdc, Transparent);
     
      GetLocalTime(t);
     
      s := 'En '
         + IntToStr(t.wYear)
         + ', le dimanche de Pâques est le '
         + f(DateDePaques[t.wYear])
         + '.'
         ;
     
      StrPCopy(c, s);
      SetRect(r, 10, 10, 640-20, 300-20);
      DrawText(ps.hdc, c, StrLen(c), r, DT_LEFT);
      DeleteObject(SelectObject(ps.hdc, OldFont));
    end;
     
    procedure MainDestroy(hWindow: HWND);
    begin
      PostQuitMessage(0);
    end;
     
    function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                         LParam: LPARAM): LRESULT; stdcall; export;
    var
      ps: TPaintStruct;
    begin
      MainWndProc := 0;
      case Msg of
        WM_PAINT: begin
                    BeginPaint(hWindow, ps);
                    MainPaint(hWindow, ps);
                    EndPaint(hWindow, ps);
                  end;
        WM_DESTROY: MainDestroy(hWindow);
      else begin
             MainWndProc := DefWindowProc(hWindow, Msg, wParam, lParam);
             Exit;
           end;
      end;
    end;
     
    var
      wc: TWndClass;
      hWindow: HWND;
      Msg: TMsg;
     
    begin
      wc.lpszClassName := 'GenericAppClass';
      wc.lpfnWndProc := @MainWndProc;
      wc.style := CS_VREDRAW or CS_HREDRAW;
      wc.hInstance := hInstance;
      wc.hIcon := LoadIcon(0, IDI_APPLICATION);
      wc.hCursor := LoadCursor(0, IDC_ARROW);
      wc.hbrBackground := CreateSolidBrush(RoyalBlue);
      wc.lpszMenuName := nil;
      wc.cbClsExtra := 0;
      wc.cbWndExtra := 0;
      RegisterClass(wc);
      hWindow := CreateWindowEx(WS_EX_OVERLAPPEDWINDOW,
                                wc.lpszClassName,
                                'Date de Pâques',
                                WS_OVERLAPPEDWINDOW,
                                10,
                                10,
                                640+16,
                                300+38,
                                0,
                                0,
                                hInstance,
                                nil);
      ShowWindow(hWindow, CmdShow);
      UpDateWindow(hWindow);
      while GetMessage(Msg, 0, 0, 0) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
      Halt(Msg.wParam);
    end.
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  2. #2
    Responsable Pascal

    Avatar de Alcatîz
    Homme Profil pro Jean-Luc Gofflot
    Ressources humaines
    Inscrit en
    mars 2003
    Messages
    5 942
    Détails du profil
    Informations personnelles :
    Nom : Homme Jean-Luc Gofflot
    Âge : 47
    Localisation : Belgique

    Informations professionnelles :
    Activité : Ressources humaines
    Secteur : Service public

    Informations forums :
    Inscription : mars 2003
    Messages : 5 942
    Points : 37 468
    Points
    37 468

    Par défaut

    Bonjour,

    Le type TSystemTime est défini ainsi dans la RTL de Virtual Pascal :
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
      PSystemTime = ^TSystemTime;
      TSystemTime = record
        wYear:         SmallWord;
        wMonth:        SmallWord;
        wDayOfWeek:    SmallWord;
        wDay:          SmallWord;
        wHour:         SmallWord;
        wMinute:       SmallWord;
        wSecond:       SmallWord;
        wMilliseconds: SmallWord;
      end;
    Et j'ai trouvé cette remarque dans l'aide de Delphi 7 :
    Use TSystemTime to represent SYSTEMTIME values when making Windows 32 API function calls.
    Ceci pourrait peut-être t'aider ?

    Pour une directive genre $IFDEF Delphi, je n'ai rien trouvé non plus.
    Règles du forum
    Tutoriels, exercices, FAQ, sources, compilateurs, outils, livres Pascal
    Mes tutoriels et sources Pascal
    FAQ Assembleur

    Le problème en ce bas monde est que les imbéciles sont sûrs d'eux et fiers comme des coqs de basse cour, alors que les gens intelligents sont emplis de doute. [Bertrand Russell]

  3. #3
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Citation Envoyé par Alcatîz Voir le message
    Ceci pourrait peut-être t'aider ?
    Cela résout parfaitement le problème. Merci pour l'indication.

    J'ai écrit un petit programme en mode console pour essayer la chose, et effectivement ça fonctionne aussi avec Delphi et FreePascal sans qu'on ait à changer quoi que ce soit.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
     
    { Delphi 6 - Free Pascal 2.6 - Virtual Pascal 2.1 }
     
    program HeureLocale; {.DPR }
     
    {$IFDEF VPASCAL}
      {&PMTYPE VIO}
    {$ELSE}
      {$APPTYPE CONSOLE}
    {$ENDIF}
     
    uses
      Windows, SysUtils;
     
    var
      t: tSystemTime;
     
    const
      NomDuJour: array[0..6] of string = ('dimanche',
                                          'lundi',
                                          'mardi',
                                          'mercredi',
                                          'jeudi',
                                          'vendredi',
                                          'samedi');
     
      NomDuMois: array[1..12] of string = ('janvier',
                                           'f'#130'vrier',
                                           'mars',
                                           'avril',
                                           'mai',
                                           'juin',
                                           'juillet',
                                           'ao'#150't',
                                           'septembre',
                                           'octobre',
                                           'novembre',
                                           'd'#130'cembre');
     
    begin
      GetLocalTime(t);
     
      WriteLn(NomDuJour[ t.wDayOfWeek ]
              + ' ' +
              IntToStr( t.wDay )
              + ' ' +
              NomDuMois[ t.wMonth ]
              + ' ' +
              IntToStr( t.wYear )
              );
     
      ReadLn;
    end.
    L'Art est long et le Temps est court.

  4. #4
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Bonjour !

    Je continue mes recherches sur un style de programmation compatible avec les principaux compilateurs Pascal. Je trouve l'idée très intéressante et si je propose ici mes exemples, ce n'est pas que je prétende avoir quelque chose de neuf à proposer, mais c'est plutôt pour recueillir les connaissances des uns et des autres.

    Voici un essai d'adaptation de l'exemple GENERIC.DPR de Delphi 1. (J'ai téléchargé Delphi 1 sur ce site.) J'ai refait le fichier "res", et remplacé les endroits du code qui ne passaient pas. Malheureusement, je n'ai pas réussi à compiler avec Free Pascal : pour certaines erreurs j'avais une solution mais pas pour toutes. Si vous y arrivez, faites-le moi savoir.

    L'archive ci-jointe (9 Ko) contient l'exécutable, le code et les ressources.
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  5. #5
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut Minuscules

    Bonsoir !

    Voici un programme dans lequel j'ai voulu réunir quelques connaissances sur la ligne de commande.

    Le programme s'utilise en faisant glisser au moyen de la souris un fichier texte sur l'exécutable. Une copie du fichier est produite, dans laquelle toutes les majuscules ont été remplacées... par des minuscules.

    Le programme s'exécute sans ouvrir de console. Aucune unité n'a été déclarée, et le code se compile aussi bien avec TP7 (exécutable incroyablement petit par rapport aux autres !) qu'avec Delphi XE2. (Toutefois avec TP7 je n'ai pas trouvé comment empêcher la console de s'ouvrir.)

    Pour éviter un avertissement de Delphi XE2 concernant la fonction Chr(), j'ai écrit une procédure de remplacement :

    Code :
    1
    2
    3
    const
      alphabet_min: string = 'abcdefghijklmnopqrstuvwxyz';
      alphabet_maj: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
    Cela m'a rappelé de très justes observations qui m'avaient été faites sur ce sujet de la portabilité et de l'avantage d'employer des caractères entre guillemets plutôt que des codes.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
     
    program Minuscules;
     
    {$IfDef FPC}
    {$AppType Gui}
    {$EndIf}
     
    {$IfDef Ver140}{$AppType Gui}{$EndIf}
    {$IfDef Ver150}{$AppType Gui}{$EndIf}
    {$IfDef Ver230}{$AppType Gui}{$EndIf}
     
    {$IfDef VPascal}
    {&PmType Pm}
    {$Endif}
     
    {$R Icone}
     
    {$I Min.inc}
    {$I Extract.inc}
     
    var
      sPath: string; { 'C:\Atelier\Pascal\Minuscules\Sample.pas' }
      sDir : string; { 'C:\Atelier\Pascal\Minuscules\'           }
      sName: string; { 'Sample'                                  }
      sExt : string; { '.pas'                                    }
     
    procedure FileProc(const nf1, nf2: string);
    var
      t1, t2: text;
      s: string;
    begin
      Assign(t1, nf1);
      Assign(t2, nf2);
      Reset(t1);
      Rewrite(t2);
      while not Eof(t1) do
      begin
        ReadLn(t1, s);
        Min(s);
        WriteLn(t2, s);
      end;
      Close(t1);
      Close(t2);
    end;
     
    begin
      if ParamCount > 0 then
      begin
        sPath := ParamStr(1);
        Extract(sPath, sDir, sName, sExt);
        FileProc(sDir + sName + sExt, sDir + sName);
      end;
    end.
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  6. #6
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Bonjour !

    Je vous propose un nouvel exemple de code utilisant l'API win32. Comme dans l'exemple précédent, le programme affiche la date de Pâques pour l'année courante mais cette fois il va la lire directement dans le fichier texte que j'ai laissé tel quel.

    J'ai refait aussi l'interface. A la place d'une fenêtre j'ai mis une simple boîte de message.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
     
    program Easter;
     
    { Affiche la date de Pâques pour l'année courante, au moyen de la
      procédure MessageBox() de l'API win32. La date est tirée d'une table
      contenant les années 1900 à 2199.
      Compilation testée : Virtual Pascal 2.1, Delphi 6. }
     
    {$IFDEF VPASCAL}
    {$PMTYPE PM}
    {$ELSE}
    {$APPTYPE GUI}
    {$ENDIF}
     
    {$R delphi}
     
    uses
      windows,{$IFDEF VPASCAL} strings,{$ELSE} sysutils,{$ENDIF} estr_tbl;
     
    procedure ShowMessage(aMsg: string);
    const
      ttl: pAnsiChar = '';
    var
      msg: array[0..79] of char;
    begin
      StrPCopy(msg, aMsg);
      MessageBox(0, msg, ttl, MB_OK);
    end;
     
    const
      s1 = 'En ';
      s2 = ', le dimanche de Pâques est le ';
      s3 = '.';
     
    var
      t: tSystemTime;
      s: string;
     
    begin
      GetLocalTime(t);
      Str(t.wYear, s);
      s := s1 + s + s2 + reader.EasterDate(t.wYear) + s3;
      ShowMessage(s);
    end.
    Citation Envoyé par Roland Chastain Voir le message
    Je n'ai pas trouvé comment compiler un fichier PAS avec Delphi
    Avec Delphi 6 on peut, en passant par le menu "Ouvrir un projet" et en choisissant l'option "projet Pascal".
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  7. #7
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Pour ma procédure ShowMessage, je viens de trouver une variante qui me permet de ne pas utiliser l'unité Strings.

    Code :
    1
    2
    3
    4
    5
    6
    7
    procedure ShowMessage(msg: string);
    const
      ttl: pAnsiChar = '';
    begin
      msg := Concat(msg, #0);
      MessageBox(0, pAnsiChar(@msg[1]), ttl, MB_OK);
    end;
    J'ai trouvé la solution dans ce message.
    L'Art est long et le Temps est court.

  8. #8
    Expert Confirmé Sénior
    Avatar de Paul TOTH
    Homme Profil pro Paul TOTH
    Freelance
    Inscrit en
    novembre 2002
    Messages
    5 320
    Détails du profil
    Informations personnelles :
    Nom : Homme Paul TOTH
    Âge : 44
    Localisation : Réunion

    Informations professionnelles :
    Activité : Freelance
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : novembre 2002
    Messages : 5 320
    Points : 14 987
    Points
    14 987

    Par défaut

    Citation Envoyé par Roland Chastain Voir le message
    Pour ma procédure ShowMessage, je viens de trouver une variante qui me permet de ne pas utiliser l'unité Strings.

    Code :
    1
    2
    3
    4
    5
    6
    7
    procedure ShowMessage(msg: string);
    const
      ttl: pAnsiChar = '';
    begin
      msg := Concat(msg, #0);
      MessageBox(0, pAnsiChar(@msg[1]), ttl, MB_OK);
    end;
    J'ai trouvé la solution dans ce message.
    alors Concat() existe, mais c'est tout simplement l'addition de strings

    msg := msg + #0;

    note que sous Delphi les strings sont des pointeurs qui possèdent déjà un #0 terminal (je ne sais pas si c'est le cas sous VP), tu peux donc tout simplement transtyper un string en PChar : PChar(msg).

    et pour ttl, tu dois pouvoir passer "nil" à la place...oui la chaîne '' en dur qui sera traitée comme un PChar (par Delphi en tout cas)
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Produits : UPnP, RemoteOffice, FlashPascal
    Embarcadero : Ile de la Réunion, Dephi, C++Builder, RADPHP...TVA à 8,5%

  9. #9
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Merci Paul pour ces indications.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
     
    program ShowMessage2;
     
    {$IFDEF VPASCAL}
    {&PMTYPE PM}
    {$ELSE}
    {$APPTYPE GUI}
    {$ENDIF}
     
    uses
      windows;
     
    procedure ShowMessage(msg: string);
    begin
      {$IFDEF VPASCAL}
      msg := msg + Chr(0);
      MessageBox(0, pAnsiChar(@msg[1]), '', MB_OK);
      {$ELSE}
      MessageBox(0, pAnsiChar(msg), '', MB_OK);
      {$ENDIF}
    end;
     
    var
      s: string;
     
    begin
      s := 'Bonjour!';
      ShowMessage(s);
    end.
    L'Art est long et le Temps est court.

  10. #10
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    J'ai écrit un petit programme pour mémoriser les principales fonctions de l'unité Strings.

    Ces fonctions (pardon si vous le savez déjà) sont disponibles dans Delphi. Il n'y a que le nom de l'unité qui soit différent. Au lieu de dédoubler la déclaration des unités, j'ai ajouté un alias dans les options de mon projet Delphi : Strings=SysUtils;
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    { D'après "La programmation Win32 en Virtual Pascal avec OWL" par Alcatîz. }
    { Compilateurs utilisés : VP 2.1, Delphi 6. }
     
    {$IFDEF VPASCAL}{&PMTYPE VIO}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
     
    uses
      Strings;
     
    procedure Traitement(p: pChar);
    begin
    end;
     
    var
      chaine, chaine2: array[0..10] of char;
      pChaine: pChar;
      caractere: char;
      adresse: pChar;
      string1: string;
     
    begin
    { Equivalences remarquables. }
      pChaine := chaine;
      pChaine := @chaine;
      pChaine := 'ab';
      caractere := chaine[6];
      caractere := pChaine[6];
      Traitement(chaine);
      Traitement(pChaine);
      Traitement('ab');
    { Fonctions de l'unité Strings/SysUtils. }
      StrCopy(chaine, 'abc');
      WriteLn(chaine);                               // abc
      chaine[2] := Chr(0);
      WriteLn(chaine);                               // ab
      WriteLn(StrLen(chaine));                       // 2
      StrCopy(chaine2, chaine);
      WriteLn(chaine2);                              // ab
      StrCopy(chaine2, chaine);
      WriteLn(chaine2);                              // ab
      WriteLn(StrComp(chaine,chaine2));              // 0
      StrCopy(chaine2, 'aB');
      WriteLn(chaine2);                              // aB
      WriteLn(chaine);                               // ab
      WriteLn(StrComp(chaine,chaine2));              // 32
      WriteLn(StrIComp(chaine,chaine2));             // 0
      WriteLn(StrPos(chaine,'b'));                   // b
      adresse := StrPos(chaine,'a');
      WriteLn(adresse-chaine);                       // 0
      StrCat(chaine,chaine2);
      WriteLn(chaine);                               // abaB
      StrLCat(chaine,'cccccccccc',SizeOf(chaine)-1);
      WriteLn(chaine);                               // abaBcccccc
      string1 := StrPas(chaine);
      WriteLn(string1);                              // abaBcccccc
      string1 := 'ab';
      StrPCopy(chaine, string1);
      WriteLn(chaine);                               // ab
      ReadLn;
    end.
    L'Art est long et le Temps est court.

  11. #11
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    En ce Mercredi-Saint, je vous propose une version retravaillée de mon programme "date de Pâques".

    J'ai ajouté une fonction qui renvoie une date relative au jour de Pâques d'une année donnée. Les arguments de la fonction sont l'année et la différence de jours. Cela permet de connaître, par exemple, la date du mercredi des Cendres (46 jours avant Pâques).

    La partie interface est réutilisable : il suffit de mettre ce que vous voulez à la place de l'unité u_paques.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
     
    program p_Paques;
     
    { Date de Pâques pour l'année courante.
     
      Virtual Pascal 2.1, Delphi 6, FreePascal 2.6.2. }
     
     
    {$IFDEF VPASCAL}
    {&PMTYPE PM}
    uses
      windows, strings, couleurs, u_paques;
    {$ELSE}
    {$APPTYPE GUI}
    uses
      windows, messages, sysutils, couleurs, u_paques;
    {$ENDIF}
     
    {$IFDEF VPASCAL}
    function currentyear: word;
    var
      t: tsystemtime;
    begin
      getlocaltime(t);
      result := t.wyear;
    end;
    {$ENDIF}
     
    procedure mainpaint(hw: hwnd; ps: tpaintstruct);
    var
      s: string;
      c: array[0..255] of char;
      newfont, oldfont: hfont;
      r: trect;
      y: word;
     
    begin
      y := currentyear;
     
      s := 'Cendres   : ' + f_chaine(f_relativepaques(y, -46)) + #13
         + 'Pâques    : ' + f_chaine(f_relativepaques(y,   0)) + #13
         + 'Ascension : ' + f_chaine(f_relativepaques(y, +39)) + #13
         + 'Pentecôte : ' + f_chaine(f_relativepaques(y, +49));
     
      setbkmode(ps.hdc, transparent);
      //setbkcolor(ps.hdc, black);
      settextcolor(ps.hdc, snow);
     
      newfont := createfont(20, 0,0,0,
                            fw_normal, 0,0,0,
                            default_charset, 0,0,0,0,
                            'courier');
     
      oldfont := selectobject(ps.hdc, newfont);
     
      getclientrect(hw, r);
      inc(r.left, 10);
      inc(r.top, 10);
      inc(r.right, 10);
      inc(r.bottom, 10);
     
      strpcopy(c, s);
      drawtext(ps.hdc, c, strlen(c), r, dt_left);
     
      deleteobject(selectobject(ps.hdc, oldfont));
    end;
     
    procedure maindestroy(hw: hwnd);
    begin
      postquitmessage(0);
    end;
     
    function mainwndproc(hw: hwnd; msg: uint; wp: wparam; lp: lparam): lresult; stdcall; export;
    var
      ps: tpaintstruct;
    begin
      result := 0;
      case msg of
        wm_paint: begin
                    beginpaint(hw, ps);
                    mainpaint(hw, ps);
                    endpaint(hw, ps);
                  end;
        wm_destroy: maindestroy(hw);
      else begin
             result := defwindowproc(hw, msg, wp, lp);
             exit;
           end;
      end;
    end;
     
    var
      wc: twndclass;
      hw: hwnd;
      msg: tmsg;
     
    begin
      wc.lpszclassname := 'app_win32';
      wc.lpfnwndproc   := @mainwndproc;
      wc.style         := cs_vredraw or cs_hredraw;
      wc.hinstance     := hinstance;
      wc.hicon         := loadicon(0, idi_application);
      wc.hcursor       := loadcursor(0, idc_arrow);
      //wc.hbrbackground := getstockobject(black_brush);
      wc.hbrbackground := createsolidbrush(darkindigo);
      wc.lpszmenuname  := nil;
      wc.cbclsextra    := 0;
      wc.cbwndextra    := 0;
      registerclass(wc);
      hw := createwindowex(ws_ex_toolwindow,
                           wc.lpszclassname,
                           'Date de Pâques pour l''année courante',
                           ws_visible or ws_clipsiblings or ws_clipchildren or ws_overlappedwindow,
                           0,
                           0,
                           594,
                           420,
                           0,
                           0,
                           hinstance,
                           nil);
      showwindow(hw, cmdshow);
      updatewindow(hw);
      while getmessage(msg, 0, 0, 0) do
      begin
        translatemessage(msg);
        dispatchmessage(msg);
      end;
      halt(msg.wparam);
    end.
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
     
    unit u_Paques;
     
    interface
     
    type
      t_Date = record
                 s, j, m, a: word;
               end;
     
    { s = jour de la semaine = 1..7
      j = jour du mois       = 1..31
      m = mois               = 1..12
      a = année              = 1900..2199 }
     
    function f_Paques(a: word): t_Date;
    function f_RelativePaques(a: word; d: integer): t_Date;
    function f_Chaine(d: t_Date): string;
     
    implementation
     
    const
      DIMANCHE = 1;
      LUNDI = 2;
      MARDI = 3;
      MERCREDI = 4;
      JEUDI = 5;
      VENDREDI = 6;
      SAMEDI = 7;
     
      NOMSDESJOURS: array[DIMANCHE..SAMEDI]of string = ('dimanche', 'lundi', 'mardi', 'mercredi',
      'jeudi', 'vendredi', 'samedi');
     
      JANVIER = 1;
      FEVRIER = 2;
      MARS = 3;
      AVRIL = 4;
      MAI = 5;
      JUIN = 6;
      JUILLET = 7;
      AOUT = 8;
      SEPTEMBRE = 9;
      OCTOBRE = 10;
      NOVEMBRE = 11;
      DECEMBRE = 12;
     
      NOMSDESMOIS: array[JANVIER..DECEMBRE]of string = ('janvier', 'février', 'mars', 'avril', 'mai',
      'juin', 'juillet', 'août', 'septembre', 'octobre', 'novembre', 'décembre');
     
      PAQUES: array[0..299]of word = (
    { Date du dimanche de Pâques de 1900 à 2199 }
        46,38,30,43,34,54,46,31,50,42,
        27,47,38,23,43,35,54,39,31,51,
        35,27,47,32,51,43,35,48,39,31,
        51,36,27,47,32,52,43,28,48,40,
        24,44,36,56,40,32,52,37,28,48,
        40,25,44,36,49,41,32,52,37,29,
        48,33,53,45,29,49,41,26,45,37,
        29,42,33,53,45,30,49,41,26,46,
        37,50,42,34,53,38,30,50,34,26,
        46,31,50,42,34,47,38,30,43,35,
        54,46,31,51,42,27,47,39,23,43,
        35,55,39,31,51,36,27,47,32,52,
        43,35,48,40,31,51,36,28,47,32,
        52,44,28,48,40,25,44,36,56,41,
        32,52,37,29,48,40,25,45,36,49,
        41,33,52,37,29,49,33,53,45,30,
        49,41,26,46,37,29,42,34,53,45,
        30,50,41,26,46,38,50,42,34,54,
        38,30,50,35,26,46,31,51,42,34,
        47,39,30,43,35,55,46,31,51,43,
        28,48,40,25,44,36,49,41,32,52,
        37,29,48,33,53,45,29,49,41,26,
        45,37,29,42,33,53,45,30,49,41,
        26,46,37,50,42,34,53,38,30,50,
        34,26,46,31,50,42,34,47,38,30,
        43,35,54,46,31,51,42,27,47,39,
        23,43,35,55,39,31,51,36,27,47,
        32,52,43,35,48,40,31,51,36,28,
        47,32,52,44,28,48,40,25,44,36,
        56,41,32,52,37,29,48,40,25,45);
     
    function f_Paques(a: word): t_Date;
    { Fonction qui renvoie la date de Pâques, pour une année comprise entre 1900 et 2199. La date est
      extraite d'une table. }
    begin
      if a < 1900 then a := 1900;
      if a > 2199 then a := 2199;
     
      result.s := DIMANCHE;
     
      if PAQUES[a-1900] < 32 then
      begin
        result.j := PAQUES[a-1900];
        result.m := MARS;
      end else
      begin
        result.j := PAQUES[a-1900] - 31;
        result.m := AVRIL;
      end;
     
      result.a := a;
    end;
     
    {const
      N: array[1..12]of word = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);}
     
    type
      t_NombreJours = array[boolean, 1..12]of word;
     
    const
      N: t_NombreJours = (
        (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
        (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
     
    function Bissext(a: word): boolean;
    { Fonction pour savoir si une année est bissextile. }
    begin
      result := ((a mod 4=0) and not((a mod 100=0) and not(a mod 400=0)));
    end;
     
    function f_RelativePaques(a: word; d: integer): t_Date;
    { Calcule une date relative à la date de Pâques, pour une année comprise entre 1900 et 2199. Le
      paramètre d est la différence de jours. }
    var
      p: t_Date;
      vs, vj, vm, va: word;
     {vn: array[1..12]of word;}
      b: boolean;
      i: integer;
    begin
      if a < 1900 then a := 1900;
      if a > 2199 then a := 2199;
     
      p := f_Paques(a);
     
      vs := p.s;
      vj := p.j;
      vm := p.m;
      va := p.a;
     
     {for i := 1 to 12 do
        vn[i] := N[i];
     
      if Bissext(a) then
        Inc(vn[FEVRIER]);}
     
      b := Bissext(a);
     
      if d < 0 then i := -1 else i := +1;
     
      while Abs(d) > 0 do
      begin
        Dec(d, i);
     
        Inc(vs, i);
     
        if vs = 0 then
          vs := SAMEDI;
     
        if vs = 8 then
          vs := DIMANCHE;
     
        Inc(vj, i);
     
        if vj = 0 then
        begin
          Dec(vm);
          if vm = 0 then
          begin
            Dec(va);
            vm := DECEMBRE;
          end;
         {vj := vn[vm];}
          vj := N[b, vm];
        end;
     
       {if vj > vn[vm] then}
        if vj > N[b, vm] then
        begin
          Inc(vm);
          if vm = 13 then
          begin
            Inc(va);
            vm := JANVIER;
          end;
          vj := 1;
        end;
     
      end;
     
      result.s := vs;
      result.j := vj;
      result.m := vm;
      result.a := va;
    end;
     
    function IntToStr(i: word): string;
    begin
      Str(i, result);
    end;
     
    function f_Chaine(d: t_Date): string;
    begin
      result := NOMSDESJOURS[d.s] + ' ' + IntToStr(d.j) + ' ' + NOMSDESMOIS[d.m] + ' ' + IntToStr(d.a);
    end;
     
    end.
    Images attachées Images attachées
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  12. #12
    Expert Confirmé Sénior
    Inscrit en
    août 2006
    Messages
    3 531
    Détails du profil
    Informations forums :
    Inscription : août 2006
    Messages : 3 531
    Points : 4 010
    Points
    4 010

    Par défaut

    Boa,

    Pour le nombre de jours par mois, au lieu de
    Code :
    1
    2
    const
      N: array[1..12]of word = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
    et plus loin
    Code :
    1
    2
      if Bissext(a) then
        Inc(vn[FEVRIER]);
    j'aurais plutôt fait
    Code :
    1
    2
    3
    4
    5
    const
      N: array[boolean][1..12]of word = ( 
                                          (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
                                          (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) 
                                         );
    et adapter le code.

    Et bien entendu, en pratique j'aurais déclaré un type, puis une constante de ce type (toujours anticiper qu'on puisse devoir passer des données en paramètre, et c'est bien plus simple avec un type déclaré).

    Il court en ce moment une espèce de grippe, mais elle ne court pas très vite, car on peut l'attraper sans courir.

  13. #13
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Merci droggo pour le coup d'œil et pour l'idée. J'ai fait la modification.
    L'Art est long et le Temps est court.

  14. #14
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Bonjour !

    Voici un programme qui joue un chant de Noël.

    J'ai utilisé une procédure faisant appel à l'unité MMSystem.

    La compilation a été testée avec Virtual Pascal et avec Delphi 7.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
     
    program Adeste;
     
    {$IFDEF VPASCAL}{&PMTYPE VIO}{&USE32+}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
     
    uses
      Son, Frequences;
     
    const
      re  =  2;
      mi  =  4;
      fa  =  6;
      sol =  7;
      la  =  9;
      si  = 11;
      ut  = 12;
      re8 = 14;
     
    type
      note = record
        n: integer;
        d: integer;
        v: integer;
      end;
     
    const
      notes: array[1..68]of note = (
        (n: sol; d: 2; v: 2),
        (n: sol; d: 4; v: 2),
        (n:  re; d: 2; v: 2),
        (n: sol; d: 2; v: 2),
        (n:  la; d: 4; v: 2),
        (n:  re; d: 4; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  ut; d: 2; v: 2),
        (n:  si; d: 4; v: 2),
        (n:  la; d: 2; v: 2),
        (n:   0; d: 1; v: 0),
        (n: sol; d: 1; v: 2),
        (n: sol; d: 4; v: 2),
        (n:  fa; d: 1; v: 2),
        (n:   0; d: 1; v: 0),
        (n:  mi; d: 2; v: 2),
        (n:  fa; d: 2; v: 2),
        (n: sol; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  fa; d: 4; v: 2),
        (n:  mi; d: 3; v: 2),
        (n:  re; d: 1; v: 2),
        (n:  re; d: 6; v: 2),
        (n:   0; d: 2; v: 0),
        (n: re8; d: 4; v: 2),
        (n:  ut; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  ut; d: 4; v: 2),
        (n:  si; d: 4; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n: sol; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  fa; d: 4; v: 2),
        (n:  re; d: 1; v: 2),
        (n:   0; d: 1; v: 0),
        (n: sol; d: 2; v: 1),
        (n: sol; d: 2; v: 1),
        (n:  fa; d: 2; v: 1),
        (n: sol; d: 2; v: 1),
        (n:  la; d: 2; v: 1),
        (n: sol; d: 4; v: 1),
        (n:  re; d: 1; v: 1),
        (n:   0; d: 1; v: 0),
        (n:  si; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  ut; d: 2; v: 2),
        (n:  si; d: 4; v: 2),
        (n:  la; d: 1; v: 2),
        (n:   0; d: 1; v: 0),
        (n:  si; d: 2; v: 3),
        (n:  ut; d: 2; v: 3),
        (n:  si; d: 1; v: 3),
        (n:   0; d: 1; v: 0),
        (n:  la; d: 2; v: 3),
        (n: sol; d: 2; v: 3),
        (n:  fa; d: 4; v: 3),
        (n: sol; d: 2; v: 3),
        (n:  ut; d: 2; v: 3),
        (n:  si; d: 4; v: 3),
        (n:  la; d: 3; v: 3),
        (n: sol; d: 1; v: 2),
        (n: sol; d: 8; v: 2)
      );
     
    var
      i: integer;
     
    begin
      for i := Low(notes) to High(notes) do
        with notes[i] do
          Jouer(f[n], 200 * d, 30 * v);
    end.
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  15. #15
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Voici une version MIDI.

    Non seulement les possibilités sont supérieures (choix de l'instrument, polyphonie), mais le code sur lequel le programme est bâti est plus simple (comparé à la procédure utilisée dans le programme précédent) !

    Je ne savais pas que c'était aussi facile de faire du MIDI.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
     
    unit Midi;
     
    {&USE32+}
     
    // http://stackoverflow.com/questions/3649429/delphi-library-for-midi-input-output
     
    interface
     
    type
      tMidiInstrument = (midiAcousticGrandPiano, midiBrightAcousticPiano,
                         midiElectricGrandPiano, midiHonkyTonkPiano,
                         midiRhodesPiano, midiChorusedPiano, midiHarpsichord,
                         midiClavinet, midiCelesta, midiGlockenspiel,
                         midiMusicBox, midiVibraphone, midiMarimba, midiXylophone,
                         midiTubularBells, midiDulcimer, midiHammondOrgan,
                         midiPercussiveOrgan, midiRockOrgan, midiChurchOrgan,
                         midiReedOrgan, midiAccordion, midiHarmonica,
                         midiTangoAccordion, midiAcousticGuitarNylon,
                         midiAcousticGuitarSteel, midiElectricGuitarJazz,
                         midiElectricGuitarClean, midiElectricGuitarMuted,
                         midiOverdrivenGuitar, midiDistortionGuitar,
                         midiGuitarHarmonics, midiAcousticBass, midiElectricBassFinger,
                         midiElectricBassPick, midiFretlessBass, midiSlapBass1,
                         midiSlapBass2, midiSynthBass1, midiSynthBass2, midiViolin,
                         midiViola, midiCello, midiContrabass, midiTremoloStrings,
                         midiPizzicatoStrings, midiOrchestralHarp, midiTimpani,
                         midiStringEnsemble1, midiStringEnsemble2, midiSynthStrings1,
                         midiSynthStrings2, midiChoirAahs, midiVoiceOohs,
                         midiSynthVoice, midiOrchestraHit, midiTrumpet, midiTrombone,
                         midiTuba, midiMutedTrumpet, midiFrenchHorn, midiBrassSection,
                         midiSynthBrass1, midiSynthBrass2, midiSopranoSax, midiAltoSax,
                         midiTenorSax, midiBaritoneSax, midiOboe, midiEnglishHorn,
                         midiBassoon, midiClarinet, midiPiccolo, midiFlute,
                         midiRecorder, midiPanFlute, midiBottleBlow, midiShakuhachi,
                         midiWhistle, midiOcarina, midiLead1Square,
                         midiLead2Sawtooth, midiLead3CalliopeLead, midiLead4ChiffLead,
                         midiLead5Charang, midiLead6Voice, midiLead7Fifths,
                         midiLead8BrassLead, midiPad1NewAge, midiPad2Warm,
                         midiPad3Polysynth, midiPad4Choir, midiPad5Bowed,
                         midiPad6Metallic, midiPad7Halo, midiPad8Sweep, midiEmpty0,
                         midiEmpty1, midiEmpty2, midiEmpty3, midiEmpty4, midiEmpty5,
                         midiEmpty6, midiEmpty7, midiEmpty8, midiEmpty9, midiEmpty10,
                         midiEmpty11, midiEmpty12, midiEmpty13, midiEmpty14,
                         midiEmpty15, midiEmpty16, midiEmpty17, midiEmpty18,
                         midiEmpty19, midiEmpty20, midiEmpty21, midiEmpty22,
                         midiEmpty23, midiGuitarFretNoise, midiBreathNoise,
                         midiSeashore, midiBirdTweet, midiTelephoneRing,
                         midiHelicopter, midiApplause, midiGunshot);
     
    procedure MidiInit;
    procedure SetCurrentInstrument(CurrentInstrument: tMidiInstrument);
    procedure NoteOn(NewNote, NewIntensity: byte);
    procedure NoteOff(NewNote, NewIntensity: byte);
    procedure SetPlaybackVolume(PlaybackVolume: cardinal);
     
    implementation
     
    uses
      MMSystem;
     
    const
      MIDI_NOTE_ON = $90;
      MIDI_NOTE_OFF = $80;
      MIDI_CHANGE_INSTRUMENT = $C0;
      MIDI_DEVICE = 0;
      MIDI_VEL = 108;
     
    var
      mo: hMidiOut;
     
    procedure MidiInit;
    begin
      MidiOutOpen(@mo, MIDI_DEVICE, 0, 0, CALLBACK_NULL);
      SetPlaybackVolume(65535);
    end;
     
    function MidiEncodeMessage(Msg, Param1, Param2: integer): integer;
    begin
      result := Msg + (Param1 shl 8) + (Param2 shl 16);
    end;
     
    procedure SetCurrentInstrument(CurrentInstrument: tMidiInstrument);
    begin
      MidiOutShortMsg(mo, MidiEncodeMessage(MIDI_CHANGE_INSTRUMENT, Ord(CurrentInstrument), 0));
    end;
     
    procedure NoteOn(NewNote, NewIntensity: byte);
    begin
      MidiOutShortMsg(mo, MidiEncodeMessage(MIDI_NOTE_ON, NewNote, NewIntensity));
    end;
     
    procedure NoteOff(NewNote, NewIntensity: byte);
    begin
      MidiOutShortMsg(mo, MidiEncodeMessage(MIDI_NOTE_OFF, NewNote, NewIntensity));
    end;
     
    procedure SetPlaybackVolume(PlaybackVolume: cardinal);
    begin
      MidiOutSetVolume(mo, PlaybackVolume);
    end;
     
    end.
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
     
    program Adeste;
     
    {$IFDEF VPASCAL}{&PMTYPE VIO}{&USE32+}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
     
    uses
      Midi, Windows;
     
    (*
     Each musical pitch of a chord is expressed as a MIDI note number (middle C is
     note number 60, so D# above middle C is #61, etc).
    *)
     
    const
      re  = 62;
      mi  = 64;
      fa  = 66; (* fa dièse *)
      sol = 67;
      la  = 69;
      si  = 71;
      ut  = 72;
      re8 = 74;
     
    type
      note = record
        n: byte;    (* Note *)
        d: integer; (* Durée *)
        v: byte;    (* Volume *)
      end;
     
    const
      notes: array[1..68]of note = (
        (n: sol; d: 2; v: 2),
        (n: sol; d: 4; v: 2),
        (n:  re; d: 2; v: 2),
        (n: sol; d: 2; v: 2),
        (n:  la; d: 4; v: 2),
        (n:  re; d: 4; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  ut; d: 2; v: 2),
        (n:  si; d: 4; v: 2),
        (n:  la; d: 2; v: 2),
        (n:   0; d: 1; v: 0),
        (n: sol; d: 1; v: 2),
        (n: sol; d: 4; v: 2),
        (n:  fa; d: 1; v: 2),
        (n:   0; d: 1; v: 0),
        (n:  mi; d: 2; v: 2),
        (n:  fa; d: 2; v: 2),
        (n: sol; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  fa; d: 4; v: 2),
        (n:  mi; d: 3; v: 2),
        (n:  re; d: 1; v: 2),
        (n:  re; d: 6; v: 2),
        (n:   0; d: 2; v: 0),
        (n: re8; d: 4; v: 2),
        (n:  ut; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  ut; d: 4; v: 2),
        (n:  si; d: 4; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n: sol; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  fa; d: 4; v: 2),
        (n:  re; d: 1; v: 2),
        (n:   0; d: 1; v: 0),
        (n: sol; d: 2; v: 1),
        (n: sol; d: 2; v: 1),
        (n:  fa; d: 2; v: 1),
        (n: sol; d: 2; v: 1),
        (n:  la; d: 2; v: 1),
        (n: sol; d: 4; v: 1),
        (n:  re; d: 1; v: 1),
        (n:   0; d: 1; v: 0),
        (n:  si; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  la; d: 2; v: 2),
        (n:  si; d: 2; v: 2),
        (n:  ut; d: 2; v: 2),
        (n:  si; d: 4; v: 2),
        (n:  la; d: 1; v: 2),
        (n:   0; d: 1; v: 0),
        (n:  si; d: 2; v: 3),
        (n:  ut; d: 2; v: 3),
        (n:  si; d: 1; v: 3),
        (n:   0; d: 1; v: 0),
        (n:  la; d: 2; v: 3),
        (n: sol; d: 2; v: 3),
        (n:  fa; d: 4; v: 3),
        (n: sol; d: 2; v: 3),
        (n:  ut; d: 2; v: 3),
        (n:  si; d: 4; v: 3),
        (n:  la; d: 3; v: 3),
        (n: sol; d: 1; v: 2),
        (n: sol; d: 8; v: 2)
      );
     
    procedure Jouer(const n: byte; const d: integer; const v: byte);
    begin
      NoteOn(n, v);
      Sleep(d);
      NoteOff(n, v);
    end;
     
    var
      i: integer;
     
    begin
      MidiInit;
      SetCurrentInstrument(midiTrumpet);
      for i := Low(notes) to High(notes) do
        with notes[i] do
          if n = 0 then
            Sleep(200 * d)
          else
            Jouer(n, 200 * d, 67 + 20 * v);
    end.
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  16. #16
    Responsable Pascal

    Avatar de Alcatîz
    Homme Profil pro Jean-Luc Gofflot
    Ressources humaines
    Inscrit en
    mars 2003
    Messages
    5 942
    Détails du profil
    Informations personnelles :
    Nom : Homme Jean-Luc Gofflot
    Âge : 47
    Localisation : Belgique

    Informations professionnelles :
    Activité : Ressources humaines
    Secteur : Service public

    Informations forums :
    Inscription : mars 2003
    Messages : 5 942
    Points : 37 468
    Points
    37 468

    Par défaut

    Bonjour Roland,
    Citation Envoyé par Roland Chastain Voir le message
    Je ne savais pas que c'était aussi facile de faire du MIDI.
    En effet !

    Avec les flocons en Lazarus et la musique en Delphi, c'est Noël en Pascal !
    Règles du forum
    Tutoriels, exercices, FAQ, sources, compilateurs, outils, livres Pascal
    Mes tutoriels et sources Pascal
    FAQ Assembleur

    Le problème en ce bas monde est que les imbéciles sont sûrs d'eux et fiers comme des coqs de basse cour, alors que les gens intelligents sont emplis de doute. [Bertrand Russell]

  17. #17
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut Démineur API Win32

    Bonjour !

    Je vous propose une traduction en Pascal du Démineur en C de CGi.

    Cette version peut être compilée avec Delphi, FreePascal et Virtual Pascal.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
     
    (* Traduction en Pascal du démineur en C de "CGi" :                           *)
    (* http://chgi.developpez.com/wincode/demineur/                               *)
    (* Compilation testée : Delphi 6, Free Pascal 2.6.2, Virtual Pascal 2.1.      *)
    (* Roland Chastain, 24 janvier 2014.                                          *)
     
    program Demineur;
     
    {$IFDEF VPASCAL}
      {&PMTYPE PM}
      {&H+}
    {$ELSE}
      {$APPTYPE GUI}
      {$IFDEF FPC}
        {$MODE DELPHI}
      {$ENDIF}
      {$WARN SYMBOL_PLATFORM OFF}
    {$ENDIF}
     
    uses
      Messages, Windows;
     
    const
      LARG      =  32;
      NBC_X     =  16;
      NBC_Y     =  12;
      NB_MINE   =  20;
      IDM_QUIT  = 101;
      IDM_NEW   = 102;
      IDM_ABOUT = 103;
     
    type
      tTableau = array[0..NBC_Y - 1, 0..NBC_X - 1]of integer;
     
    var
      hFenetre: HWND;
      hMenu, hSousMenu: tHandle;
      tableau: tTableau;
      fin: boolean;
     
    function Demine(var aTableau: tTableau; const y, x: integer): boolean;
    var
      void: boolean;
    begin
      if (aTableau[y, x] and $10000) > 0 then
        aTableau[y, x] := aTableau[y, x] and $FFFEFFFF
      else
      begin
        Result := FALSE;
        exit;
      end;
      if (aTableau[y, x] and $100) > 0 then
      begin
        Result := TRUE;
        exit;
      end;
      if (aTableau[y, x] and $F) > 0 then
      begin
        Result := FALSE;
        exit;
      end;
      if (y > 0) and (x > 0) then
        void := Demine(aTableau, y - 1, x - 1);
      if (y > 0) then
        void := Demine(aTableau, y - 1, x);
      if (y > 0) and (x < NBC_X - 1) then
        void := Demine(aTableau, y - 1, x + 1);
      if (x > 0) then
        void := Demine(aTableau, y, x - 1);
      if (x < NBC_X - 1) then
        void := Demine(aTableau, y, x + 1);
      if (y < NBC_Y - 1) and (x > 0) then
        void := Demine(aTableau, y + 1, x - 1);
      if (y < NBC_Y - 1) then
        void := Demine(aTableau, y + 1, x);
      if (y < NBC_Y - 1) and (x < NBC_X - 1) then
        void := Demine(aTableau, y + 1, x + 1);
      Result := FALSE;
    end;
     
    procedure Montre(var aTableau: tTableau);
    var
      x, y: integer;
    begin
      for y := 0 to  NBC_Y - 1 do
        for x := 0 to NBC_X - 1 do
          aTableau[y, x] := aTableau[y, x] and $FFFEFFFF;
    end;
     
    function Test(const aTableau: tTableau): boolean;
    var
      x, y: integer;
    begin
      Result := TRUE;
      for y := 0 to NBC_Y - 1 do
        for x := 0 to NBC_X - 1 do
          if ((aTableau[y, x] and $00010000) > 0) and
             ((aTableau[y, x] and $00000100) > 0) then
               Result := FALSE;
    end;
     
    procedure Initialise(var aTableau: tTableau);
    var
      x, y: integer;
      xMine, yMine: integer;
    begin
      for y := 0 to NBC_Y - 1 do
        for x := 0 to NBC_X - 1 do
          aTableau[y, x] := 0;
      x := 0;
      while x < NB_MINE do
      begin
        xMine := Random(NBC_X);
        yMine := Random(NBC_Y);
        if (aTableau[yMine, xMine] and $100) = 0 then
        begin
          aTableau[yMine, xMine] := $100;
          Inc(x);
        end;
      end;
      for y := 0 to NBC_Y - 1 do
        for x := 0 to NBC_X - 1 do
        begin
          if (aTableau[y, x] and $100) > 0 then
          begin
            if (y > 0) and (x > 0) then
              Inc(aTableau[y - 1, x - 1]);
            if (y > 0) then
              Inc(aTableau[y - 1, x]);
            if (y > 0) and (x < NBC_X - 1) then
              Inc(aTableau[y - 1, x + 1]);
            if (x > 0) then
              Inc(aTableau[y, x - 1]);
            if (x < NBC_X - 1) then
              Inc(aTableau[y, x + 1]);
            if (y < NBC_Y - 1) and (x > 0) then
              Inc(aTableau[y + 1, x - 1]);
            if (y < NBC_Y - 1) then
              Inc(aTableau[y + 1, x]);
            if (y < NBC_Y - 1) and (x < NBC_X - 1) then
              Inc(aTableau[y + 1, x + 1]);
          end;
          aTableau[y, x] := aTableau[y, x] or $10000;
        end;
      fin := FALSE;
    end;
     
    function WndProc(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
    var
      x, y: integer;
      xPos, yPos: integer;
      oldPen, drawPen: HPEN;
      drawDC, drawDC2: HDC;
      hBmp: HBITMAP;
      ps: tPaintStruct;
      rect, rect2: tRect;
      hBrsh: HBRUSH;
      s: string;
    begin
      case msg of
        WM_CREATE:
          begin
            Randomize;
            Initialise(tableau);
            Result := 0;
            exit;
          end;
        WM_COMMAND:
          case LoWord(wParam) of
            IDM_QUIT: PostMessage(hWnd, WM_CLOSE, 0, 0);
            IDM_NEW:
              begin
                Initialise(tableau);
                InvalidateRect(hWnd, nil, FALSE);
              end;
            IDM_ABOUT: MessageBox(0, 'Démineur par CGi.'#10#10'Version Pascal par Roland Chastain.', 'A Propos', MB_OK);
          end;
        WM_LBUTTONUP:
          begin
            xPos := LoWord(lParam);
            yPos := HiWord(lParam);
            x := xPos div LARG;
            y := yPos div LARG;
            InvalidateRect(hWnd, nil, FALSE);
            if fin then
            begin
              Result := 0;
              exit;
            end;
            if Demine(tableau, y, x) then
            begin
              Montre(tableau);
              MessageBox(0, 'Désolé, vous avez perdu !', 'Démineur', MB_OK);
              fin := TRUE;
            end else
              if Test(tableau) then
              begin
                MessageBox(0, 'Bravo, vous avez gagné !', 'Démineur', MB_OK);
                fin := TRUE;
              end;
            Result := 0;
            exit;
          end;
        WM_KEYDOWN:
          begin
            if wParam = VK_ESCAPE then
            begin
              PostQuitMessage(0);
              Result := 0;
              Exit;
            end;
          end;
        WM_DESTROY:
          begin
            PostQuitMessage(0);
            Result := 0;
            Exit;
          end;
        WM_PAINT:
        begin
          hBrsh := CreateSolidBrush($CCEECC);
          drawPen := CreatePen(PS_SOLID, 1, 0);
          GetClientRect(hWnd, rect);
          drawDC := BeginPaint(hFenetre, ps);
          drawDC2 := CreateCompatibleDC(drawDC);
          hBmp := CreateCompatibleBitmap(drawDC, rect.right, rect.bottom);
          SelectObject(drawDC2, hBmp);
          oldPen := SelectObject(drawDC2, drawPen);
          FillRect(drawDC2, rect, HBRUSH(COLOR_3DFACE + 1));
          for y := 0 to NBC_Y - 1 do
            for x := 0 to NBC_X - 1 do
            begin
              rect2.left := x * LARG + 1;
              rect2.right := x * LARG + LARG;
              rect2.top := y * LARG + 1;
              rect2.bottom := y * LARG + LARG;
              Rectangle(
                drawDC2,
                x * LARG + 1,
                y * LARG + 1,
                x * LARG + LARG,
                y * LARG + LARG
              );
              SetTextColor(drawDC2, 0);
              if (tableau[y, x] and $100) > 0 then
                DrawText(drawDC2, 'M', 1, rect2, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
              if (tableau[y, x] > 0) and (tableau[y, x] < 9) then
              begin
                Str(tableau[y, x], s);
                if (tableau[y, x] = 1) then SetTextColor(drawDC2, $FF0000);
                if (tableau[y, x] = 2) then SetTextColor(drawDC2, $008F00);
                if (tableau[y, x] = 3) then SetTextColor(drawDC2, $0000FF);
                if (tableau[y, x] >= 4) then SetTextColor(drawDC2, $FF00FF);
                DrawText(drawDC2, pChar(s), 1, rect2, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
              end;
              if (tableau[y, x] and $10000) > 0 then
              begin
                Inc(rect2.left);
                Dec(rect2.right);
                Inc(rect2.top);
                Dec(rect2.bottom);
                FillRect(drawDC2, rect2, hBrsh);
              end;
            end;
          BitBlt(drawDC, 0, 0, rect.right, rect.bottom, drawDC2, 0, 0, SRCCOPY);
          DeleteDC(drawDC2);
          DeleteObject(hBmp);
          EndPaint(hFenetre, ps);
          DeleteObject(hBrsh);
          SelectObject(drawDC, oldPen);
          DeleteObject(drawPen);
          Result := 0;
          Exit;
        end;
      end;
      Result := DefWindowProc(hWnd, msg, wParam, lParam);
    end;
     
    const
      APPNAME = 'Demineur';
     
    var
      wc: tWndClass;
      msg: tMsg;
     
    begin
      Randomize;
      with wc do
      begin
        Style := CS_VREDRAW or CS_HREDRAW;
        lpfnWndProc := @WndProc;
        cbClsExtra := 0;
        cbWndExtra := 0;
        wc.hInstance := HInstance;
        hIcon := LoadIcon(HInstance, IDI_APPLICATION);
        hCursor := LoadCursor(HInstance, IDC_ARROW);
        hbrBackground := COLOR_BTNFACE + 1;
        lpszMenuName := nil;
        lpszClassName:= APPNAME;
      end;
      RegisterClass(wc);
      hSousMenu := CreateMenu;
      AppendMenu(hSousMenu, MF_STRING, IDM_NEW, 'Nouvelle Partie');
      AppendMenu(hSousMenu, MF_MENUBREAK, 0, nil);
      AppendMenu(hSousMenu, MF_STRING, IDM_ABOUT, 'A Propos');
      AppendMenu(hSousMenu, MF_STRING, IDM_QUIT, 'Quitter');
      hMenu := CreateMenu;
      AppendMenu(hMenu, MF_POPUP, hSousMenu, 'Fichier');
      hFenetre := CreateWindow(
        APPNAME,
        'Demineur',
        WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX,
        longint(CW_USEDEFAULT),
        longint(CW_USEDEFAULT),
        LARG * NBC_X + 3 + 4,
        LARG * NBC_Y + 46 + 4,
        0,
        hMenu,
        HInstance,
        nil
      );
      ShowWindow(hFenetre, CMDSHOW);
      UpdateWindow(hFenetre);
      while TRUE do
      begin
        if PeekMessage(msg,0,0,0, PM_REMOVE) then
        begin
          if msg.message = WM_QUIT then
            Break;
          TranslateMessage(msg);
          DispatchMessage(msg);
        end;
      end;
      ExitProcess(msg.wParam);
    end.
    Fichiers attachés Fichiers attachés
    L'Art est long et le Temps est court.

  18. #18
    Responsable Pascal

    Avatar de Alcatîz
    Homme Profil pro Jean-Luc Gofflot
    Ressources humaines
    Inscrit en
    mars 2003
    Messages
    5 942
    Détails du profil
    Informations personnelles :
    Nom : Homme Jean-Luc Gofflot
    Âge : 47
    Localisation : Belgique

    Informations professionnelles :
    Activité : Ressources humaines
    Secteur : Service public

    Informations forums :
    Inscription : mars 2003
    Messages : 5 942
    Points : 37 468
    Points
    37 468

    Par défaut

    Bravo, bel exemple de programme Windows sans surcouche !
    Règles du forum
    Tutoriels, exercices, FAQ, sources, compilateurs, outils, livres Pascal
    Mes tutoriels et sources Pascal
    FAQ Assembleur

    Le problème en ce bas monde est que les imbéciles sont sûrs d'eux et fiers comme des coqs de basse cour, alors que les gens intelligents sont emplis de doute. [Bertrand Russell]

  19. #19
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    Citation Envoyé par Alcatîz Voir le message
    Bravo, bel exemple de programme Windows sans surcouche !
    Merci pour vos encouragements, maître Alcatîz !
    L'Art est long et le Temps est court.

  20. #20
    Rédacteur
    Avatar de Roland Chastain
    Homme Profil pro Roland Chastain
    Inscrit en
    décembre 2011
    Messages
    1 074
    Détails du profil
    Informations personnelles :
    Nom : Homme Roland Chastain
    Âge : 40
    Localisation : France, Moselle (Lorraine)

    Informations forums :
    Inscription : décembre 2011
    Messages : 1 074
    Points : 2 098
    Points
    2 098

    Par défaut

    En retravaillant le Démineur, j'ai cherché à résoudre un problème auquel je me suis plusieurs fois attaqué sans succès, à savoir de déterminer les dimensions d'une fenêtre (les paramètres à passer à CreateWindow()) en fonction de la taille souhaitée du rectangle client.

    Jusqu'à présent la seule solution que j'ai trouvée est de déterminer de façon empirique la différence en largeur et en hauteur. La méthode est fastidieuse et peut-être peu fiable. J'ai cherché à comparer les valeurs que j'obtenais avec les résultats renvoyés par GetSystemMetrics() : je n'ai jamais trouvé la bonne combinaison.

    Là j'ai tenté autre chose, à savoir de retailler la fenêtre à l'exécution avec MoveWindow() jusqu'à avoir le rectangle client que je souhaite. Ce que j'ai fait ne fonctionne pas : la fenêtre disparaît.

    Connaîtriez-vous la bonne façon d'utiliser cette fonction ?
    L'Art est long et le Temps est court.

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •