IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Autres IDE Pascal Discussion :

Dessiner dans une fenêtre avec la librairie OWL [Virtual Pascal]


Sujet :

Autres IDE Pascal

  1. #1
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut Dessiner dans une fenêtre avec la librairie OWL
    Bonjour !

    A partir de cet excellent tutoriel, j'ai écrit un petit exemple qui résume les principes du dessin dans une fenêtre au moyen de la librairie des objets Windows.

    Autrement le point particulier auquel je me suis intéressé, c'est le moyen de faire un dégradé. J'ai repris une formule qui consiste à faire varier la couleur du pixel en fonction d'une distance.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    program Exemple_GDI; {&PMType PM}
     
    uses Windows, oWindows;
     
    type
      pFenetre = ^tFenetre;
      tFenetre = object(tWindow)
                   procedure PAINT (PaintDC : hDC; var PaintInfo : tPaintStruct); virtual;
                   procedure GETWINDOWCLASS (var aWndClass : tWndClass); virtual;
                 end;
      tProgramme = object(tApplication)
                     Procedure INITMAINWINDOW; virtual;
                   end;
     
    var maxDist : single;
     
    function distance (const Ax, Ay, Bx, By : smallInt) : single;
    begin
      distance := sqrt ( sqr ( Bx - Ax ) + sqr ( By - Ay ) );
    end;
     
    function f ( const a, b, c, d, e : single ) : single;
    (* f tel que ( f - d ) / ( e - d ) = ( c - a ) / ( b - a ) *)
    begin
      f := d + ( e - d ) * ( c - a ) / ( b - a );
    end;
     
    procedure tFenetre.PAINT (PaintDC : hDC; var PaintInfo : tPaintStruct);
    var
      ClientRect : tRect;
      x, y : smallInt;
      dist : single;
      couleur: Word;
    Begin
      GetClientRect(hWindow,ClientRect);
      for x := ClientRect.Left to ClientRect.Right do
        for y := ClientRect.Top to ClientRect.Bottom do
          begin
            dist := distance((ClientRect.Right + 1) div 2, (ClientRect.Bottom + 1) div 2, x, y);
            couleur := round(f(0, maxDist, dist, $DD, $44));
            if dist < maxDist then
              SetPixel(PaintDC, x, y, rgb(couleur, couleur, couleur));
          end;
    End;
     
    Procedure tFenetre.GETWINDOWCLASS (var aWndClass : tWndClass);
    Begin
      tWindow.GETWINDOWCLASS(aWndClass);
      aWndClass.hbrBackground := CreateSolidBrush ($444444);
    End;
     
    Procedure tProgramme.INITMAINWINDOW;
    Begin
      MainWindow := New(pFenetre, INIT(Nil, 'Virtual Pascal 2.1'));
    End;
     
    Var Prog : tProgramme;
     
    Begin
      maxDist := sqrt ( sqr( 100 ) + sqr ( 100 ) );
      Prog.INIT('Exemple_GDI');
      Prog.RUN;
      Prog.DONE;
    End.
    Images attachées Images attachées  
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  2. #2
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    Superbe !
    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  3. #3
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut Une fenêtre sans bordure ni barre de titre
    Merci pour vos encouragements, maître Alcatîz !

    Je cherchais comment obtenir une fenêtre qu'on ne puisse pas redimensionner, et je suis tombé sur un parfait petit exemple de fenêtre sans bordure ni barre de titre.

    Je l'ai légèrement modifié pour le rendre un peu plus joli. Je voulais me servir de la procedure Drawtext mais je n'y suis pas arrivé.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    program NoCaption;
     
    (* Fenêtre sans bordure ni barre de titre *)
     
    uses
      WinTypes, WinProcs, OWindows, Strings, Couleurs;
     
    type
      pFenetre = ^tFenetre;
      tFenetre = object(TWindow)
        constructor Init(P: PWindowsObject; AName: PChar);
        procedure SetUpWindow;
          virtual;
        procedure GetWindowClass(var AWndClass: TWndClass);
          virtual;
        procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
          virtual;
        procedure WMLButtonDown(var Msg: TMessage);
          virtual wm_First + wm_LButtonDown;
      end;
     
      TMyApplication = object(TApplication)
        procedure InitMainWindow; virtual;
      end;
     
    constructor tFenetre.Init(P: PWindowsObject; AName: PChar);
    begin
      inherited Init(P, Aname);
      Attr.Style := ws_Visible or ws_PopUp;
      Attr.X := (GetSystemMetrics(SM_CXFULLSCREEN)-400) div 2;
      Attr.Y := (GetSystemMetrics(SM_CYFULLSCREEN)-400) div 2;
      Attr.H := 400;
      Attr.W := 400;
    end;
     
    procedure tFenetre.SetUpWindow;
    begin
      inherited SetUpWindow;
      //PostMessage(HWindow, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
    end;
     
    procedure tFenetre.WMLButtonDown(var Msg: TMessage);
    begin
      CloseWindow;
    end;
     
    procedure tFenetre.GetWindowClass(var AWndClass: TWndClass);
    begin
      tWindow.GetWindowClass(AWndClass);
      //aWndClass.hbrBackground := GetStockObject(GRAY_BRUSH);
      aWndClass.hbrBackground := CreateSolidBrush(OrangeRed);
    end;
     
    procedure tFenetre.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
    var
      S: array[0..100] of Char;
    begin
      StrCopy(S, 'Cliquez-moi !');
      //SetBkColor(PaintDC, Orange);
      SetBkMode(PaintDC, TRANSPARENT);
      TextOut(PaintDC, 10, 10, S, StrLen(S));
    end;
     
    procedure TMyApplication.InitMainWindow;
    begin
      MainWindow := New(pFenetre, Init(nil, 'Steps'));
    end;
     
    var
      MyApp: TMyApplication;
     
    begin
      MyApp.Init('Steps');
      MyApp.Run;
      MyApp.Done;
    end.
    Fichiers attachés Fichiers attachés
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  4. #4
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    Citation Envoyé par Roland Chastain Voir le message
    Je voulais me servir de la procedure Drawtext mais je n'y suis pas arrivé.
    Pour s'en servir, il faut déclarer une variable de type TRect, qui contiendra les coordonnées des points haut/gauche et bas/droite du rectangle dans lequel le texte doit être dessiné.

    Par exemple, pour centrer horizontalement le texte avec une marge supérieure de 50 pixels :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    procedure tFenetre.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
    var
      S: array[0..100] of Char;
      R : tRect;
    begin
      StrCopy(S, 'Bonjour'#13#10'tout'#13#10'le'#13#10'monde !');
      SetBkMode(PaintDC, TRANSPARENT);
      GetClientRect(hWindow,R);
      Inc(R.Top,50);
      DrawText(PaintDC,S,StrLen(S),R,DT_CENTER);
    end;
    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  5. #5
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Parfait ! Merci pour le code.

    Dans la foulée j'ai trouvé comment changer la police.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    procedure tFenetre.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
    var
      S: array[0..100] of Char;
      R: tRect;
      F: hFont;
    begin
      StrCopy(S, 'Bonjour'#13#10'tout'#13#10'le'#13#10'monde !');
      SetBkMode(PaintDC, TRANSPARENT);
      GetClientRect(hWindow, R);
      Inc(R.Top, 50);
      F := CreateFont(40,0,0,0,0,0,0,0,0,0,0,0,0, 'Times New Roman');
      SelectObject(PaintDC, F);
      DrawText(PaintDC, S, StrLen(S), R, DT_CENTER);
    end;
    Alors mettons que je veuille utiliser une police particulière, une police de jeu d'échecs par exemple. Je dois la mettre dans un fichier .res, n'est-ce pas ?

    Je joins le fichier compilé. (Cliquez sur la fenêtre pour la fermer.)
    Images attachées Images attachées  
    Fichiers attachés Fichiers attachés
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  6. #6
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    La plupart des exemples qu'on trouve ici et là sont en C ou C++. A force d'en lire depuis deux jours je commence à m'y faire.

    Je viens de tomber sur l'exemple TYPER.C de Charles Petzold. J'y ai trouvé cette ligne qui permet de rétablir la police par défaut :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    DeleteObject (SelectObject (hdc, GetStockObject (SYSTEM_FONT))) ;
    Autrement j'ai essayé de remplacer "Times New Roman" par le nom d'une police de jeu d'échecs installée dans mon ordinateur : ça marche. Mais sur la façon d'inclure la police dans un fichier ressource, ce que j'ai lu dans l'aide de Workshop m'a paru assez compliqué. J'ouvrirai peut-être une autre discussion sur ce sujet.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  7. #7
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    En fait, la fonction SelectObject retourne toujours le handle de l'objet précédemment sélectionné, ce qui permet de le restaurer très simplement après coup. Il faut d'ailleurs toujours adopter le réflexe de restaurer un contexte de périphérique dans son état initial avant sa libération.

    Pour éviter de recréer la police F à chaque exécution de la méthode Paint, il vaut mieux la créer par exemple dans le constructeur Init, stocker son handle dans un champ de tFenetre et la détruire dans le destructeur Done.

    Au sujet de l'inclusion d'une police comme ressource, de quel type est-elle ?
    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  8. #8
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Citation Envoyé par Alcatîz Voir le message
    Pour éviter de recréer la police F à chaque exécution de la méthode Paint, il vaut mieux la créer par exemple dans le constructeur Init, stocker son handle dans un champ de tFenetre et la détruire dans le destructeur Done.


    Citation Envoyé par Alcatîz Voir le message
    Au sujet de l'inclusion d'une police comme ressource, de quel type est-elle ?
    C'est une police True Type. Voici mon code, que j'ai écrit avant de lire ta remarque ci-dessus. La correction sera faite dans la prochaine version.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    program Exemple_GDI;
    {&PMType PM}
     
    uses
      Windows, oWindows, Strings, Couleurs;
     
    type
      pFenetre = ^tFenetre;
      tFenetre = object(tWindow)
                   procedure PAINT(PaintDC: hDC;
                                   var PaintInfo: tPaintStruct); virtual;
                 end;
     
      tProgramme = object(tApplication)
                     procedure INITMAINWINDOW; virtual;
                   end;
     
    procedure tFenetre.PAINT (PaintDC : hDC;
                              var PaintInfo : tPaintStruct);
    var
      S: array[0..100] of Char;
      R: tRect;
      Utrecht: hFont;
      OldFont: hFont;
    begin
      SetBkColor(PaintDC, Lavender);
      SetTextColor(PaintDC, PrussianBlue);
     
      Utrecht := CreateFont(60,0,0,0,
                            FW_LIGHT,0,0,0,
                            DEFAULT_CHARSET,0,0,0,0,
                            'Chess Utrecht');
     
      OldFont := SelectObject(PaintDC, Utrecht);
     
      GetClientRect(hWindow,R);
     
      {5111111116
       3RMBWKVNT2
       3OPOPOPOP2
       3 / / / /2
       3/ / / / 2
       3 / / / /2
       3/ / / / 2
       3popopopo2
       3TNVQLBMR2
       7444444448}
     
      StrCopy(S, 'KkQqRr'#13#10'BbNnPp'#13#10'LlWwTt'#13#10'VvMmOo');
     
      DrawText(PaintDC, S, StrLen(s), R, DT_LEFT);
     
      DeleteObject(SelectObject(PaintDC, OldFont));
    end;
     
    Procedure tProgramme.INITMAINWINDOW;
    Begin
      MainWindow := New(pFenetre,
                        INIT(Nil, 'Chess Utrecht by Hans Bodlaender')
                        );
    End;
     
    Var
      Prog : tProgramme;
     
    Begin
      Prog.INIT('Exemple_GDI');
      Prog.RUN;
      Prog.DONE;
    End.
    Images attachées Images attachées  
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  9. #9
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    Citation Envoyé par Roland Chastain Voir le message
    C'est une police True Type.
    Cela ne me semble pas évident du tout et je n'ai jamais essayé.

    A priori, je pense que, dans Borland Resource Workshop, il faut faire File / Add file to project, sélectionner comme type de ressource User resource data puis choisir le fichier ttf ; il faut alors créer un nouveau type de ressource (par exemple TTFFONT) et attribuer à ce nouveau type un identificateur supérieur à 255.

    Dans le programme, le handle de la ressource peut être retourné par la fonction FindResource et ce handle peut être utilisé avec la fonction LoadResource. Cette dernière fonction contient un handle vers un bloc de mémoire globale ; pour obtenir l'adresse réelle de la ressource, je pense qu'il faut utiliser LockResource. Ensuite, cela se corse car je pense qu'il faut faire appel à la fonction AddFontMemResourceEx, qui n'est pas implémentée dans Virtual Pascal et qu'il faut déclarer comme fonction externe dans la bibliothèque gdi32.

    Bref, ça me semble assez compliqué. Mais à coeur vaillant, rien d'impossible !

    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  10. #10
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Merci pour l'explication. Je vais continuer à étudier la question. En attendant, je me contenterai d'inclure le fichier TTF dans mon archive.

    J'ai modifié l'exemple "GDI Demo" de TPW pour ne garder que la partie concernant les polices de caractères. J'ai tenté, sans succès jusqu'à présent, d'en faire une version Virtual Pascal. Le code se compile, mais à l'exécution la fenêtre ne s'ouvre pas.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    program Fonts; {GDIDemo;}
     
    // version VP à corriger
     
    {$IFDEF VER15}
    uses
      WinProcs,
      WinTypes,
      WObjects,
      Strings;
    {$ENDIF}
     
    {$IFDEF VPASCAL}
    {&PMTYPE PM}
    uses
      Windows,
      oWindows,
      Strings;
    {$ENDIF}
     
    const
      MaxNumFonts = 20;
     
    function Min(X, Y: Integer): Integer;
    begin
      if X > Y then Min := Y else Min := X;
    end;
     
    { TBaseDemoWindow -------------------------------------------------- }
     
    type
      PBaseDemoWindow = ^TBaseDemoWindow;
      TBaseDemoWindow = object(TWindow)
                        end;
     
    { TNoIconWindow ---------------------------------------------------- }
    { TMoveToLineToWindow ---------------------------------------------- }
    { TFontWindow ------------------------------------------------------ }
     
    type
      FontInfoRec = record
        Handle: HFont;
        Height: Byte;
        Width: LongInt;
        Name: array[0..lf_FaceSize-1] of char;
      end;
     
    const
      FontUsers: Integer = 0;
     
    var
      FontInfo: array[0..MaxNumFonts] of FontInfoRec;
      NumFonts: Integer;
      TheDC: HDC;
     
    type
      PFontWindow = ^TFontWindow;
      TFontWindow = object(TBaseDemoWindow)
        FontsHeight: LongInt;
        FontsWidth: LongInt;
        constructor
          Init(AParent: PWindowsObject; ATitle: PChar);
        procedure
          Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
        procedure
          Destroy; virtual;
        procedure
          WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
      end;
     
    function EnumerateFont(var LogFont: TLogFont; TextMetric: PTextMetric;
      FontType: Integer; Data: PChar): Integer; export;
    var
      OldFont: HFont;
    begin
      FontInfo[NumFonts].Handle := CreateFontIndirect(LogFont);
      with LogFont do
      begin
        FontInfo[NumFonts].Height := lfHeight;
        StrCopy(FontInfo[NumFonts].Name, lfFaceName);
        OldFont := SelectObject(TheDC, FontInfo[NumFonts].Handle);
     
        {$IFDEF VER15}
        FontInfo[NumFonts].Width := Word(
        GetTextExtent(TheDC, lfFaceName, StrLen(lfFaceName)));
        {$ENDIF}
     
        {$IFDEF VPASCAL}
        FontInfo[NumFonts].Width := lf_FaceSize;  // à vérifier
        {$ENDIF}
     
        SelectObject(TheDC, OldFont);
      end;
      Inc(NumFonts);
      if NumFonts > MaxNumFonts then
        EnumerateFont := 0
      else
        EnumerateFont := 1;
    end;
     
    procedure GetFontInfo;
    var
      EnumProc: TFarProc;
    begin
      if FontUsers = 0 then
      begin
        TheDC := GetDC(GetFocus);
        NumFonts := 0;
        EnumProc := MakeProcInstance(@EnumerateFont, HInstance);
        EnumFonts(TheDC, nil, EnumProc, nil);
        FreeProcInstance(EnumProc);
        ReleaseDC(GetFocus, TheDC);
      end;
      Inc(FontUsers);
    end;
     
    procedure ReleaseFontInfo;
    var
      I: Integer;
    begin
      Dec(FontUsers);
      if FontUsers = 0 then
        for I := 0 to NumFonts - 1 do
          DeleteObject(FontInfo[I].Handle);
    end;
     
    constructor TFontWindow.Init(AParent: PWindowsObject; ATitle: PChar);
    var
      I: Integer;
     
      function Max(I, J: LongInt): LongInt;
      begin
        if I > J then Max := I else Max := J;
      end;
     
    begin
      TBaseDemoWindow.Init(AParent, ATitle);
      GetFontInfo;
      Attr.Style := Attr.Style or ws_VScroll or ws_HScroll;
      FontsHeight := 0;
      FontsWidth := 0;
      for I := 0 to NumFonts - 1 do
      begin
        Inc(FontsHeight, FontInfo[I].Height);
        FontsWidth := Max(FontsWidth, FontInfo[I].Width);
      end;
      Scroller := New(PScroller, Init(@Self, 1, 1, 0, 0));
    end;
     
    procedure TFontWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
    var
      I: Integer;
      Position: Integer;
    begin
      Position := 0;
      for I := 0 to NumFonts - 1 do
      begin
        SelectObject(PaintDC, FontInfo[I].Handle);
        TextOut(PaintDC, 10, Position, FontInfo[I].Name,
          StrLen(FontInfo[I].Name));
        Inc(Position, FontInfo[I].Height);
      end;
    end;
     
    procedure TFontWindow.Destroy;
    var
      I: Integer;
    begin
      TBaseDemoWindow.Destroy;
      ReleaseFontInfo;
    end;
     
    procedure TFontWindow.WMSize(var Msg: TMessage);
    begin
      TWindow.WMSize(Msg);
      if Scroller <> nil then
        Scroller^.SetRange(FontsWidth - Msg.lParamLo + 10,
          FontsHeight - Msg.lParamHi);
    end;
     
    { TBitBltWindow ---------------------------------------------------- }
    { TArtyWindow ------------------------------------------------------ }
    { TGDIDemoWindow --------------------------------------------------- }
    { TGDIDemoApp ------------------------------------------------------ }
     
    type
      TGDIDemoApp = object(TApplication)
        procedure InitMainWindow; virtual;
      end;
     
    procedure TGDIDemoApp.InitMainWindow;
    begin
      MainWindow := New(PFontWindow, Init(Nil, 'Fonts Demo'));
    end;
     
    var
      GDIDemoApp: TGDIDemoApp;
     
    begin
      GDIDemoApp.Init('GDIDEMO');
      GDIDemoApp.Run;
      GDIDemoApp.Done;
    end.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  11. #11
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    Citation Envoyé par Roland Chastain Voir le message
    mais à l'exécution la fenêtre ne s'ouvre pas.
    Une exception est déclenchée dans la fonction EnumerateFont. Cette exception disparaît lorsqu'on lui donne comme dernier paramètre l'adresse d'une variable de type lParam, et non Nil.

    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  12. #12
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Merci pour l'indication. Voici la modification que j'ai faite :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    EnumFonts(TheDC, nil, EnumProc, @NumFonts); // ?
    Apparemment il y a d'autres parties du code qui ne fonctionnent pas, mais ça n'a pas tant d'importance. Je ne sais pas ce qui m'a pris de vouloir adapter ce code alors que j'avais déjà suffisamment d'exemples à étudier. J'y reviendrai peut-être plus tard.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  13. #13
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    Surtout que plusieurs fonctions utilisées dans l'exemple de TPW sont obsolètes et n'existent plus dans l'API de Windows que par souci de compatibilité avec l'API 16 bits.

    Par exemple, GetTextExtent est à présent remplacée par GetTextExtentPoint, qui fonctionne de la même façon sauf qu'il faut lui passer comme paramètre une structure de type TSize. Autre exemple : EnumFonts est remplacée par EnumFontFamilies, qui nécessite comme fonction callback une fonction de type EnumFontFamProc, dont les paramètres sont quelque peu différents de la fonction EnumerateFont.



    P.S. Dans les exemples fournis avec Virtual Pascal, il y a un programme CHESS dans le répertoire W32.
    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  14. #14
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut Usage de la fonction SetRect()
    Pour mettre en pratique ces nouvelles connaissances, j'ai commencé un jeu d'échecs.

    Afin que l'échiquier soit redessiné quand une pièce a été déplacée, j'ai utilisé l'instruction suivante :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    InvalidateRect(hWindow, nil, true);
    Ça fonctionne mais ce n'est pas très esthétique. L'échiquier étant un texte et non pas un dessin point par point, il y a un blanc entre les deux images.

    Après consultation de l'aide de Win32, j'ai pensé changer la valeur du second paramètre au moyen de la fonction SetRect() afin que seules les cases modifiées soient redessinées. Seulement je ne sais pas ce que c'est qu'une "structure Rect" et je connais encore moins son adresse.

    Comment déclarer et manipuler une "structure Rect" ?
    Fichiers attachés Fichiers attachés
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  15. #15
    Responsable Pascal, Lazarus et Assembleur


    Avatar de Alcatîz
    Homme Profil pro
    Ressources humaines
    Inscrit en
    Mars 2003
    Messages
    7 930
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : Belgique

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

    Informations forums :
    Inscription : Mars 2003
    Messages : 7 930
    Points : 59 398
    Points
    59 398
    Billets dans le blog
    2
    Par défaut
    Tu peux très utilement consulter le code source de l'unité Windows, qui se trouve dans le répertoire Source\Rtl.
    La déclaration du type TRect est :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Type tPoint = Record
                    X : Long;
                    Y : Long;
                  end;
         tRect = Record
                   case Integer of
                     0 : (Left, Top, Right, Bottom : Integer);
                     1 : (TopLeft, BottomRight : tPoint);
                 end;
    Dans ta méthode WMLButtonDown, tu peux déclarer une variable locale de type TRect. Tu peux assigner les valeurs des champs Left, Top, Right et Bottom soit directement, soit à l'aide de la fonction SetRect. Tu passes cette variable comme paramètre à la fonction InvalidateRect.
    Un petit truc : pour forcer le réaffichage immédiat du petit rectangle qui est rendu invalide par InvalidateRect, tu peux exécuter UpdateWindow tout de suite après.



    P.S. A l'exécution, j'obtiens plein d'exceptions dans l'unité Moteur. Je vais voir où se situe(nt) le(s) problème(s).

    [Edit]
    J'ai trouvé ceci :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    tablier: array[-10..109] of longint;
    
    for i := -9 to 110 do tablier[i] := horsJeu;
    [/Edit]
    Règles du forum
    Cours et tutoriels Pascal, Delphi, Lazarus et Assembleur
    Avant de poser une question, consultez les FAQ Pascal, Delphi, Lazarus et Assembleur
    Mes tutoriels et sources Pascal

    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]
    La tolérance atteindra un tel niveau que les personnes intelligentes seront interdites de toute réflexion afin de ne pas offenser les imbéciles. [Fiodor Mikhaïlovitch Dostoïevski]

  16. #16
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Citation Envoyé par Alcatîz Voir le message
    Dans ta méthode WMLButtonDown, tu peux déclarer une variable locale de type TRect. Tu peux assigner les valeurs des champs Left, Top, Right et Bottom soit directement, soit à l'aide de la fonction SetRect. Tu passes cette variable comme paramètre à la fonction InvalidateRect.
    Impeccable !

    Et en changeant également la valeur du troisième paramètre, le résultat est parfait. J'ai écrit un exemple qui permet de comparer les différentes possibilités :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    program Ex_InvalidateRect;
     
    {$Define version_1}
    {-$Define version_2}
    {-$Define version_3}
     
    {&PMType PM}
     
    uses
      Windows, OWindows;
     
    type
      pFen = ^tFen;
      tFen = object(tWindow)
               procedure Paint(PaintDC: hDC; var PaintInfo: tPaintStruct);
                 virtual;
               procedure WMLButtonDown(var msg: tMessage);
                 virtual wm_First + wm_LButtonDown;
             end;
     
      tProgramme = object(tApplication)
                     procedure InitMainWindow; virtual;
                   end;
     
    function f(const a, b, c, d, e: single): longInt;
    {
      f tel que (f-d)/(e-d) = (c-a)/(b-a)
    }
    begin
      f := round( d + (e-d) * (c-a) / (b-a) );
    end;
     
    var
      rouge: byte = 0;
     
    procedure tFen.Paint(PaintDC : hDC; var PaintInfo : tPaintStruct);
    var 
      x, y: longInt;
    begin
      for x := 0 to 599 do for y := 0 to 99 do
        SetPixel(PaintDC, x, y, rgb(rouge, 0, f(0, 599, x, 0, 255)));
    end;
     
    procedure tFen.WMLButtonDown(var msg: TMessage);
    var
      R: tRect;
    begin
     {R.Left := 0;
      R.Top := 25;
      R.Right := 599;
      R.Bottom := 74;}
     
      SetRect(R, 0, 25, 599, 74);
     
      rouge := 255;
     
      {$IfDef version_1}
      InvalidateRect(hWindow, Nil, True);
      {$EndIf}
     
      {$IfDef version_2}
      InvalidateRect(hWindow, @R, True);
      {$EndIf}
     
      {$IfDef version_3}
      InvalidateRect(hWindow, @R, False);
      {$EndIf}
    end;
     
    Procedure tProgramme.InitMainWindow;
    Begin
      MainWindow := New(pFen, INIT(Nil,
        'Cliquez dans la fen'#234'tre pour appeler '+
        'la proc'#233'dure InvalidateRect'));
    End;
     
    Var
      Prog : tProgramme;
     
    Begin
      Prog.INIT('Ex_InvalidateRect');
      Prog.RUN;
      Prog.DONE;
    End.
    Citation Envoyé par Alcatîz Voir le message
    Un petit truc : pour forcer le réaffichage immédiat du petit rectangle qui est rendu invalide par InvalidateRect, tu peux exécuter UpdateWindow tout de suite après.
    Bon à savoir !

    Citation Envoyé par Alcatîz Voir le message
    J'ai trouvé ceci :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    tablier: array[-10..109] of longint;
    
    for i := -9 to 110 do tablier[i] := horsJeu;
    Il y a un léger problème en effet.
    Merci pour le test et pour le compte-rendu.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Zone de Dessin dans une fenêtre [GTK 3 & Cairo]
    Par Twice22 dans le forum GTK+ avec C & C++
    Réponses: 14
    Dernier message: 04/05/2013, 11h41
  2. Dessiner dans une fenêtre externe à mon application
    Par fatdarron dans le forum Langage
    Réponses: 6
    Dernier message: 15/03/2010, 16h13
  3. Réponses: 2
    Dernier message: 18/12/2008, 15h15
  4. problème de dessin dans une JApplet avec GridBagLayout
    Par esperal dans le forum Agents de placement/Fenêtres
    Réponses: 1
    Dernier message: 26/05/2008, 10h46
  5. problème de dessin dans une fenêtre
    Par Mat 74 dans le forum Windows
    Réponses: 8
    Dernier message: 12/04/2007, 12h44

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo