@@ -14,7 +14,7 @@ unit UnitMain; |
| 14 |
interface |
14 |
interface |
| 15 |
|
15 |
|
| 16 |
uses |
16 |
uses |
| 17 |
Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, |
17 |
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, |
| 18 |
lcl_out, vars, z80cpu, mainloop, machine, debugger, sound, |
18 |
lcl_out, vars, z80cpu, mainloop, machine, debugger, sound, |
| 19 |
StdCtrls, ExtCtrls, ComCtrls, Menus; |
19 |
StdCtrls, ExtCtrls, ComCtrls, Menus; |
| 20 |
|
20 |
|
@@ -130,15 +130,14 @@ type |
| 130 |
{ Private-Deklarationen} |
130 |
{ Private-Deklarationen} |
| 131 |
fullwindow: boolean; |
131 |
fullwindow: boolean; |
| 132 |
FDiff: integer; // Caption Height |
132 |
FDiff: integer; // Caption Height |
| 133 |
RomFile: String; |
133 |
RomFileName: String; |
| 134 |
|
134 |
|
| 135 |
procedure Emulation; |
135 |
procedure Emulation(var msg: TMessage); message wm_user; |
| 136 |
procedure SetWindow; |
136 |
procedure SetWindow; |
| 137 |
procedure LoadRom(Rom: String); |
137 |
procedure LoadRom(Rom: String); |
| 138 |
|
138 |
|
| 139 |
procedure ShowCaption; |
139 |
procedure ShowCaption; |
| 140 |
procedure RemoveCaption; |
140 |
procedure RemoveCaption; |
| 141 |
|
|
|
| 142 |
public |
141 |
public |
| 143 |
{ Public-Deklarationen} |
142 |
{ Public-Deklarationen} |
| 144 |
timervar: byte; |
143 |
timervar: byte; |
@@ -206,12 +205,17 @@ const |
| 206 |
CyclesPerFrame : Integer = 70224; |
205 |
CyclesPerFrame : Integer = 70224; |
| 207 |
TimePerFrame: Double = 1.0 / 60.0; |
206 |
TimePerFrame: Double = 1.0 / 60.0; |
| 208 |
|
207 |
|
| 209 |
procedure TfrmGameboy.Emulation; |
208 |
procedure TfrmGameboy.Emulation(var Msg: TMessage); |
| 210 |
var |
209 |
var |
| 211 |
li: Large_Integer; |
210 |
li: Large_Integer; |
| 212 |
tickFreq, cycles: Integer; |
211 |
tickFreq, cycles: Integer; |
| 213 |
frameStart, frameEnd: Integer; |
212 |
frameStart, frameEnd: Integer; |
| 214 |
frameElapsedInSec: Double; |
213 |
frameElapsedInSec: Double; |
|
|
214 |
function GetCounter: Integer; |
|
|
215 |
begin |
|
|
216 |
QueryPerformanceCounter(@li); |
|
|
217 |
Result := li.QuadPart |
|
|
218 |
end; |
| 215 |
begin |
219 |
begin |
| 216 |
lastTime := 0; |
220 |
lastTime := 0; |
| 217 |
|
221 |
|
@@ -219,8 +223,7 @@ begin |
| 219 |
|
223 |
|
| 220 |
QueryPerformanceFrequency(@li); |
224 |
QueryPerformanceFrequency(@li); |
| 221 |
tickFreq := li.QuadPart; |
225 |
tickFreq := li.QuadPart; |
| 222 |
QueryPerformanceCounter(@li); |
226 |
FrameStart := GetCounter; |
| 223 |
frameStart := li.QuadPart; |
|
|
| 224 |
|
227 |
|
| 225 |
repeat |
228 |
repeat |
| 226 |
application.ProcessMessages; |
229 |
application.ProcessMessages; |
@@ -230,10 +233,8 @@ begin |
| 230 |
while f_stopped do |
233 |
while f_stopped do |
| 231 |
application.ProcessMessages; |
234 |
application.ProcessMessages; |
| 232 |
|
235 |
|
| 233 |
frameEnd := 0; |
236 |
FrameStart := GetCounter; |
| 234 |
|
237 |
frameEnd := 0 |
| 235 |
QueryPerformanceCounter(@li); |
|
|
| 236 |
frameStart := li.QuadPart; |
|
|
| 237 |
end; |
238 |
end; |
| 238 |
|
239 |
|
| 239 |
while (cycles < CyclesPerFrame) do |
240 |
while (cycles < CyclesPerFrame) do |
@@ -242,11 +243,9 @@ begin |
| 242 |
cycles -= CyclesPerFrame; |
243 |
cycles -= CyclesPerFrame; |
| 243 |
|
244 |
|
| 244 |
repeat |
245 |
repeat |
| 245 |
QueryPerformanceCounter(@li); |
246 |
FrameEnd := GetCounter; |
| 246 |
frameEnd := li.QuadPart; |
|
|
| 247 |
|
247 |
|
| 248 |
frameElapsedInSec := (frameEnd - frameStart) / tickFreq; |
248 |
frameElapsedInSec := (frameEnd - frameStart) / tickFreq; |
| 249 |
sleep(1); |
|
|
| 250 |
until (frameElapsedInSec > TimePerFrame) and (not SoundBufferTooFull); |
249 |
until (frameElapsedInSec > TimePerFrame) and (not SoundBufferTooFull); |
| 251 |
|
250 |
|
| 252 |
frameStart := frameEnd; |
251 |
frameStart := frameEnd; |
@@ -255,6 +254,8 @@ end; |
| 255 |
|
254 |
|
| 256 |
procedure TfrmGameboy.LoadRom(Rom: String); |
255 |
procedure TfrmGameboy.LoadRom(Rom: String); |
| 257 |
begin |
256 |
begin |
|
|
257 |
RomFileName := Rom; |
|
|
258 |
|
| 258 |
f_stopped := True; |
259 |
f_stopped := True; |
| 259 |
load(Rom); |
260 |
load(Rom); |
| 260 |
statusbar.Panels[2].Text := getcompany; |
261 |
statusbar.Panels[2].Text := getcompany; |
@@ -266,8 +267,6 @@ begin |
| 266 |
gb_speed := 1; |
267 |
gb_speed := 1; |
| 267 |
loadstat.Enabled := True; |
268 |
loadstat.Enabled := True; |
| 268 |
savestat.Enabled := True; |
269 |
savestat.Enabled := True; |
| 269 |
|
|
|
| 270 |
RomFile := Rom; |
|
|
| 271 |
end; |
270 |
end; |
| 272 |
|
271 |
|
| 273 |
procedure TfrmGameboy.FileOpenClick(Sender: TObject); |
272 |
procedure TfrmGameboy.FileOpenClick(Sender: TObject); |
@@ -306,12 +305,10 @@ begin |
| 306 |
|
305 |
|
| 307 |
frmGameboy.DoubleBuffered := True; |
306 |
frmGameboy.DoubleBuffered := True; |
| 308 |
SetPaintBox(PaintBox1); |
307 |
SetPaintBox(PaintBox1); |
|
|
308 |
postmessage(handle, wm_user, 0, 0); |
| 309 |
|
309 |
|
| 310 |
//postmessage(handle, wm_user, 0, 0); |
|
|
| 311 |
if ParamCount >= 1 then |
310 |
if ParamCount >= 1 then |
| 312 |
LoadRom(ParamStr(1)); |
311 |
LoadRom(ParamStr(1)); |
| 313 |
|
|
|
| 314 |
Emulation; |
|
|
| 315 |
end; |
312 |
end; |
| 316 |
|
313 |
|
| 317 |
procedure TfrmGameboy.Exit1Click(Sender: TObject); |
314 |
procedure TfrmGameboy.Exit1Click(Sender: TObject); |
@@ -331,6 +328,7 @@ begin |
| 331 |
f_stopped := not f_stopped; |
328 |
f_stopped := not f_stopped; |
| 332 |
pause1.Checked := f_stopped; |
329 |
pause1.Checked := f_stopped; |
| 333 |
end; |
330 |
end; |
|
|
331 |
Ord('R'): LoadRom(RomFileName); |
| 334 |
VK_UP: k_up := 0; |
332 |
VK_UP: k_up := 0; |
| 335 |
VK_DOWN: k_down := 0; |
333 |
VK_DOWN: k_down := 0; |
| 336 |
VK_LEFT: k_left := 0; |
334 |
VK_LEFT: k_left := 0; |
@@ -369,7 +367,6 @@ begin |
| 369 |
VK_DOWN: k_down := 1; |
367 |
VK_DOWN: k_down := 1; |
| 370 |
VK_LEFT: k_left := 1; |
368 |
VK_LEFT: k_left := 1; |
| 371 |
VK_RIGHT: k_right := 1; |
369 |
VK_RIGHT: k_right := 1; |
| 372 |
Ord('R'): LoadRom(RomFile); |
|
|
| 373 |
end; |
370 |
end; |
| 374 |
end; |
371 |
end; |
| 375 |
|
372 |
|
@@ -402,44 +399,43 @@ begin |
| 402 |
end; |
399 |
end; |
| 403 |
|
400 |
|
| 404 |
procedure TfrmGameboy.setPriority(Sender: TObject); |
401 |
procedure TfrmGameboy.setPriority(Sender: TObject); |
|
|
402 |
var |
|
|
403 |
ProcessID: DWORD; |
|
|
404 |
ProcessHandle: THandle; |
|
|
405 |
Priority: integer; |
| 405 |
begin |
406 |
begin |
| 406 |
//var |
407 |
{ HIGH_PRIORITY_CLASS, |
| 407 |
// ProcessID: DWORD; |
408 |
IDLE_PRIORITY_CLASS, |
| 408 |
// ProcessHandle: THandle; |
409 |
NORMAL_PRIORITY_CLASS |
| 409 |
// Priority: integer; |
410 |
REALTIME_PRIORITY_CLASS} |
| 410 |
//begin |
411 |
{THREAD_PRIORITY_ABOVE_NORMAL, |
| 411 |
//{ HIGH_PRIORITY_CLASS, |
412 |
THREAD_PRIORITY_BELOW_NORMAL, |
| 412 |
// IDLE_PRIORITY_CLASS, |
413 |
THREAD_PRIORITY_HIGHEST, |
| 413 |
// NORMAL_PRIORITY_CLASS |
414 |
THREAD_PRIORITY_IDLE, |
| 414 |
// REALTIME_PRIORITY_CLASS} |
415 |
THREAD_PRIORITY_LOWEST, |
| 415 |
//{THREAD_PRIORITY_ABOVE_NORMAL, |
416 |
THREAD_PRIORITY_NORMAL, |
| 416 |
// THREAD_PRIORITY_BELOW_NORMAL, |
417 |
THREAD_PRIORITY_TIME_CRITICAL} |
| 417 |
// THREAD_PRIORITY_HIGHEST, |
418 |
|
| 418 |
// THREAD_PRIORITY_IDLE, |
419 |
priority1.Checked := False; |
| 419 |
// THREAD_PRIORITY_LOWEST, |
420 |
priority2.Checked := False; |
| 420 |
// THREAD_PRIORITY_NORMAL, |
421 |
priority3.Checked := False; |
| 421 |
// THREAD_PRIORITY_TIME_CRITICAL} |
422 |
priority4.Checked := False; |
| 422 |
// |
423 |
tmenuitem(Sender).Checked := True; |
| 423 |
// priority1.Checked := False; |
424 |
|
| 424 |
// priority2.Checked := False; |
425 |
if Sender = priority1 then |
| 425 |
// priority3.Checked := False; |
426 |
priority := IDLE_PRIORITY_CLASS; |
| 426 |
// priority4.Checked := False; |
427 |
if Sender = priority2 then |
| 427 |
// tmenuitem(Sender).Checked := True; |
428 |
priority := NORMAL_PRIORITY_CLASS; |
| 428 |
// |
429 |
if Sender = priority3 then |
| 429 |
// if Sender = priority1 then |
430 |
priority := HIGH_PRIORITY_CLASS; |
| 430 |
// priority := IDLE_PRIORITY_CLASS; |
431 |
if Sender = priority4 then |
| 431 |
// if Sender = priority2 then |
432 |
priority := REALTIME_PRIORITY_CLASS; |
| 432 |
// priority := NORMAL_PRIORITY_CLASS; |
433 |
|
| 433 |
// if Sender = priority3 then |
434 |
ProcessID := GetCurrentProcessID; |
| 434 |
// priority := HIGH_PRIORITY_CLASS; |
435 |
ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, False, ProcessID); |
| 435 |
// if Sender = priority4 then |
436 |
SetPriorityClass(ProcessHandle, Priority); |
| 436 |
// priority := REALTIME_PRIORITY_CLASS; |
437 |
{ ThreadHandle := GetCurrentThread; |
| 437 |
// |
438 |
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_HIGHEST);} |
| 438 |
// ProcessID := GetCurrentProcessID; |
|
|
| 439 |
// ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, False, ProcessID); |
|
|
| 440 |
// SetPriorityClass(ProcessHandle, Priority); |
|
|
| 441 |
//{ ThreadHandle := GetCurrentThread; |
|
|
| 442 |
// SetThreadPriority(ThreadHandle, THREAD_PRIORITY_HIGHEST);} |
|
|
| 443 |
end; |
439 |
end; |
| 444 |
|
440 |
|
| 445 |
procedure TfrmGameboy.setResolution(Sender: TObject); |
441 |
procedure TfrmGameboy.setResolution(Sender: TObject); |