main.pas

jssm的原代码

    FreeAndNil(FSpr);
    FreeAndNil(FAdrn);
    FreeAndNil(FReal);
    FreeAndNil(FPal);
  end;
end;


{ ================================================================== }
procedure TMainForm.LoadASprit(ID, Dir: Integer);
var
  AStream, BmpStream: TMemoryStream;
  ASprAdrn: TSprAdrn;
  ASpr: TSpr;
  ASprFrame: TSprFrame;
  AAdrn: TAdrn;
  AAdrnSAExt: TAdrnSAExt;
  AAdrnCGExt: TAdrnCGExt;
  ARealHead: TRealHead;
  I: Integer;
begin
  if not GameStream.LoadOK then Exit;
  if (ID <= 0) or (ID > GameStream.MaxChar) Then Exit;

  Screen.Cursor := crHourGlass;
  with GameStream do
  try
    { 读角色动画信息 }
    FSprAdrn.Seek((ID - 1) * SizeOf(TSprAdrn), soFromBeginning);
    FSprAdrn.ReadBuffer(ASprAdrn, SizeOf(TSprAdrn));
    spnDirect.MaxValue := ASprAdrn.Count;
    if Dir > spnDirect.MaxValue then Dir := 1;

    { 跳到指定角色的信息处 }
    FSpr.Seek(ASprAdrn.Addr, soFromBeginning);
    { 跳过前面的帧信息 }
    for I := 1 to Dir - 1 do
    begin
      FSpr.ReadBuffer(ASpr, SizeOf(TSpr));
      FSpr.Seek(ASpr.Frames * SizeOf(TSprFrame), soFromCurrent);
    end;
    { 读帧数 }
    FSpr.ReadBuffer(ASpr, SizeOf(TSpr));
    StatusBar.Panels[0].Text := Format(MsgCharInf, [ID, ASprAdrn.Count, Dir, ASpr.Frames]);
    Reset(ASpr.Frames);

    CurFrame := 0;
    FrameCount := ASpr.Frames;

    AStream := TMemoryStream.Create;

    for I := 1 to ASpr.Frames do
    begin
      { 读一个帧 }
      FSpr.ReadBuffer(ASprFrame, SizeOf(TSprFrame));
      { 读该帧图片信息 }
      if GameID = CstSA then FAdrn.Seek(ASprFrame.ID * (SizeOf(TAdrn) + SizeOf(TAdrnSAExt)), soFromBeginning);
      if GameID = CstCG then FAdrn.Seek(ASprFrame.ID * (SizeOf(TAdrn) + SizeOf(TAdrnCGExt)), soFromBeginning);
      FAdrn.ReadBuffer(AAdrn, SizeOf(TAdrn));
      if GameID = CstSA then FAdrn.ReadBuffer(AAdrnSAExt, SizeOf(TAdrnSAExt));
      if GameID = CstCG then FAdrn.ReadBuffer(AAdrnCGExt, SizeOf(TAdrnCGExt));
      { 解压缩 }
      FReal.Seek(AAdrn.Addr, soFromBeginning);
      FReal.Read(ARealHead, SizeOf(TRealHead));
      AStream.Clear;
      AStream.CopyFrom(FReal, ARealHead.BlockLength);

      { !!! 合成 bitmap，注意此处不能用 AStream，内存不能释放 !!! }
      { 内存泄漏! }
      { 2005.4.9 内存泄漏严重，修改此处和 MakeBitmapStream }
      { MakeBitmapStream 和 DecompressStream 一样，本身不释放内存 }
      { 1- MakeBitmapStream 内部释放了 DecompressStream 生成的 Stream }
      { 2- 此处则是释放 MakeBitmapStream 返回的 Stream }
      BmpStream := MakeBitmapStream(ARealHead.Width, ARealHead.Height, GameStream.FPal, DecompressStream(AStream));
      BmpStream.Position := 0;
      FBitmaps[I - 1].LoadFromStream(BmpStream);
      FreeAndNil(BmpStream);

      { 画图 }
      FBmpOffs[I - 1] := Point(AAdrn.dx, AAdrn.dy);
      DrawSmallFrame(I - 1, FBitmaps[I - 1], AAdrn.ID);
    end;
    DrawFrame(0);

    FreeAndNil(AStream);
  finally
    Screen.Cursor := crDefault;
  end;
end;


procedure TMainForm.Reset(BmpCount: Integer);
var
  I, J, L: Integer;
begin
  { 内存泄漏! }
  for I := 0 to High(FBitmaps) do FBitmaps[I].Free;
  SetLength(FBitmaps, BmpCount);
  SetLength(FBmpOffs, BmpCount);
  for I := 0 to High(FBitmaps) do FBitmaps[I] := TBitmap.Create;

{  L := Length(FBitmaps);
  if BmpCount > Length(FBitmaps) then
  begin
    SetLength(FBitmaps, BmpCount);
    SetLength(FBmpOffs, BmpCount);
    for I := L to Length(FBitmaps) - 1 do
      FBitmaps[I] := TBitmap.Create;
  end;
}
  with FrameImage do
  begin
    Picture := nil;
    Width := BmpCount * 68;
    Canvas.Brush.Color := clBlack;
    Canvas.FillRect(ClientRect);
    Canvas.Brush.Color := clWhite;
    Canvas.Pen.Color := clWhite;
    for I := 0 to BmpCount - 1 do
    begin
      if I > 0 then
      begin
        Canvas.MoveTo(I * 68, 0);
        Canvas.LineTo(I * 68, Height);
      end;
      for J := 0 to 5 do
      begin
        L := I * 68 + J * 10 + 5;
        Canvas.Rectangle(L, 3, L + 5, 8);
        Canvas.Rectangle(L, 58, L + 5, 63);
      end;
    end;
    // 准备写图片 ID 号
    Canvas.MoveTo(0, 68);
    Canvas.LineTo(Width, 68);
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Color := clLime;
  end;
  {AniTimer.Enabled := False;
  SAImage.Canvas.FillRect(SAImage.ClientRect);}
end;

procedure TMainForm.DrawSmallFrame(I: Integer; Bmp: TBitmap; Pid: Integer);
var
  R: TRect;
  ds: Real;
  dw, dh: Integer;
begin
  R := Rect(I * 68 + 4, 12, 0, 0);
  ds := Max(Bmp.Width / 60, Bmp.Height / 44);
  dw := Round(Bmp.Width / ds);
  dh := Round(Bmp.Height / ds);
  R.Left := R.Left + (60 - dw) div 2;
  R.Top := R.Top + (44 - dh) div 2;
  R.Right := R.Left + dw;
  R.Bottom := R.Top + dh;
  FrameImage.Canvas.StretchDraw(R, Bmp);
  FrameImage.Canvas.TextOut(I * 68 + 4, 70, IntToStr(Pid));
end;

procedure TMainForm.DrawFrame(ID: Integer);
var
  L, T: Integer;
begin
  with SAImage do
  begin
    Canvas.Brush.Color := clBlack;
    Canvas.FillRect(ClientRect);
    L := Width div 2 + FBmpOffs[ID].X;
    T := Height div 2 + 20 + FBmpOffs[ID].Y;
    Canvas.Draw(L, T, FBitmaps[ID]);
  end;
end;


procedure TMainForm.FormCreate(Sender: TObject);
var
  F: TIniFile;
  S: String;
begin
  F := TIniFile.Create(ExtractFilePath(ParamStr(0)) + cstIniFile);
  S := 'Lang';

  Caption := F.ReadString(S, 'Title', 'Jssm - char viewer');

  tbnFile.Caption := F.ReadString(S, 'File', '&File');
  ActSave.Caption := F.ReadString(S, 'Save', '&Save');
  ActPrior.Caption := F.ReadString(S, 'Prior', 'P&rior');
  ActNext.Caption := F.ReadString(S, 'Next', 'N&ext');
  ActStop.Caption := F.ReadString(S, 'Stop', 'S&top');
  ActPlay.Caption := F.ReadString(S, 'Play', '&Play');
  ActCopy.Caption := F.ReadString(S, 'Copy', '&Copy');
  ActExit.Caption := F.ReadString(S, 'Exit', 'E&xit');
  ActWeb.Caption := F.ReadString(S, 'Site', '&DBS Studio');

  lblChar.Caption := F.ReadString(S, 'Char', ' Char ');
  lblAction.Caption := F.ReadString(S, 'Action', ' Action ');
  lblTimer.Caption := F.ReadString(S, 'Timer', ' Timer ');

  with cboGameSelector do
  begin
    Items.Clear;
    Items.Add(F.ReadString(S, 'SelectGame', '- Select A Game -'));
    Items.Add(F.ReadString(S, 'GameSA', 'StoneAge'));
    Items.Add(F.ReadString(S, 'GameCG', 'CrossGate'));
    ItemIndex := 0;
  end;

  MsgPalMissing := F.ReadString(S, 'PalMissing', 'Missing Pal: %s.');
  MsgDataMissing := F.ReadString(S, 'DataMissing', 'Game data not found: %s, please select directory of data.');
  MsgSelectFolder := F.ReadString(S, 'SelectFolder', 'Choose data folder:');
  MsgCGTip := F.ReadString(S, 'CGTip', 'CG char begin with 2375.');
  MsgCharCount := F.ReadString(S, 'CharCount', ' %d char');
  MsgCharInf := F.ReadString(S, 'CharInfo', 'Char: %d has %d actions, Action: %d has %d frame');

  F.Free;
end;


procedure TMainForm.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  FreeGameStream;
  for I := 0 to High(FBitmaps) do FBitmaps[I].Free;
end;


procedure TMainForm.ActSaveExecute(Sender: TObject);
  procedure AddBmpToGif(Gif: TGifImage; X, Y: Integer; Bmp: TBitmap);
  var
    Ext: TGIFGraphicControlExtension;
    App: TGIFAppExtNSLoop;
    Index: Integer;
  begin
    Index := Gif.Add(Bmp);
    Gif.Images[Index].Interlaced := True;
    { 设置帧尺寸和偏移量 }
    Gif.Images[Index].Left := X;
    Gif.Images[Index].Top := Y;
    Gif.Images[Index].Width := Bmp.Width;
    Gif.Images[Index].Height := Bmp.Height;
    { 设置帧的透明色、延迟时间、重画方法(这里是恢复背景色) }
    Ext := TGIFGraphicControlExtension.Create(Gif.Images[index]);
    Gif.Images[Index].Extensions.Add(Ext);
    // Make it transparent and add delay after
    with Ext do
    begin
      TransparentColor := Bmp.TransparentColor;
      Transparent := True;
      Delay := AniTimer.Interval div 10;
      Disposal := dmBackground;
    end;
    { 设置无限循环播放 }
    App := TGIFAppExtNSLoop.Create(Gif.Images[Index]);
    Gif.Images[Index].Extensions.Add(App);
    App.Loops := 0;
  end;

  procedure DoSaveToGif(FileName: String);
  var
    Gif: TGifImage;
    I, L, T: Integer;
    R: TRect;
  begin
    R := Rect(0, 0, 0, 0);
    for I := 0 to GameStream.FrameCount - 1 do
    begin
      if FBmpOffs[I].X < R.Left then R.Left := FBmpOffs[I].X;
      if FBmpOffs[I].Y < R.Top then R.Top := FBmpOffs[I].Y;
      if FBitmaps[I].Width + FBmpOffs[I].X > R.Right then R.Right := FBitmaps[I].Width + FBmpOffs[I].X;
      if FBitmaps[I].Height + FBmpOffs[I].Y > R.Bottom then R.Bottom := FBitmaps[I].Height + FBmpOffs[I].Y;
    end;
    Gif := TGifImage.Create;
    { 设置 Gif 图片尺寸 }
    Gif.Width := R.Right - R.Left;
    Gif.Height := R.Bottom - R.Top;
    { 添加 Bitmap 帧，指定偏移量 }
    for I := 0 to GameStream.FrameCount - 1 do
    begin
      L := FBmpOffs[I].X - R.Left;
      T := FBmpOffs[I].Y - R.Top;
      AddBmpToGif(Gif, L, T, FBitmaps[I]);
    end;

    if LowerCase(ExtractFileExt(FileName)) <> '.gif' then FileName := FileName + '.gif';
    { 优化调色板、删除局部调色板、设置交错显示 }
    Gif.OptimizeColorMap;
    { 保存到文件 }
    Gif.SaveToFile(FileName);
    Gif.Free;
  end;

  procedure DoSaveToSingleBmp(FileName: String);
  var
    I, L, T: Integer;
    tmp: TBitmap;
    R: TRect;
  begin
    R := Rect(0, 0, 0, 0);
    for I := 0 to GameStream.FrameCount - 1 do
    begin
      if FBmpOffs[I].X < R.Left then R.Left := FBmpOffs[I].X;
      if FBmpOffs[I].Y < R.Top then R.Top := FBmpOffs[I].Y;
      if FBitmaps[I].Width + FBmpOffs[I].X > R.Right then R.Right := FBitmaps[I].Width + FBmpOffs[I].X;
      if FBitmaps[I].Height + FBmpOffs[I].Y > R.Bottom then R.Bottom := FBitmaps[I].Height + FBmpOffs[I].Y;
    end;
    tmp := TBitmap.Create;
    tmp.Width := (R.Right - R.Left) * GameStream.FrameCount;
    tmp.Height := R.Bottom - R.Top;
    tmp.Canvas.Brush.Color := clBlack;
    tmp.Canvas.FillRect(Rect(0, 0, tmp.Width, tmp.Height));
    for I := 0 to GameStream.FrameCount - 1 do
    begin
      L := FBmpOffs[I].X - R.Left + (R.Right - R.Left) * I;
      T := FBmpOffs[I].Y - R.Top;
      tmp.Canvas.Draw(L, T, FBitmaps[I]);
    end;
    if LowerCase(ExtractFileExt(FileName)) <> '.bmp' then FileName := FileName + '.bmp';
    tmp.SaveToFile(FileName);
  end;

  procedure DoSaveToSerialBmp(FileName: String);
  var
    I: Integer;
    F: String;
  begin
    F := ExtractFilePath(FileName) + ExtractFileName(FileName);
    for I := 0 to GameStream.FrameCount - 1 do FBitmaps[I].SaveToFile(F + '_' + IntToStr(I + 1) + '.bmp');
  end;
begin
  if GameStream.FrameCount = 0 then Exit;
  with SaveDialog do
  begin
    FileName := Format('%d_%d', [spnID.Value, spnDirect.Value]);
    if not Execute then Exit;
    case FilterIndex of
      1: DoSaveToGif(FileName);
      2: DoSaveToSingleBmp(FileName);
      3: DoSaveToSerialBmp(FileName);
    end;
  end;
end;

procedure TMainForm.ActPriorExecute(Sender: TObject);
begin
  spnID.Value := spnID.value - 1;
end;

procedure TMainForm.ActNextExecute(Sender: TObject);
begin
  spnID.Value := spnID.value + 1;
end;

procedure TMainForm.ActPlayExecute(Sender: TObject);
begin
  AniTimer.Tag := 0;
  AniTimer.Enabled := True;
end;

procedure TMainForm.ActStopExecute(Sender: TObject);
begin
  AniTimer.Tag := 0;
  AniTimer.Enabled := False;
end;

procedure TMainForm.ActCopyExecute(Sender: TObject);
var
  I: Integer;
begin
  if GameStream.FrameCount = 0 then Exit;
  try
    I := GameStream.CurFrame;
    Clipboard.Assign(FBitmaps[I]);
  finally
  end;
end;

procedure TMainForm.ActExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FrameImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
  I: Integer;
begin
  for I := 0 to FrameImage.Width div 68 - 1 do
  begin
    R := Rect(I * 68, 0, (I + 1) * 68, 68);
    if PtInRect(R, Point(X, Y)) then
    begin
      DrawFrame(I);
    end;
  end;
end;

procedure TMainForm.AniTimerTimer(Sender: TObject);
begin
  with GameStream do
  begin
    if FrameCount <= 1 then Exit;
    DrawFrame(CurFrame);
    Inc(CurFrame);
    if CurFrame >= FrameCount then CurFrame := 0;
  end;
end;

procedure TMainForm.spnTimerChange(Sender: TObject);
begin
  AniTimer.Interval := spnTimer.Value * 10;
end;

procedure TMainForm.OnSelectEvent(Sender: TObject);
begin
  LoadASprit(spnID.Value, spnDirect.Value);
end;

procedure TMainForm.cboGameSelectorChange(Sender: TObject);
begin
  LoadGameStream;
end;

procedure TMainForm.ActWebExecute(Sender: TObject);
begin
  ShellExecute(Handle, PChar('OPEN'), PChar(CstWebURL), nil, nil, SW_SHOW);
end;

end.