main.pas

jssm的原代码

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ToolWin, ComCtrls, ExtCtrls, Menus, ImgList, ActnList,
  Spin, Math, Clipbrd, IniFiles, FileCtrl, ShellAPI, XPMan,
  GifImage;

type
  TGameFileInf = record
    Path,
    Spradrn_bin,
    Spr_bin,
    Adrn_bin,
    Real_bin,
    Pal_bin: String;
  end;
  TGameStream = record
    FSprAdrn,
    FSpr,
    FAdrn,
    FReal,
    FPal: TFileStream;
    GameID,
    MaxChar,
    CurFrame,
    FrameCount: Integer;
    LoadOK: Boolean;
  end;
  TSprAdrn = record
    ID,
    Addr: LongInt;
    Count: Short;
    Unknow: Short;
  end;
  TSpr = packed record
    Unknow: array[1..8] of Char;
    Frames: LongInt;
  end;
  TSprFrame = packed record
    ID: LongInt;
    Unknow: array[1..6] of Char;
  end;
  TAdrn = packed record
    ID,
    Addr,
    BlockLength,
    dx,
    dy,
    Width,
    Height: LongInt;
    de,
    ds,
    Flag: Char;
  end;
  TAdrnSAExt = packed record
    Unknow: array[1..45] of Char;  { 石器的Adrn是 80bit }
    Code: LongInt;
  end;
  TAdrnCGExt = packed record
    Unknow: array[1..5] of Char;   { 魔力的Adrn是 40bit }
    Code: LongInt;
  end;
  TRealHead = packed record
    Flag: array[1..2] of Char;
    Unknow: Short;
    Width,
    Height,
    BlockLength: LongInt;
  end;

  TMainForm = class(TForm)
    AniTimer: TTimer;
    SaveDialog: TSaveDialog;
    ImageList: TImageList;
    ActionList: TActionList;
    ActSave: TAction;
    ActPrior: TAction;
    ActNext: TAction;
    ActPlay: TAction;
    ActStop: TAction;
    ActCopy: TAction;
    ActExit: TAction;
    ActWeb: TAction;
    FileMenu: TPopupMenu;
    FileMenu1: TMenuItem;
    FileMenuS1: TMenuItem;
    FileMenu3: TMenuItem;
    FileMenu4: TMenuItem;
    FileMenuS2: TMenuItem;
    FileMenu5: TMenuItem;
    FileMenu6: TMenuItem;
    FileMenuS3: TMenuItem;
    FileMenu7: TMenuItem;
    FileMenu2: TMenuItem;
    FileMenu8: TMenuItem;
    pnlMenu: TPanel;
    MainToolBar: TToolBar;
    tbnFile: TToolButton;
    ToolButton2: TToolButton;
    cboGameSelector: TComboBox;
    ScrollBox: TScrollBox;
    FrameImage: TImage;
    pnlCtrl: TPanel;
    ToolBar: TToolBar;
    lblChar: TLabel;
    lblTimer: TLabel;
    lblAction: TLabel;
    spnID: TSpinEdit;
    spnDirect: TSpinEdit;
    spnTimer: TSpinEdit;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    pnlImage: TPanel;
    SAImage: TImage;
    StatusBar: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActPriorExecute(Sender: TObject);
    procedure ActNextExecute(Sender: TObject);
    procedure ActPlayExecute(Sender: TObject);
    procedure ActStopExecute(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure ActCopyExecute(Sender: TObject);
    procedure FrameImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AniTimerTimer(Sender: TObject);
    procedure spnTimerChange(Sender: TObject);
    procedure OnSelectEvent(Sender: TObject);
    procedure cboGameSelectorChange(Sender: TObject);
    procedure ActWebExecute(Sender: TObject);
  private
    GameStream: TGameStream;
    FBitmaps: array of TBitmap;
    FBmpOffs: array of TPoint;

    function FindGameFile(Section: Integer; Path: String = ''): TGameFileInf;
    procedure LoadGameStream;
    procedure FreeGameStream;
    procedure Reset(BmpCount: Integer);
    procedure DrawSmallFrame(I: Integer; Bmp: TBitmap; Pid: Integer);
    procedure DrawFrame(ID: Integer);
  public
    procedure LoadASprit(ID, Dir: Integer);
  end;

procedure ShowMsg(Text: String);
function DecompressStream(AStream: TMemoryStream): TMemoryStream;
function MakeBitmapStream(AWidth, AHeight: Integer; Pal: TFileStream; AStream: TMemoryStream): TMemoryStream;

var
  MsgPalMissing,
  MsgDataMissing,
  MsgSelectFolder,
  MsgCGTip,
  MsgCharCount,
  MsgCharInf : String;


const
  CstSA = 1;
  CstCG = 2;

  cstIniFile = 'Jssm.ini';
  cstSection: array [1..2] of string = ('SA', 'CG');
  cstAdrn: array [1..2] of string = ('Adrn_*.bin', 'GraphicInfo_*.bin');
  cstReal: array [1..2] of string = ('Real_*.bin', 'Graphic_*.bin');
  cstSpr: array [1..2] of string = ('Spr_*.bin', 'Anime_*.bin');
  cstSprAdrn: array [1..2] of string = ('Spradrn_*.bin', 'AnimeInfo_*.bin');

  CstWebURL= 'http://dbs.ghljj.com';


var
  MainForm: TMainForm;

implementation

{$R *.dfm}


function DecompressStream(AStream: TMemoryStream): TMemoryStream;
var
  I, S, Offset: LongInt;
  BS1, BS2, BS3, BS4, H, L: Byte;

  procedure DecStatic(Len: LongInt);
  var
    P: Pointer;
  begin
    P := AllocMem(Len);
    AStream.Read(P^, Len);
    Result.Write(P^, Len);
    FreeMem(P);
  end;
  procedure DecRepeat(Rep: LongInt);
  var
    K: LongInt;
  begin
    for K := 1 to Rep do Result.WriteBuffer(BS2, 1);
  end;
begin
  Offset := 0;
  Result := TMemoryStream.Create;
  try
    AStream.Position := 0;
    S := AStream.Size;
    I := 0;
    while I < S do
    begin
      AStream.ReadBuffer(BS1, 1);
      { if BS1 = $28 then Break; }
      H := BS1 shr 4;
      L := BS1 and $0F;
      case H of
        $0: begin
              Offset := L;
              DecStatic(Offset);
            end;
        $1: begin
              AStream.ReadBuffer(BS2, 1);
              Offset := L shl 8 + BS2; // L * $100 + BS2;
              DecStatic(Offset);
              Offset := Offset + 1;
            end;
        $2: begin
              AStream.ReadBuffer(BS2, 1);
              AStream.ReadBuffer(BS3, 1);
              Offset := L shl 16 + BS2 shl 8 + BS3; // L * $10000 + BS2 * $100 + BS3;
              DecStatic(Offset);
              Offset := Offset + 2;
            end;
        $8: begin
              AStream.ReadBuffer(BS2, 1);
              DecRepeat(L);
              Offset := 1;
            end;
        $9: begin
              AStream.ReadBuffer(BS2, 1);
              AStream.ReadBuffer(BS3, 1);
              DecRepeat(L shl 8 + BS3); //(L * $100 + BS3);
              Offset := 2;
            end;
        $A: begin
              AStream.ReadBuffer(BS2, 1);
              AStream.ReadBuffer(BS3, 1);
              AStream.ReadBuffer(BS4, 1);
              DecRepeat(L shl 16 + BS3 shl 8 + BS4); //(L * $10000 + BS3 * $100 + BS4);
              Offset := 3;
            end;
        $C: begin
              BS2 := $FF;
              DecRepeat(L);
              Offset := 0;
            end;
        $D: begin
              BS2 := $FF;
              AStream.ReadBuffer(BS3, 1);
              DecRepeat(L shl 8 + BS3); //(L * $100 + BS3);
              Offset := 1;
            end;
        $E: begin
              BS2 := $FF;
              AStream.ReadBuffer(BS3, 1);
              AStream.ReadBuffer(BS4, 1);
              DecRepeat(L shl 16 + BS3 shl 8 + BS4); //L * $10000 + BS3 * $100 + BS4);
              Offset := 2;
            end;
      else
        Break;
        { 52 44 01 84 28 00 00 00 ... 时结束，否则 28 00 00 00 将导致好多 00 }
      end;
      I := I + 1 + Offset;
    end;
  finally
  end;
end;


function MakeBitmapStream(AWidth, AHeight: Integer; Pal: TFileStream; AStream: TMemoryStream): TMemoryStream;
var
  BMF: TBitmapFileHeader;
  BH: TBitmapInfoHeader;
begin
  Result := TMemoryStream.Create;
  try
    FillChar(BMF, SizeOf(BMF), 0);
    BMF.bfType := $4D42;
    BMF.bfSize := SizeOf(BMF) + SizeOf(BH) + Pal.Size + AStream.Size;
    BMF.bfOffBits := SizeOf(BMF) + SizeOf(BH) + Pal.Size;
    FillChar(BH, SizeOf(BH), 0);
    BH.biSize := SizeOf(BH);
    BH.biWidth := AWidth;
    BH.biHeight := AHeight;
    BH.biPlanes := 1;
    BH.biBitCount := 8;
    BH.biXPelsPerMeter := $EC4;
    BH.biYPelsPerMeter := $EC4;

    Result.WriteBuffer(BMF, SizeOf(BMF));
    Result.WriteBuffer(BH, SizeOf(BH));
    Result.CopyFrom(Pal, 0);
    Result.CopyFrom(AStream, 0);

    // !!! 释放空间 !!!
    { 内存泄漏! }
    FreeAndNil(AStream);
  finally
  end;
end;


procedure ShowMsg(Text: String);
begin
  //Application.MessageBox(PChar(Text), 'Jssm', MB_OK + MB_ICONINFORMATION);
  MessageDlg(Text, mtInformation, [mbOk], 0);
end;


{ ================================================================== }
function TMainForm.FindGameFile(Section: Integer; Path: String = ''): TGameFileInf;
var
  F: TIniFile;
  S: String;

  function FindFile(APath, AFile: String): String;
  var
    Rec: TSearchRec;
  begin
    Result := '';
    if FindFirst(APath + AFile, faAnyFile, Rec) = 0 then
    begin
      Result := APath + Rec.Name;
      FindClose(Rec);
    end;
  end;
begin
  F := TIniFile.Create(ExtractFilePath(ParamStr(0)) + cstIniFile);
  S := cstSection[Section];

  if Path = '' then
    Result.Path := IncludeTrailingPathDelimiter(F.ReadString(S, 'DataDir', ''))
  else
  begin
    Result.Path := IncludeTrailingPathDelimiter(Path);
    F.WriteString(S, 'DataDir', Path);
  end;
  Result.Pal_bin := ExtractFilePath(ParamStr(0)) + F.ReadString(S, 'Pal_bin', '');
  Result.Spr_bin := FindFile(Result.Path, cstSpr[Section]);
  Result.Spradrn_bin := FindFile(Result.Path,  cstSpradrn[Section]);
  Result.Adrn_bin := FindFile(Result.Path, cstAdrn[Section]);
  Result.Real_bin := FindFile(Result.Path, cstReal[Section]);

  F.Free;
end;


procedure TMainForm.LoadGameStream;
var
  T: TGameFileInf;
  Section: Integer;
begin
  Section := cboGameSelector.ItemIndex;
  if Section = 0 then Exit;

  T := FindGameFile(Section);

  { pal missing }
  if not FileExists(T.Pal_bin) then
  begin
    ShowMsg(Format(MsgPalMissing, [T.Pal_bin]));
    Exit;
  end;

  { data missing }
  while not (FileExists(T.Spradrn_bin) and FileExists(T.Spr_bin) and
    FileExists(T.Adrn_bin) and FileExists(T.Real_bin)) do
  begin
    ShowMsg(Format(MsgDataMissing, [T.Path]));
    if not SelectDirectory(MsgSelectFolder, '', T.Path) then Exit;
    T := FindGameFile(Section, T.Path);
  end;

  { Ready to load }
  with GameStream do
  begin
    if LoadOK then FreeGameStream;
    LoadOK := False;

    FSprAdrn := TFileStream.Create(T.Spradrn_bin, fmOpenRead + fmShareDenyNone);
    FSpr := TFileStream.Create(T.Spr_bin, fmOpenRead + fmShareDenyNone);
    FAdrn := TFileStream.Create(T.Adrn_bin, fmOpenRead + fmShareDenyNone);
    FReal := TFileStream.Create(T.Real_bin, fmOpenRead + fmShareDenyNone);
    FPal := TFileStream.Create(T.Pal_bin, fmOpenRead + fmShareDenyNone);

    GameID := Section;
    MaxChar := FSprAdrn.Size div SizeOf(TSprAdrn);
    CurFrame := 0;
    FrameCount := 0;

    spnID.MaxValue := MaxChar;
    { if GameID = CstSA then StatusBar.Panels[0].Text := ''; }
    { if GameID = CstCG then StatusBar.Panels[0].Text := ResCGTip; }
    StatusBar.Panels[1].Text := Format(MsgCharCount, [MaxChar]);

    LoadOK := True;

    if GameID = CstSA then
    begin
      if spnID.Value = 1 then LoadASprit(spnID.Value, spnDirect.Value)
      else spnID.Value := 1;
    end;
    if GameID = CstCG then
    begin
      if spnID.Value = 2376 then LoadASprit(spnID.Value, spnDirect.Value)
      else spnID.Value := 2376;
    end;
  end;
end;


procedure TMainForm.FreeGameStream;
begin
  with GameStream do
  begin
    if not LoadOK then Exit;
    FreeAndNil(FSprAdrn);