当鼠标不在FireMonkey应用程序上移动时,Delphi"While"性能下降

Mar*_*lka 1 delphi opengl onkeydown firemonkey

我正在玩Delphi + openGL.因为我很懒,所以我想用FireMonkey为我制作表格.
所以我制作了一个FireMonkeyHD应用程序,初始化了GL,渲染了一个基本的立方体......并发现了一些奇怪的行为.当我不移动我的鼠标时,我得到大约10FPS.当我移动鼠标时,性能很容易上升到500FPS(显然)更多.那可能是什么?
*注意:我开始使用主线程中的onKeyDown事件进行渲染...

为了更好地理解,两个图片: 没有鼠标移动的应用程序 应用w野鼠移动

一些代码:

unit Unit1;

interface

uses
{ ... }
;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
  private
    degen
    : IDeGEn;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
var
  DeGEnFactory
  : TDeGEnFactory;
begin
  { ... }
  // Load DeGEn
  degen := DeGEnFactory.newDeGEn(WindowHandleToPlatform(Form1.Handle).Wnd);

  // Initialize
  degen.get3D.init(600, 800);
  degen.get3D.setOnRender(function : Boolean
  var
    v3d
    : R3DVector;
  begin
    Result := true;
    self.Caption := IntToStr(degen.get3D.getFPS);
    v3d.z := 0.01;
    degen.get3D.getCamera.move(v3d);
    degen.get3D.renderTest;
  end);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Shut down DeGEn
  { ... }
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  // Start rendering
  degen.startRendering;
end;

end.
Run Code Online (Sandbox Code Playgroud)


而且startRendering看起来是这样的:

procedure TDeGEn.startRendering;
var
  msg
  : TMsg;
begin
  if isRendering then
  begin
    Exit;
  end;

  isRendering := true;
  while GetMessage(msg, 0, 0, 0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);

    if not degen3D.render then
    begin
      Break;
    end;
  end;

  isRendering := false;
end;
Run Code Online (Sandbox Code Playgroud)


您可能很容易注意到,相机只是以速度取决于FPS而远离立方体.此外,我将FPS显示为表单标题.

Joh*_*ica 5

GetMessage 等待一个消息.如果你不移动鼠标,很少有消息进入消息队列并且渲染速度很慢,因为CPU等待GetMessage返回.

移动鼠标时会创建大量消息; 消息队列已满,GetMessage几乎立即返回.

请注意,自Windows 3.1起,不需要像这样执行消息循环.

另请注意,Microsoft警告不要像这样实现messageloop.
来自:http://msdn.microsoft.com/en-us/library/windows/desktop/ms644936%28v=vs.85%29.aspx

因为返回值可以是非零,零或-1,所以避免这样的代码:

while (GetMessage( lpMsg, hWnd, 0, 0)) ...

在hWnd是无效参数的情况下(例如,引用已被销毁的窗口),返回值为-1的可能性意味着此类代码可能导致致命的应用程序错误.相反,使用这样的代码:

BOOL bRet;`

while( (bRet = GetMessage( &msg, hWnd, 0, 0 )) != 0) {
    if (bRet == -1)` `    {
        // handle the error and possibly exit
    } else {
        TranslateMessage(&msg); 
        DispatchMessage(&msg); 
    } 
}
Run Code Online (Sandbox Code Playgroud)

无论如何,没有必要像这样做循环.
而是在表单上放置一个计时器,并将代码放在OnTimer事件中.

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //DoRendering
end;
Run Code Online (Sandbox Code Playgroud)

如果普通定时器太慢,那么有很多高分辨率的定时器.JVCL已经完成,unDelphiX也有.
请参阅此处:http://delphi.about.com/od/windowsshellapi/a/delphi-high-performance-timer-tstopwatch.htm
或此处:http://wiki.delphi-jedi.org/wiki/JVCL_Help : TJvTimer

在CPU密集型循环中处理Windows消息
我们不再使用messageloop(不是自Delphi 1.0以来).
使用Application.ProcessMessages如果您发现该应用程序没有响应,由于你的循环占用CPU的所有时间,而不是.

WM_TIMER消息的优先级低
如果使用默认计时器,则会遇到不可靠性问题.
这是因为Windows将WM_TIMER消息(TTimer查找的消息)视为低优先级.
如果Windows忙于其他任务,它会将多个等待WM_TIMER消息压缩为一个,以避免产生积压的计时器消息.
它对WM_PAINT消息做了同样的事情.
请参阅:http://msdn.microsoft.com/en-us/library/windows/desktop/ms644902%28v=vs.85%29.aspx

避免这种情况的一个技巧是使用高分辨率计时器(这不依赖于消息循环)来构造循环,或者使用简单的无限循环Application.ProcessMessagessleep()延迟.