www.pudn.com > EloGbaR1.zip > Unit1.pas

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.