Discussion :

[Paul TOTH]

première chose à vérifier, c'est que le second Now est > en premier

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
 
procedure TDrawThread.Execute;
begin
  var DC := GetDC(HWnd);
  while not Terminated do
  begin
    var T1 := Now;
    var S := FormatDateTime('hh:nn:ss.zzz', T1);
    Winapi.Windows.TextOut(DC, 10, 10, PChar(S), Length(S));
    var T2 := Now;
    Assert(T2 > T1);
    S := FormatDateTime('hh:nn:ss.zzz', T2) + ' *';
    Winapi.Windows.TextOut(DC, 10, 30, PChar(S), Length(S));
    Sleep(45);
  end;
end;

ensuite, cela peut s'expliquer par le balayage écran qui tomberait entre les deux textes (et non sur le texte comme dans ta photo avec 431 et 446)

[Paul TOTH]

tient, je t'invite à tester un rendu OpenGL en double buffered avec VSync activé (ou pas)

c'est un peu plus compliqué que GDI car OpenGL est une API graphique, donc pour afficher du texte il faut un peu de boulot (il y a d'autres méthodes mais j'aime bien celle-ci)

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
 
unit Unit1;
 
interface
 
uses
  Winapi.OpenGL,
  Winapi.OpenGLext,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Déclarations privées }
    FDC: HDC;
    FGL: HGLRC;
    FFont: Integer;
    procedure createBitmapFont;
  public
    { Déclarations publiques }
    procedure CreateWnd; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
 
{ TForm1 }
 
const
  FONT_TEXTURE_SIZE = 512;
var
  FontSizes: array[#0..#255] of TSize;
 
function glTextOut(x, y, FontSize: Single; const Str: AnsiString): Integer;
const
  t = 16/FONT_TEXTURE_SIZE;
begin
  Result := 0;
  glBegin(GL_QUADS);
  for var I := 1 to Length(Str) do
  begin
    var c := Str[I];
 
    var u1 := ((Ord(c) mod 16) * FONT_TEXTURE_SIZE / 16) / FONT_TEXTURE_SIZE;
    var v1 := ((Ord(c) div 16) * FONT_TEXTURE_SIZE / 16) / FONT_TEXTURE_SIZE;
    var u2 := u1 + FontSizes[c].cx / FONT_TEXTURE_SIZE;
    var v2 := v1 + FontSizes[c].cy / FONT_TEXTURE_SIZE;
    var x2 := x + FontSizes[c].cx * FontSize / 32;
    var y2 := y + FontSizes[c].cy * FontSize / 32;
    glTexCoord2f(u2, v1); glVertex3f(x2, y , 0);
    glTexCoord2f(u1, v1); glVertex3f(x , y , 0);
    glTexCoord2f(u1, v2); glVertex3f(x , y2, 0);
    glTexCoord2f(u2, v2); glVertex3f(x2, y2, 0);
    Inc(Result, Round(FontSizes[c].cx * FontSize / 32));
    x := x2;
 
  end;
  glEnd();
end;
 
procedure TForm1.createBitmapFont;
var
  c: AnsiChar;
begin
  var B := TBitmap.Create;
  B.PixelFormat := pf32Bit;
  B.SetSize(512, 512);
 
  B.Canvas.Font.Name := 'Arial';
  B.Canvas.Font.Size := 16;
 
  var DC := B.Canvas.Handle;
  for c := #0 to #255 do
  begin
    var X := 32 * (Ord(c) mod 16);
    var Y := 32 * (Ord(c) div 16);
    TextOutA(DC, X, Y, @C, 1);
    GetTextExtentPoint32A(DC, @C, 1, FontSizes[C]);
  end;
 
 
  glGenTextures(1, @FFont);
  glBindTexture(GL_TEXTURE_2D, FFont);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
 
  var P: TArray<Cardinal>;
  var S: PCardinal;
 
  SetLength(P, 512 * 512);
  for var y := 0 to 511 do
  begin
    S := B.ScanLine[y];
    for var x := 0 to 511 do
    begin
      var color := 255 - S^ and $FF;
      P[512 * y + x] := ($FFFFFF - (S^ and $FFFFFF)) or (color shl 24);
      Inc(S);
    end;
  end;
 
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 512, 512, 0, GL_RGBA, GL_UNSIGNED_BYTE, P);
 
  B.Free;
end;
 
procedure TForm1.CreateWnd;
begin
  inherited;
 
  FDC := GetDC(Handle);
  if FDC = 0 then
    RaiseLastOSError;
 
  var pfd: TPIXELFORMATDESCRIPTOR;
  FillChar(pfd, SizeOf(pfd), 0);
  pfd.nSize       := sizeof(pfd);
  pfd.nVersion    := 1;
  pfd.dwFlags     := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
  pfd.iLayerType  := PFD_MAIN_PLANE;
  pfd.iPixelType  := PFD_TYPE_RGBA;
  pfd.cColorBits  := 32;
  pfd.iLayerType  := PFD_MAIN_PLANE;
  pfd.cStencilBits:= 0;
 
  var PixelFormat := ChoosePixelFormat(FDC, @pfd);
  if PixelFormat = 0 then
    RaiseLastOSError;
 
  if not SetPixelFormat(FDC, pixelformat, @pfd) then
    RaiseLastOSError;
 
  FGL := wglCreateContext(FDC);
 
  wglMakeCurrent(FDC, FGL);
 
  Winapi.OpenGLext.InitOpenGLext;
 
  wglSwapIntervalEXT(1); // Activer VSync
 
  CreateBitmapFont;
 
  FormResize(Self);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  if FGL <> 0 then
  begin
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    glOrtho(0, ClientWidth, ClientHeight, 0, -100, +100);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
    glViewport(0, 0, ClientWidth, ClientHeight);
  end;
  Invalidate;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, FFont);
  glEnable(GL_ALPHA_TEST);
  glAlphaFunc(GL_GREATER, 0.1);
 
  glTextOut(10, 10, 40, FormatDateTime('hh:nn:ss.zzz', Now));
 
  SwapBuffers(FDC);
 
  InvalidateRect(Handle, nil, False); // boucle éternelle
end;
 
end.

[_alx_]

ensuite, cela peut s'expliquer par le balayage écran qui tomberait entre les deux textes (et non sur le texte comme dans ta photo avec 431 et 446)

Oui, c'est ce que je viens de comprendre et que tu confirmes: l'affichage montre, dans chaque 60ème de seconde et dans le sens du balayage du bas vers le haut, l'état de la mémoire graphique telle qu'elle est remplie à cet instant. Donc, une ligne située plus bas peut être montrée mais avoir été créée antérieurement à une ligne située plus haut, puisqu'elle n'a pas encore été modifiée.

Du coup, ça explique 16 ms de décalage, et ça pourrait même peut-être expliquer les valeurs plus élevées constatées en cas de multi-buffering x5 ou x6 (comme l'a suggéré ShailLeTroll).

[_alx_]

tient, je t'invite à tester un rendu OpenGL en double buffered avec VSync activé (ou pas)

merci , je vais essayer dès que possible.

[Paul TOTH]

note que ce que j'ai mis dans FormPaint doit pouvoir se faire aussi dans une boucle indépendante...voir dans un Thread ? je n'ai pas testé...là j'utilise InvalidateRect (à ne pas mettre dans une boucle) qui va relancer un WM_PAINT sans WM_ERASEBKGND (dernier paramètre à False) contrairement au Invalide de la VCL...on a donc un WM_PAINT en boucle.

pour des questions de "ms" en moins on doit pouvoir aussi utiliser une procedure WMPaint(var Msg: TMessage); message WM_PAINT vu qu'on utilise rien de la VCL

oui d'ailleurs ça donne ça

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
 
procedure TForm1.Render;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, FFont);
  glEnable(GL_ALPHA_TEST);
  glAlphaFunc(GL_GREATER, 0.1);
 
  glTextOut(10, 10, 40, FormatDateTime('hh:nn:ss.zzz', Now));
 
  SwapBuffers(FDC);
end;
 
procedure TForm1.WMPaint(var Msg: TMessage);
begin
  Render;
end;

même plus besoin d'invalidate car normalement WM_PAINT appelle Validate(), ce que je ne fais pas ici

[ShaiLeTroll]

indépendante...voir dans un Thread ?

With multithread applications, flush the drawing commands in any other threads drawing to the same window before calling SwapBuffers.

Si tu n'as qu'un thread, ça doit pouvoir se faire, tu fais tourner ton thread avec juste un Sleep(0)
En mutli-thread, il semble falloir prendre des précautions, est-ce que la VCL peut pertuber quelque chose (un WMPaint avec un corps vide devrait laisser le thread secondaire d'aller à fond)

[_alx_]

tient, je t'invite à tester un rendu OpenGL en double buffered avec VSync activé (ou pas)

Ca ne change strictement rien de GDI à OpenGL, ni en activant ou non le VSync.
Il y a toujours ~90 ms de décalage dans tous les cas, pour un timer à 45 ms et une video à 9 ips.
Le décalage est seulement de ~65 ms avec un timer à 15 ms. Rien de nouveau.

[Paul TOTH]

ok, par contre tu ne devrais plus avoir de chevauchement avec VSync activé tu peux ajouter un second temps

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
  glTextOut(10, 10, 40, FormatDateTime('hh:nn:ss.zzz', Now));
  glTextOut(10, 50, 40, FormatDateTime('hh:nn:ss.zzz', Now));

[_alx_]

ok, par contre tu ne devrais plus avoir de chevauchement avec VSync activé tu peux ajouter un second temps

Désolé , mais je viens de vérifier que les deux lignes restent identiques en OpenGL, que Vsync soit ou non activé