| Autor |
Beitrag |
Symbroson
 
Beiträge: 382
Erhaltene Danke: 67
Raspbian, Ubuntu, Win10
C, C++, Python, JavaScript, Lazarus, Delphi7, Casio Basic
|
Verfasst: Di 07.11.17 00:34
Hallo EE
Nachdem ich es endlich geschafft habe, mir die Delphi Starter-Edition zu holen, hab ich die von jaenicke empfohlene Direct2DCanvas ausprobieren wollen.
 jaenicke hat folgendes geschrieben  : | In neueren Delphiversionen, dazu zählt auch die kostenlose Starter Edition, ist die Hardwarebeschleunigung bereits direkt verfügbar. Einerseits mit Firemonkey, andererseits mit einem Direct2D-Canvas, der hier beschrieben ist:
docwiki.embarcadero.com/RADStudio/Tokyo/de/Die_Direct2D-Zeichenfläche
Beides ist sehr viel einfacher als direkt mit der OpenGL oder DirectX API zu arbeiten. Es gibt alternativ natürlich auch noch 2D Grafikengines, aber auch das ist etwas komplizierter als die direkt in Delphi verfügbaren Varianten. |
Leider bin ich ehrlich gesagt etwas enttäuscht, da mein doch relativ simpel gehaltenes Beispielprogramm nur etwa 10 fps erreicht.
Außerdem mag Delphi die Resize-Funktion nicht:
  Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
| procedure TForm1.WMSize(var Message: TWMSize);
begin
if Assigned(FCanvas) then
ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(D2D1SizeU(ClientWidth, ClientHeight));
inherited;
end; |
Die Grundlage bot mir diese Seite: docwiki.embarcadero...._the_Direct2D_Canvas
Ich hab hier einen Thread dazu gefunden:
stackoverflow.com/qu...oing-something-wrong
Davon habe ich FD2DCanvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_ALIASED); ausprobiert, hat aber nichts gebracht.
Zu guter letzt scheint es bei der Canvas und Formgröße einen Fehler zu geben. Ist auch gut im Beispiel zu sehen, wenn man die Form vergrößert bzw verkleinert. Die Canvasgröße wächst schneller als die Form, wodurch mein Ball verzerrt wird, und ggf das Fenster verlässt.
Ich hoffe, jemand kann mir bei den drei Problemchen helfen 
LG,
Symbroson
PS: mir ist außerdem aufgefallen, dass die exe Dateien der Starter-Edition viel größer als die von Delphi7 sind - hat das irgendeinen speziellen Grund? Zum Vergleich: AlgoSort.exe kompiliert mit Delphi7 war ca 500KB groß, dieses Beispielbrogramm aus der Starter ganze 2.16MB! Dabei ist es vom Umpfang her viel kleiner. (wie groß die importierten Units am Ende sind, kann ich nicht bewerten)
Einloggen, um Attachments anzusehen!
_________________ most good programmers do programming not because they expect to get paid or get adulation by the public, but because it's fun to program. (Linus Torvalds)
|
|
Symbroson 
Beiträge: 382
Erhaltene Danke: 67
Raspbian, Ubuntu, Win10
C, C++, Python, JavaScript, Lazarus, Delphi7, Casio Basic
|
Verfasst: Di 07.11.17 13:32
Ok nach diesem msdn.microsoft.com/e...372260(v=vs.85).aspx Arikel soll man zusätzlich Bitmaps benutzen. Ist das der richtige Ansatz? Klingt zumindest Vernünftig. Nur warum können die das auf der anderen Seite von der ich den Code als Grundlage genutzt habe nicht auch gleich so machen? Sehr Einsteigerfreundlich... _________________ most good programmers do programming not because they expect to get paid or get adulation by the public, but because it's fun to program. (Linus Torvalds)
|
|
Symbroson
Beiträge: 382
Erhaltene Danke: 67
Raspbian, Ubuntu, Win10
C, C++, Python, JavaScript, Lazarus, Delphi7, Casio Basic
|
Verfasst: Di 07.11.17 16:33
Nein, auch die Graphics.TBitmap bringt keinen Geschwindigkeitsschub. Irgendwas hab ich noch mit nem RenderTarget gelesen, aber so kompliziert kann es doch nicht sein...
Das wäre dann ja schwieriger als OpenGL, dabei sollte das Gegenteil gelten
Wenn ich nur TBitmap nehme und die auf Form1.Canvas bzw auf eine TPaintBox Zeichne bekomme ich ca 500 fps. Komischerweise erreicht hier auch OpenGL diese Bildrate.
Edit: ich hab mal 1000 rechtecke zeichnen lassen, TBitmap/TCanvas ist dann bei ca 30, OpenGL bei 60 fps. Das bei Direct2D auszuprobieren halte ich derzeit für nicht sinnvoll.
_________________ most good programmers do programming not because they expect to get paid or get adulation by the public, but because it's fun to program. (Linus Torvalds)
|
|
Symbroson
Beiträge: 382
Erhaltene Danke: 67
Raspbian, Ubuntu, Win10
C, C++, Python, JavaScript, Lazarus, Delphi7, Casio Basic
|
Verfasst: Di 07.11.17 18:44
Entschuldigung, mit der Bildrate bei Direct2D habe ich mich vermutlich vertan - Selbst 1000 rechtecke sehen sehr flüssig aus. Gilt bei D2D die Funktion QueryPerformance[Counter/Freqiency] nicht mehr?
Dennoch besteht noch das Problem der skalierung, sodass die Punkte das Fenster ständig verlassen. Die D2D Canvas scheint größer zu sein als die Form; und die Resize funktion natürlich
Ich hab mal alle Versionen in den Anhang gepackt.
Auch der Größenunterschied der exe Dateien ist hier gut zu sehen.
LG,
Symbroson
Edit: Ich glaube ich hab jetzt alle Probleme Gelöst. Geholfen hat mir ein Beispielprogramm aus diesem Post: www.delphipraxis.net/1251889-post8.html
Aufgrund dieses eher einseitigen Monologes kann der Thread meinetwegen wieder gelöscht werden...
Einloggen, um Attachments anzusehen!
_________________ most good programmers do programming not because they expect to get paid or get adulation by the public, but because it's fun to program. (Linus Torvalds)
|
|
TiGü
Hält's aus hier
Beiträge: 9
Erhaltene Danke: 1
|
Verfasst: Do 09.11.17 17:06
Versuchs mal so, da komme ich auf 2 - 3 ms pro Frame oder 333 bis 500 FPS.
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:
| unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, Vcl.Forms, Direct2D, D2D1,
Vcl.Controls, SysUtils, System.Classes;
type
TBall = record
x, y, dx, dy, r: integer;
end;
TGameThread = class(TThread)
strict private
FTThreadProcedure: TThreadProcedure;
protected
procedure Execute; override;
public
constructor Create(const AMethod: TThreadProcedure);
end;
TForm1 = class(TForm)
procedure FormDestroy(Sender: TObject);
private
FRectColor: D3DCOLORVALUE;
FBkgColor: D3DCOLORVALUE;
public
FGameThread: TGameThread;
FCanvas: TDirect2DCanvas;
FBalls: array of TBall;
FMaxNumber: integer;
property Canvas: TDirect2DCanvas read FCanvas;
procedure CreateWnd; override;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure StartRender;
procedure Render;
end;
var
Form1: TForm1;
implementation
uses
Diagnostics;
{$R *.dfm}
constructor TGameThread.Create(const AMethod: TThreadProcedure);
begin
inherited Create(False);
FTThreadProcedure := AMethod;
end;
procedure TGameThread.Execute;
begin
if Assigned(FTThreadProcedure) then
begin
while not Terminated do
Synchronize(FTThreadProcedure);
end;
end;
procedure TForm1.StartRender;
var
fps: int64;
PaintStruct: TPaintStruct;
Watch: TStopWatch;
begin
BeginPaint(Handle, PaintStruct);
try
FCanvas.BeginDraw;
try
Watch := TStopWatch.StartNew;
Render;
Watch.Stop;
fps := 1000 div Watch.ElapsedMilliseconds;
FCanvas.TextOut(0, 40, IntToStr(fps) + 'fps');
finally
FCanvas.EndDraw;
Application.ProcessMessages;
end;
finally
EndPaint(Handle, PaintStruct);
end;
end;
procedure TForm1.CreateWnd;
var
I: integer;
LClientRect: TRect;
LClientWidth, LClientHeight: integer;
begin
inherited;
FCanvas := TDirect2DCanvas.Create(Handle);
randomize;
FMaxNumber := 1000;
SetLength(FBalls, FMaxNumber);
Winapi.Windows.GetClientRect(Self.Handle, LClientRect);
LClientWidth := LClientRect.Width;
LClientHeight := LClientRect.Height;
for I := 1 to FMaxNumber - 1 do
begin
with FBalls[I] do
begin
r := random(10) + 1;
x := random(LClientWidth - r - r) + r;
y := random(LClientHeight - r - r) + r;
dx := random(10) + 1;
dy := random(10) + 1;
end;
end;
FRectColor := D2D1ColorF(1, 1, 1, 1);
FBkgColor := D2D1ColorF(0, 0, 0, 0);
FGameThread := TGameThread.Create(Self.StartRender);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FGameThread.Free;
end;
procedure TForm1.Render;
var
I: integer;
BallRect: TD2D1RectF;
CanvasRenderTarget: ID2D1RenderTarget;
tmpX, tmpY: integer;
LClientRect: TRect;
LClientWidth, LClientHeight: integer;
begin
CanvasRenderTarget := FCanvas.RenderTarget;
CanvasRenderTarget.Clear(FBkgColor);
ID2D1SolidColorBrush(FCanvas.Brush.Handle).SetColor(FRectColor);
Winapi.Windows.GetClientRect(Self.Handle, LClientRect);
LClientWidth := LClientRect.Width;
LClientHeight := LClientRect.Height;
for I := 0 to Length(FBalls) - 1 do
begin
with FBalls[I] do
begin
tmpX := x + dx;
if ((tmpX + r) >= LClientWidth) or ((tmpX - r) <= 0) then
dx := random(4) - 2 - dx;
tmpY := y + dy;
if ((tmpY + r) >= LClientHeight) or ((tmpY - r) <= 0) then
dy := random(4) - 2 - dy;
x := x + dx;
y := y + dy;
BallRect := D2D1RectF(x - r + 0.5, y - r + 0.5, x + r - 0.5, y + r - 0.5);
CanvasRenderTarget.FillRectangle(BallRect, FCanvas.Brush.Handle);
CanvasRenderTarget.DrawRectangle(BallRect, FCanvas.Pen.Brush.Handle, FCanvas.Pen.Width, FCanvas.Pen.StrokeStyle);
end;
end;
end;
procedure TForm1.WMSize(var Message: TWMSize);
var
NewSize: TD2D1SizeU;
begin
NewSize := D2D1SizeU(ClientWidth, ClientHeight);
if Assigned(FCanvas) then
ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(NewSize);
inherited;
end;
end. |
Für diesen Beitrag haben gedankt: Symbroson
|
|
Symbroson
Beiträge: 382
Erhaltene Danke: 67
Raspbian, Ubuntu, Win10
C, C++, Python, JavaScript, Lazarus, Delphi7, Casio Basic
|
Verfasst: Do 09.11.17 23:49
Vielen Dank TiGü! 
Die Geschwindigkeit hob sich deutlich, wie vorrausgesagt. 
Allerdings vertraue ich QueryPerformance mehr als dem TStopWatch - der hat mir teilweise 1000 fps angezeigt und sprang oft zwischen verschiedenen Werten hin und her, was eigentlich garnicht sein kann; QP dagegen relativ konstant 60 fps. Nur ein kleiner Mangel, der ja eig. nichts mit der Grafik zu tun hat 
Danke auf jeden Fall für den bearbeiteten Code _________________ most good programmers do programming not because they expect to get paid or get adulation by the public, but because it's fun to program. (Linus Torvalds)
|
|
TiGü
Hält's aus hier
Beiträge: 9
Erhaltene Danke: 1
|
Verfasst: Fr 10.11.17 12:48
Hinter TStopWatch stecken auch QueryPerformanceCounter und QueryPerformanceFrequency, einfach mal in die Implementierung gucken.
Der "Fehler" liegt eher daran, weil ich nur den Aufruf von Render gestoppt habe, aber es richtigerweise vor BeginDraw und nach EndDraw gehört.
So komme ich dann auch auf rund 60 FPS. Das geht aber noch schneller bis hin zu 255-260 FPS bei mir.
Das Problem ist, das beim Erzeugen des Rendertargets die entsprechende Option nicht gesetzt wird.
In TDirect2DCanvas.CreateRenderTarget wird D2DFactory.CreateHwndRenderTarget(...) aufgerufen.
Da drin als kleine Helper-Funktion D2D1HwndRenderTargetProperties(...).
Hier wird die TD2D1PresentOptions leider nur auf D2D1_PRESENT_OPTIONS_NONE gesetzt, anstatt auf D2D1_PRESENT_OPTIONS_IMMEDIATELY.
Mit einer Interposer-Klasse kann man das Problem aber umgehen. Wenn du willst, kann ich das später mal zeigen, falls du es nicht selber rausknobelst.
Ansonsten hier meine angepasste und genauere FPS-Anzeige mit MIN und MAX (wird alle 100 Frames zurückgesetzt):
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:
| unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, Vcl.Forms, Direct2D, D2D1,
Vcl.Controls, SysUtils, System.Classes;
type
TBall = record
x, y, dx, dy, r: integer;
end;
TGameThread = class(TThread)
strict private
FTThreadProcedure: TThreadProcedure;
protected
procedure Execute; override;
public
constructor Create(const AMethod: TThreadProcedure);
end;
TForm1 = class(TForm)
procedure FormDestroy(Sender: TObject);
private
FRectColor: D3DCOLORVALUE;
FBkgColor: D3DCOLORVALUE;
FTextFormat: IDWriteTextFormat;
FCounter: integer;
FFPSDisplay: string;
procedure ResetValues;
procedure DrawTextOut(x, y: integer; const AText: string);
procedure GenerateFPSDisplay(WatchElapsedTicks: Int64);
public
FGameThread: TGameThread;
FCanvas: TDirect2DCanvas;
FBalls: array of TBall;
FMaxNumber: integer;
FMaxFPS: Double;
FMinFPS: Double;
property Canvas: TDirect2DCanvas read FCanvas;
procedure CreateWnd; override;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure StartRender;
procedure Render;
end;
var
Form1: TForm1;
implementation
uses
Diagnostics;
{$R *.dfm}
constructor TGameThread.Create(const AMethod: TThreadProcedure);
begin
inherited Create(False);
FTThreadProcedure := AMethod;
end;
procedure TGameThread.Execute;
begin
if Assigned(FTThreadProcedure) then
begin
while not Terminated do
Synchronize(FTThreadProcedure);
end;
end;
procedure TForm1.DrawTextOut(x, y: integer; const AText: string);
var
LayoutRect: D2D1_RECT_F;
TextLen: integer;
begin
TextLen := Length(AText);
LayoutRect := D2D1RectF(
x + 0.5,
y + 0.5,
(x + TextLen * 5) - 0.5,
(y + TextLen) - 0.5);
if not Assigned(FTextFormat) then
begin
FTextFormat := FCanvas.Font.Handle;
end;
FCanvas.RenderTarget.DrawText(PWideChar(AText), TextLen, FTextFormat, LayoutRect, FCanvas.Brush.Handle);
end;
procedure TForm1.StartRender;
var
PaintStruct: TPaintStruct;
Watch: TStopWatch;
WatchElapsedTicks: Int64;
begin
BeginPaint(Handle, PaintStruct);
try
Watch := TStopWatch.StartNew;
FCanvas.BeginDraw;
try
Render;
DrawTextOut(0, 40, FFPSDisplay);
finally
FCanvas.EndDraw;
Watch.Stop;
WatchElapsedTicks := Watch.ElapsedTicks;
GenerateFPSDisplay(WatchElapsedTicks);
Application.ProcessMessages;
end;
finally
EndPaint(Handle, PaintStruct);
end;
end;
procedure TForm1.CreateWnd;
var
I: integer;
LClientRect: TRect;
LClientWidth, LClientHeight: integer;
begin
inherited;
FCanvas := TDirect2DCanvas.Create(Handle);
ResetValues;
randomize;
FMaxNumber := 1000;
SetLength(FBalls, FMaxNumber);
Winapi.Windows.GetClientRect(Self.Handle, LClientRect);
LClientWidth := LClientRect.Width;
LClientHeight := LClientRect.Height;
for I := 1 to FMaxNumber - 1 do
begin
with FBalls[I] do
begin
r := random(10) + 1;
x := random(LClientWidth - r - r) + r;
y := random(LClientHeight - r - r) + r;
dx := random(10) + 1;
dy := random(10) + 1;
end;
end;
FRectColor := D2D1ColorF(1, 1, 1, 1);
FBkgColor := D2D1ColorF(0, 0, 0, 0);
FGameThread := TGameThread.Create(Self.StartRender);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FGameThread.Free;
end;
procedure TForm1.Render;
var
I: integer;
BallRect: TD2D1RectF;
CanvasRenderTarget: ID2D1RenderTarget;
tmpX, tmpY: integer;
LClientRect: TRect;
LClientWidth, LClientHeight: integer;
begin
CanvasRenderTarget := FCanvas.RenderTarget;
CanvasRenderTarget.Clear(FBkgColor);
ID2D1SolidColorBrush(FCanvas.Brush.Handle).SetColor(FRectColor);
Winapi.Windows.GetClientRect(Self.Handle, LClientRect);
LClientWidth := LClientRect.Width;
LClientHeight := LClientRect.Height;
for I := 0 to Length(FBalls) - 1 do
begin
with FBalls[I] do
begin
tmpX := x + dx;
if ((tmpX + r) >= LClientWidth) or ((tmpX - r) <= 0) then
dx := random(4) - 2 - dx;
tmpY := y + dy;
if ((tmpY + r) >= LClientHeight) or ((tmpY - r) <= 0) then
dy := random(4) - 2 - dy;
x := x + dx;
y := y + dy;
BallRect := D2D1RectF(x - r + 0.5, y - r + 0.5, x + r - 0.5, y + r - 0.5);
CanvasRenderTarget.FillRectangle(BallRect, FCanvas.Brush.Handle);
CanvasRenderTarget.DrawRectangle(BallRect, FCanvas.Pen.Brush.Handle, FCanvas.Pen.Width, FCanvas.Pen.StrokeStyle);
end;
end;
end;
procedure TForm1.GenerateFPSDisplay(WatchElapsedTicks: Int64);
var
TickFreq: Double;
RealElapsedMilliseconds: Double;
fps: Double;
begin
TickFreq := 10000000.0 / TStopWatch.Frequency;
RealElapsedMilliseconds := (WatchElapsedTicks * TickFreq) / 10000;
fps := (1000 / RealElapsedMilliseconds);
if FCounter = 100 then
begin
ResetValues;
end;
Inc(FCounter);
if fps > FMaxFPS then
FMaxFPS := fps;
if fps < FMinFPS then
FMinFPS := fps;
FFPSDisplay := Format('Current FPS: %4.3f' + sLineBreak + 'Max: %4.3f ' + sLineBreak + 'Min: %4.3f', [fps, FMaxFPS, FMinFPS]);
end;
procedure TForm1.ResetValues;
begin
FMaxFPS := 0;
FMinFPS := 10000;
FCounter := 0;
end;
procedure TForm1.WMSize(var Message: TWMSize);
var
NewSize: TD2D1SizeU;
begin
NewSize := D2D1SizeU(ClientWidth, ClientHeight);
if Assigned(FCanvas) then
ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(NewSize);
inherited;
end;
end. |
|
|
jaenicke
Beiträge: 19272
Erhaltene Danke: 1740
W11 x64 (Chrome, Edge)
Delphi 11 Pro, Oxygene, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
|
Verfasst: Fr 10.11.17 13:20
So viele fps machen aber auch nicht unbedingt Sinn. D2D1_PRESENT_OPTIONS_IMMEDIATELY bedeutet, dass der Frame aktualisiert wird, egal ob der letzte überhaupt schon angezeigt wurde oder nicht. Man sieht den größten Teil der Frames also nicht einmal mehr.
Im Standard wird immer erst der nächste Frame angezeigt, wenn der letzte im Display in der Anzeige ist. Da 60 Hz für einen Standardmonitor normal sind, kommt man analog auf 60 fps.
|
|
|
