Initial commit

.gitignore

@@ -0,0 +1,20 @@
+/backup
+/release
+*.bak
+*.dof
+*.dsk
+*.exe
+*.dll
+*.so
+@build*.bat
+*.tlb
+*.pyc
+/gbmb/exe
+/gbmb/units
+/gbmb/unused
+/gbtd/exe
+/gbtd/units
+/gbtd/unused
+/gbcomp/exe   
+/gbcomp/units 
+/gbcomp/unused

README.md

@@ -1,2 +1,8 @@
 # GBTD_GBMB
 GBTD/GBMB rebuild and fix
+
+Original sources were taken here: http://www.devrs.com/gb/hmgd/gbtd.html
+Converted to delphi5 (the oldest i have) and re-built.
+
+The initial purpose of doing this - making GBDK export compatible with 
+GBDK-2020.

gbcomp/AppMem.pas

@@ -0,0 +1,69 @@
+unit AppMem;
+
+interface
+
+uses Windows, SysUtils;
+
+type
+  TAppMem = class
+   private
+    { Private declarations }
+
+    FHandle   : HWND;
+    FMemBlock : Pointer;
+    FSize     : integer;
+
+
+   protected
+    { Protected declarations }
+
+
+   public
+    { Public declarations }
+
+    constructor Create( const ID : string; Size : integer; ReadOnly : boolean; var Existed : boolean );
+    destructor Destroy; override;
+
+    property MemBlock : Pointer read FMemBlock write FMemBlock;
+    property Size     : integer read FSize;
+  end;
+
+implementation
+
+
+constructor TAppMem.Create( const ID : string; Size : integer; ReadOnly : boolean; var Existed : boolean);
+var s : string;
+begin
+  inherited Create;
+
+  s := UpperCase(ID);
+  { Convert spaces to zeroes }
+  while Pos('\', s) > 0 do
+  begin
+    S[Pos('\', S)] := '@';
+  end;
+
+  FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(s));
+  if (FHandle <> null) then
+  begin
+    Existed := (GetLastError = ERROR_ALREADY_EXISTS);
+    if ReadOnly then
+      FMemBlock := MapViewOfFile( FHandle, FILE_MAP_READ, 0, 0, Size )
+    else
+      FMemBlock := MapViewOfFile( FHandle, FILE_MAP_WRITE, 0, 0, Size );
+
+    FSize := Size;
+  end;
+end;
+
+destructor TAppMem.Destroy;
+begin
+  if Assigned(FMemBlock) then UnmapViewOfFile(FMemBlock);
+  if (FHandle <> null) then CloseHandle(FHandle);
+
+  inherited Destroy;
+end;
+
+
+
+end.

gbcomp/AppMessage.pas

@@ -0,0 +1,91 @@
+unit AppMessage;
+
+interface
+
+uses Controls, messages, Windows, SysUtils;
+
+type
+  TAppMessage = class
+   private
+    { Private declarations }
+    FMsg        : integer;
+    FMaster     : TControl;
+    FOldHandler : TWndMethod;
+
+    FActive     : boolean;
+    FOnMessage  : TWndMethod;
+
+   protected
+    { Protected declarations }
+
+    procedure SetActive ( b : boolean );
+    procedure WindowProcHandler(var Message: TMessage);
+
+   public
+    { Public declarations }
+
+    constructor Create( Master : TControl; const MsgDesc : string );
+    destructor Destroy; override;
+
+    function SendAppMessage(WParam : word; LParam : LongInt): LongInt;
+
+    property Active    : boolean read FActive write SetActive;
+    property OnMessage : TWndMethod read FOnMessage write FOnMessage;
+
+   end;
+
+implementation
+
+
+constructor TAppMessage.Create(Master : TControl; const MsgDesc : string );
+begin
+  inherited Create;
+
+  FMaster := Master;
+  FMsg := RegisterWindowMessage(PChar(UpperCase(MsgDesc)));
+end;
+
+
+destructor TAppMessage.Destroy;
+begin
+  Active := False;
+
+  inherited Destroy;
+end;
+
+
+
+procedure TAppMessage.SetActive ( b : boolean );
+begin
+  if (b <> FActive) and Assigned(FMaster) then
+  begin
+    if b then
+    begin
+      (* link handler into chain *)
+      FOldHandler := FMaster.WindowProc;
+      FMaster.WindowProc := WindowProcHandler;
+    end
+    else
+      (* unlink from chain *)
+      FMaster.WindowProc := FOldHandler;
+
+    FActive := b;
+  end;
+end;
+
+
+procedure TAppMessage.WindowProcHandler(var Message: TMessage);
+begin
+  if (message.Msg = FMsg) and (Assigned(FOnMessage)) then FOnMessage(Message);
+
+  (* call next in chain *)
+  if Assigned(FOldHandler) then FOldHandler(Message);
+end;
+
+
+function TAppMessage.SendAppMessage(WParam : word; LParam : LongInt): LongInt;
+begin
+  Result := SendMessage(HWND_BROADCAST, FMsg, WParam, LParam);
+end;
+
+end.

gbcomp/CartInfo.pas

@@ -0,0 +1,91 @@
+unit CartInfo;
+
+interface
+
+uses classes, SysUtils;
+
+type
+
+  THardwareStart = (hsDefault, hsGB, hsSGB, hsGBC);
+  TEmuStart      = integer;
+
+
+  TCartInfo = class
+  private
+    { Private declarations }
+    FName      : string;
+    FCartName  : string;         (* max 16 *)
+    FFileName  : TFileName;
+    FPath      : integer;
+    FSGB       : boolean;
+    FGBC       : boolean;
+    FJapanese  : boolean;
+    FPublisher : integer;
+    FHStart    : THardwareStart;
+    FEStart    : TEmuStart;
+
+  protected
+    { protected declarations }
+
+    function GetName : string;
+    procedure SetName(s : string);
+    procedure SetCartName(s : string);
+    procedure SetFileName(s : TFileName);
+
+  public
+    { Public declarations }
+    property Name : string read GetName write SetName;
+    property CartName : string read FCartName write SetCartName;
+    property FileName : TFileName read FFileName write SetFileName;
+    property Path : integer read FPath write FPath;
+
+    property SGB      : boolean read FSGB write FSGB;
+    property GBC      : boolean read FGBC write FGBC;
+    property Japanese : boolean read FJapanese write FJapanese;
+
+  end;
+
+
+
+
+implementation
+
+function CapitalCase( s : string): string;
+var i,j : integer;
+begin
+  i := Length(s);
+  if (i > 0) then
+  begin
+    SetLength(Result, i);
+    Result[1] := UpCase(s[1]);
+    for j := 2 to i do
+      if (s[j] in ['A'..'Z']) then Result[j] := char(ord(s[j])-ord('A')+ord('a')) else Result[j] := s[j];
+  end
+  else
+    Result := s;
+end;
+
+
+
+function TCartInfo.GetName : string;
+begin
+  Result := FName;
+end;
+
+procedure TCartInfo.SetName(s : string);
+begin
+  FName := Trim(s);
+end;
+
+procedure TCartInfo.SetCartName(s : string);
+begin
+  FCartName := Trim(s);
+  if (Name = '') then Name := CapitalCase(FCartName);
+end;
+
+procedure TCartInfo.SetFileName(s : TFileName);
+begin
+  FFileName := Trim(s);
+end;
+
+end.