erikphilips
15-11-2003, 02:08 PM
So i've created this app that has similar properties to the DirectDraw example WindowsedMode_vcl. However when my app runs, it uses 100% of my processor. The cursor moves sporadically, an other app are getting little/no cpu time (winamp).
The example below is missing a TON of important code for real apps, but as long as the window doesn't move and other misc things it shouldn't have the effect i'm seeing.
I reduced my entire code down to:
mdisplay: tDisplay;
mDebugSurface: TSurface;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
mdisplay := tdisplay.create;
mdisplay.CreateWindowedDisplay(handle, 640, 480);
mdisplay.CreateSurfaceFromText(mDebugSurface, 0, pAnsiChar('test'), RGB( 0, 0, 0 ), RGB( 255, 255, 0 ) );
application.OnIdle := GameLoop;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
mDebugSurface.Free;
mDebugSurface := nil;
mdisplay.Free;
mdisplay := nil;
end;
procedure TfrmMain.GameLoop(Sender: TObject; var Done: Boolean);
var
newTickCount: integer;
hr : HRESULT;
x, y: integer;
begin
newTickCount := getTickCount;
if (newTickCount = lastTickCount) then
exit;
blah;
Done := False;
end;
procedure tFrmMain.blah;
begin
if (mdisplay = nil) then
exit;
mdisplay.Clear(0);
mdisplay.Blt( 10, 10, mDebugSurface, nil );
mdisplay.Flip;
end;
{debug}
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ( Key = VK_F12 ) or ( Key = VK_ESCAPE ) then
begin
Key := 0;
Close;
end;
end;
{/debug}
The example below is missing a TON of important code for real apps, but as long as the window doesn't move and other misc things it shouldn't have the effect i'm seeing.
I reduced my entire code down to:
mdisplay: tDisplay;
mDebugSurface: TSurface;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
mdisplay := tdisplay.create;
mdisplay.CreateWindowedDisplay(handle, 640, 480);
mdisplay.CreateSurfaceFromText(mDebugSurface, 0, pAnsiChar('test'), RGB( 0, 0, 0 ), RGB( 255, 255, 0 ) );
application.OnIdle := GameLoop;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
mDebugSurface.Free;
mDebugSurface := nil;
mdisplay.Free;
mdisplay := nil;
end;
procedure TfrmMain.GameLoop(Sender: TObject; var Done: Boolean);
var
newTickCount: integer;
hr : HRESULT;
x, y: integer;
begin
newTickCount := getTickCount;
if (newTickCount = lastTickCount) then
exit;
blah;
Done := False;
end;
procedure tFrmMain.blah;
begin
if (mdisplay = nil) then
exit;
mdisplay.Clear(0);
mdisplay.Blt( 10, 10, mDebugSurface, nil );
mdisplay.Flip;
end;
{debug}
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ( Key = VK_F12 ) or ( Key = VK_ESCAPE ) then
begin
Key := 0;
Close;
end;
end;
{/debug}