unit1.pas

唯一公开源代码的GBA模拟器

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, Unit2, ComCtrls;

type
  TGBAEmu = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    LoadBinary1: TMenuItem;
    Emulation1: TMenuItem;
    Start1: TMenuItem;
    OpenDialogBin: TOpenDialog;
    Quit1: TMenuItem;
    Quit2: TMenuItem;
    Display1: TMenuItem;
    x11: TMenuItem;
    x12: TMenuItem;
    x21: TMenuItem;
    x31: TMenuItem;
    About1: TMenuItem;
    Checll33taboutmsg1: TMenuItem;
    Reset1: TMenuItem;
    StatusBar1: TStatusBar;
    Debug1: TMenuItem;
    Debugger1: TMenuItem;
    GBADebugger1: TMenuItem;
    procedure LoadBinary1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Start1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Debugger1Click(Sender: TObject);
    procedure UpdateDebugger;
    procedure Reset1Click(Sender: TObject);
    procedure Quit2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  GBAEmu: TGBAEmu;
  temp_string : pchar;
  msg_string : pchar;
  operand_string : pchar;
  bin_name: string;
  CurrentThread:RunThread;
  bin_loaded:boolean;
  threadrunning: boolean;
  showfps:boolean;

implementation

uses Unit3;
     function init_gbaemu():integer; cdecl; external 'gbaemu.dll'
     procedure reset_gbaemu (pc: longword;debug_destination : pchar;operand_destination:pchar); cdecl; external 'gbaemu.dll'
     function load_bin (filename: pchar): longword; cdecl; external 'gbaemu.dll'
     function read_word (adress: longword):longword; cdecl; external 'gbaemu.dll'
     function get_arm_gpreg (i:longword):longword; cdecl; external 'gbaemu.dll'
     function get_arm_cpsr ():longword; cdecl; external 'gbaemu.dll'
     function get_bin_size():longword; cdecl; external 'gbaemu.dll'
     function get_instruction_pipe(num:longword):longword; cdecl; external 'gbaemu.dll'
     procedure exec_step(); cdecl; external 'gbaemu.dll'
     function get_new_message(msg_string: pchar):longword; cdecl; external 'gbaemu.dll'
     procedure set_arm_cpsr(value:longword); cdecl; external 'gbaemu.dll'
     procedure set_arm_gpreg(index:longword;value:longword); cdecl; external 'gbaemu.dll'
     function get_io_reg(index:longword):word; cdecl; external 'gbaemu.dll'
     procedure set_io_reg(index:longword; value:word); cdecl; external 'gbaemu.dll'
     procedure run_breakpoint (breakpoint:longword); cdecl; external 'gbaemu.dll'
     function get_rom (offset:longword):longword; cdecl; external 'gbaemu.dll'
     function get_rom_size_u32 ():longword; cdecl; external 'gbaemu.dll'
     procedure decode_opcode (op:longword;adress:longword;destination:pchar); cdecl; external 'gbaemu.dll'
     function get_pixel (x:longword; y:longword):longword; cdecl; external 'gbaemu.dll'
     procedure dump_vram; cdecl; external 'gbaemu.dll'
     procedure run_frame; cdecl; external 'gbaemu.dll'
     procedure setup_graphics (handle:HWND); cdecl; external 'gbaemu.dll'
     procedure clean_up; cdecl; external 'gbaemu.dll'
     procedure set_blit_res (x:longword; y:longword); cdecl; external 'gbaemu.dll'
     procedure set_keyfield (keyfield:integer); cdecl; external 'gbaemu.dll'
     function get_rom_u16 (offset:longword):integer; cdecl; external 'gbaemu.dll'
     procedure decode_opcode_thumb (op:integer;adress:longword;destination:pchar); cdecl; external 'gbaemu.dll'

{$R *.DFM}

procedure TGBAEmu.LoadBinary1Click(Sender: TObject);
var
   s : string;
   i,n,temp : integer;
begin
     if threadrunning then
     begin
           CurrentThread.terminate;
           CurrentThread.waitfor;
           CurrentThread.free;
           threadrunning := false;
           Start1.caption := 'Start';
           UpdateDebugger;
     end;

     if OpenDialogBin.execute then
     begin
          temp_string := allocmem (100);
          msg_string := allocmem (100);
          operand_string := allocmem (100);

          bin_name := OpenDialogBin.filename;
          temp:=load_bin(PChar(bin_name));

          debugger.listbox1.clear;
          
          bin_loaded := true;

          reset_gbaemu($8000000, temp_string, operand_string);
          UpdateDebugger;
     end;
     StatusBar1.Panels[1].text := OpenDialogBin.filename;
end;

procedure TGBAEmu.FormCreate(Sender: TObject);
begin
     init_gbaemu();
     setup_graphics (gbaemu.handle);
     bin_loaded := false;
     threadrunning := false;
     showfps:= false;
end;

procedure TGBAEmu.Start1Click(Sender: TObject);
begin
     if bin_loaded = true then
     begin
     if threadrunning = true then
     begin
           CurrentThread.terminate;
           CurrentThread.waitfor;
           CurrentThread.free;
           threadrunning := false;
           Start1.caption := 'Start';
           UpdateDebugger;
     end
     else
     begin
           CurrentThread := RunThread.Create(false);
           CurrentThread.keyfield := $3FF;
           threadrunning := true;
           Start1.caption := 'Stop';
     end;
     end;
end;

procedure TGBAEmu.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
     if bin_loaded AND threadrunning then
     begin
     if Key = ord('A') then CurrentThread.keyfield := CurrentThread.keyfield and not 1;
     if Key = ord('S') then CurrentThread.keyfield := CurrentThread.keyfield and not 2;
     if Key = VK_SHIFT then CurrentThread.keyfield := CurrentThread.keyfield and not 4;
     if Key = VK_RETURN then CurrentThread.keyfield := CurrentThread.keyfield and not 8;
     if Key = VK_RIGHT then CurrentThread.keyfield := CurrentThread.keyfield and not 16;
     if Key = VK_LEFT then CurrentThread.keyfield := CurrentThread.keyfield and not 32;
     if Key = VK_UP then CurrentThread.keyfield := CurrentThread.keyfield and not 64;
     if Key = VK_DOWN then CurrentThread.keyfield := CurrentThread.keyfield and not 128;
     if Key = ord('W') then CurrentThread.keyfield := CurrentThread.keyfield and not 256;
     if Key = ord('Q') then CurrentThread.keyfield := CurrentThread.keyfield and not 512;
     end;
end;

procedure TGBAEmu.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
     if bin_loaded AND threadrunning then
     begin
     if Key = ord('A') then CurrentThread.keyfield := CurrentThread.keyfield or 1;
     if Key = ord('S') then CurrentThread.keyfield := CurrentThread.keyfield or 2;
     if Key = VK_SHIFT then CurrentThread.keyfield := CurrentThread.keyfield or 4;
     if Key = VK_RETURN then CurrentThread.keyfield := CurrentThread.keyfield or 8;
     if Key = VK_RIGHT then CurrentThread.keyfield := CurrentThread.keyfield or 16;
     if Key = VK_LEFT then CurrentThread.keyfield := CurrentThread.keyfield or 32;
     if Key = VK_UP then CurrentThread.keyfield := CurrentThread.keyfield or 64;
     if Key = VK_DOWN then CurrentThread.keyfield := CurrentThread.keyfield or 128;
     if Key = ord('W') then CurrentThread.keyfield := CurrentThread.keyfield or 256;
     if Key = ord('Q') then CurrentThread.keyfield := CurrentThread.keyfield or 512;
     end;
end;

procedure TGBAEmu.Debugger1Click(Sender: TObject);
begin
     Debugger.show;
end;

procedure TGBAemu.UpdateDebugger;
var
   temp:longword;
   von, bis, n: longword;
   s:string;
begin
     with Debugger do
     begin
     LabelR0.caption:='$'+IntToHex(get_arm_gpreg(0), 8);
     labelR1.caption:='$'+IntToHex(get_arm_gpreg(1), 8);
     labelR2.caption:='$'+IntToHex(get_arm_gpreg(2), 8);
     labelR3.caption:='$'+IntToHex(get_arm_gpreg(3), 8);
     labelR4.caption:='$'+IntToHex(get_arm_gpreg(4), 8);
     labelR5.caption:='$'+IntToHex(get_arm_gpreg(5), 8);
     labelR6.caption:='$'+IntToHex(get_arm_gpreg(6), 8);
     labelR7.caption:='$'+IntToHex(get_arm_gpreg(7), 8);
     labelR8.caption:='$'+IntToHex(get_arm_gpreg(8), 8);
     labelR9.caption:='$'+IntToHex(get_arm_gpreg(9), 8);
     labelR10.caption:='$'+IntToHex(get_arm_gpreg(10), 8);
     labelR11.caption:='$'+IntToHex(get_arm_gpreg(11), 8);
     labelR12.caption:='$'+IntToHex(get_arm_gpreg(12), 8);
     labelR13.caption:='$'+IntToHex(get_arm_gpreg(13), 8);
     labelR14.caption:='$'+IntToHex(get_arm_gpreg(14), 8);
     labelR15.caption:='$'+IntToHex(get_arm_gpreg(15), 8);
     labelCPSR.caption:='$'+IntToHex(get_arm_cpsr(), 8);

     temp:= get_arm_cpsr();
     //CPSREdit.text:=IntToHex(temp, 8);
     if (temp and $80000000)=0 then CheckBoxN.checked := false
     else CheckBoxN.checked := true;
     if (temp and $40000000)=0 then CheckBoxZ.checked := false
     else CheckBoxZ.checked := true;
     if (temp and $20000000)=0 then CheckBoxC.checked := false
     else CheckBoxC.checked := true;
     if (temp and $10000000)=0 then CheckBoxV.checked := false
     else CheckBoxV.checked := true;
     if (temp and $00000080)=0 then CheckBoxI.checked := false
     else CheckBoxI.checked := true;
     if (temp and $00000040)=0 then CheckBoxF.checked := false
     else CheckBoxF.checked := true;
     if (temp and $00000020)=0 then CheckBoxT.checked := false
     else CheckBoxT.checked := true;
     end;

     Debugger.ListBox1.clear;

     if (temp and $20)=0 then begin

     von := ((get_arm_gpreg(15)-8)-$20)div 4;
     bis := ((get_arm_gpreg(15)-8)+$20)div 4;

     for von:=von to bis do
     begin
           n:=(von*4);
           s:= IntToHex(n, 8) + chr(9) + IntToHex (get_rom(n), 8);
           decode_opcode (get_rom(n),n, temp_string);
           s:= s + chr(9) + string(temp_string);
           Debugger.ListBox1.items.add(s);
     end;

     Debugger.ListBox1.itemindex := $20 div 4;
 
     end
     else
     begin

     von := ((get_arm_gpreg(15)-4)-$10)div 2;
     bis := ((get_arm_gpreg(15)-4)+$10)div 2;

     for von:=von to bis do
     begin
           n:=(von*2);
           s:= IntToHex(n, 8) + chr(9) + IntToHex (get_rom_u16(n), 8);
           decode_opcode_thumb (get_rom_u16(n),n, temp_string);
           s:= s + chr(9) + string(temp_string);
           Debugger.ListBox1.items.add(s);
     end;

     Debugger.ListBox1.itemindex := $10 div 2;

     end;
end;

procedure TGBAEmu.Reset1Click(Sender: TObject);
begin
     if bin_loaded then begin

     if threadrunning then begin
           CurrentThread.terminate;
           CurrentThread.waitfor;
           CurrentThread.free;
     end;
          reset_gbaemu($8000000, temp_string, operand_string);
          UpdateDebugger;

     if threadrunning then begin
           CurrentThread := RunThread.Create(false);
           CurrentThread.keyfield := $FFFF;
     end;

     end;
end;

procedure TGBAEmu.Quit2Click(Sender: TObject);
begin
     close;
end;

procedure TGBAEmu.FormDestroy(Sender: TObject);
begin
     //
     if bin_loaded = true then
     begin
     if threadrunning = true then
     begin
           CurrentThread.terminate;
           CurrentThread.waitfor;
           CurrentThread.free;
     end;
     end;
end;

end.