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

[Roland Chastain]

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 :

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.

[Alcatîz]

Superbe !

[Roland Chastain]

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 :

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.

[Alcatîz]

Envoyé par Roland Chastain

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 :

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;

[Roland Chastain]

Parfait ! Merci pour le code.

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

Code :

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.)

[Roland Chastain]

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 :

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.

[Alcatîz]

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 ?

[Roland Chastain]

Envoyé par Alcatîz

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.

Envoyé par Alcatîz

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 :

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.

[Alcatîz]

Envoyé par Roland Chastain

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 !

[Roland Chastain]

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 :

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.

[Alcatîz]

Envoyé par Roland Chastain

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.

[Roland Chastain]

Merci pour l'indication. Voici la modification que j'ai faite :

Code :

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.

[Alcatîz]

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.

[Roland Chastain]

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 :

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" ?

[Alcatîz]

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 :

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 :

1
2
3
tablier: array[-10..109] of longint;

for i := -9 to 110 do tablier[i] := horsJeu;

[/Edit]

[Roland Chastain]

Envoyé par Alcatîz

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 :

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.

Envoyé par Alcatîz

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 !

Envoyé par Alcatîz

J'ai trouvé ceci :

Code :

Il y a un léger problème en effet.
Merci pour le test et pour le compte-rendu.