main.pas

一个曾经热门的网络游戏RO查看GRF工具的源码

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grf, ComCtrls, ToolWin, ImgList, ExtCtrls, Buttons, Types,
  ShellAPI, ShlObj, ExtractThread, VirtualTrees, Menus;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    StatusBar1: TStatusBar;
    Search: TEdit;
    SearchBtn: TToolButton;
    ImageList2: TImageList;
    Splitter1: TSplitter;
    PreviewPane: TPanel;
    Notebook1: TNotebook;
    RichEdit1: TRichEdit;
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    Timer1: TTimer;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    ExtractWatcher: TTimer;
    ExtractorPanel: TPanel;
    Panel3: TPanel;
    StopButton: TSpeedButton;
    ProgressBar1: TProgressBar;
    FileList: TVirtualStringTree;
    Label1: TLabel;
    OpenBtn: TSpeedButton;
    ExtractBtn: TSpeedButton;
    PreviewBtn: TSpeedButton;
    AboutBtn: TSpeedButton;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    procedure FormResize(Sender: TObject);
    procedure OpenBtnClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure PreviewBtnClick(Sender: TObject);
    procedure SearchBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PreviewPaneResize(Sender: TObject);
    procedure FileListClick(Sender: TObject);
    procedure SearchKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FileListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure AboutBtnClick(Sender: TObject);
    procedure ExtractBtnClick(Sender: TObject);
    procedure ExtractWatcherTimer(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FileListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure FileListDblClick(Sender: TObject);
    procedure FileListCompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure FileListHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    Grf: TGrf;
    FSortColumn: Integer;
    FSortDirection: TSortDirection;
    function OpenGRF(FileName: String): Boolean;
    procedure FillFileList;
    procedure UpdateSelectionStatus;
    procedure IterateList(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
  public
    Extractor: TExtractor;
  end;

  TGrfItem = Record
    i: Integer;
  end;

var
  Form1: TForm1;

implementation

uses
  About, GPattern;

{$R *.dfm}

function TForm1.OpenGRF(FileName: String): Boolean;
var
  Error: TGrfError;
  NewGrf: TGrf;
begin
  NewGrf := grf_open (PChar(FileName), Error);
  if NewGrf = nil then
  begin
      MessageBox(Handle, PChar('Unable to open ' + ExtractFileName(FileName) + ':' + #13#10 +
                         grf_strerror(Error)), 'Error', MB_ICONERROR);
      Result := False;
      Exit;
  end;

  if Grf <> nil then
      grf_free (Grf);
  Grf := NewGrf;

  FSortColumn := -1;
  FillFileList;
  Caption := FileName + ' - GRF Tool';
  ExtractBtn.Enabled := True;
  Result := True;
end;

function GetTypeName(FileName: String): String;
var
  Ext: String;
begin
  Ext := UpperCase(ExtractFileExt(FileName));
  if Ext = '.BMP' then
      Result := 'Bitmap Image'
  else if Ext = '.JPG' then
      Result := 'JPEG Image'
  else if Ext = '.GIF' then
      Result := 'GIF Image'
  else if Ext = '.PNG' then
      Result := 'PNG Image'
  else if Ext = '.TXT' then
      Result := 'Text File'
  else if Ext = '.WAV' then
      Result := 'Wave Sound'
  else if Ext = '.MP3' then
      Result := 'MP3 Music'
  else if Ext = '.SPR' then
      Result := 'Sprite Data'
  else if Ext = '.XML' then
      Result := 'XML Document'
  else
      Result := Ext;
end;

function FriendlySizeName(Size: Cardinal): String;
begin
  if Size < 1024 then
      Result := IntToStr(Size) + ' bytes'
  else if (Size >= 1024) and (Size < 1024 * 1024) then
      Result := Format('%.1f', [Size / 1024]) + ' KB'
  else
      Result := Format('%.1f', [Size / 1024 / 1024]) + ' MB';
end;

procedure TForm1.FillFileList;
var
  i: Cardinal;
  SearchFor: PChar;
  SearchLen: Integer;
  Pattern: PGPatternSpec;
  Node: ^TGrfItem;
begin
  // Do a substring search if the search text doesn't contain wildcards
  SearchLen := Length(Search.Text);
  if  (Pos('*', Search.Text) = 0) and (Pos('?', Search.Text) = 0) then
      SearchFor := PChar(LowerCase('*' + Search.Text + '*'))
  else
      SearchFor := PChar(LowerCase(Search.Text));
  Screen.Cursor := crHourGlass;

  FileList.BeginUpdate;
  FileList.Clear;
  FileList.EndUpdate;
  Application.ProcessMessages;

  if SearchLen > 0 then
      Pattern := g_pattern_spec_new(SearchFor)
  else
      Pattern := nil;

  FileList.BeginUpdate;
  for i := 0 to Grf.nfiles - 1 do
  begin
      if (Assigned(Pattern)) and (not g_pattern_match_string(Pattern, PChar(LowerCase(Grf.files[i].Name)))) then
          Continue;
      if Grf.files[i].TheType = 2 then
          Continue;    // Do not list folders

      Node := FileList.GetNodeData(FileList.AddChild(nil));
      Node.i := i;
  end;
  FileList.EndUpdate;

  if Assigned(Pattern) then
      g_pattern_spec_free(Pattern);
  Screen.Cursor := crDefault;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Search.Width := Width - SearchBtn.Width - Label1.Width - ToolBar2.Indent - 8;
end;

procedure TForm1.OpenBtnClick(Sender: TObject);
var
  PrevText: String;
begin
  if OpenDialog1.Execute then
  begin
      PrevText := StatusBar1.SimpleText;
      StatusBar1.SimpleText := 'Loading ' + ExtractFileName(OpenDialog1.FileName) + '...';
      Application.ProcessMessages;
      if OpenGRF(OpenDialog1.FileName) then
          UpdateSelectionStatus
      else
          StatusBar1.SimpleText := PrevText;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  PreviewBtn.Down := not PreviewBtn.Down;
  PreviewBtnClick(Sender);
end;

procedure TForm1.PreviewBtnClick(Sender: TObject);
begin
  PreviewPane.Visible := PreviewBtn.Down;
  Splitter1.Visible := PreviewBtn.Down;
end;

procedure TForm1.SearchBtnClick(Sender: TObject);
begin
  if Grf = nil then Exit;
  StatusBar1.SimpleText := 'Searching...';
  FillFileList;
  StatusBar1.SimpleText := IntToStr(FileList.RootNode.ChildCount) + ' files found';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Grf := nil;
  Extractor := nil;
  FileList.NodeDataSize := SizeOf(TGrfItem);
  Font.Name := 'Tahoma';
  Panel2.Font.Name := 'Tahoma';
end;

procedure TForm1.PreviewPaneResize(Sender: TObject);
begin
  SpeedButton1.Left := Panel2.Width - SpeedButton1.Width - 2;
end;

procedure TForm1.UpdateSelectionStatus;
var
  Size: Integer;
  Node: PVirtualNode;
  Data: ^TGrfItem;
begin
  if not Assigned(Grf) then Exit;

  if FileList.SelectedCount = 0 then
      StatusBar1.SimpleText := IntToStr(FileList.RootNode.ChildCount) + ' files'
  else if FileList.SelectedCount = 1 then
  begin
      Data := FileList.GetNodeData(FileList.GetNextSelected(nil));
      StatusBar1.SimpleText := IntToStr(Grf.nFiles) + ' files - file #' +
          IntToStr(Data.i + 1) + ' selected';
  end else
  begin
      Size := 0;
      Node := FileList.RootNode;
      repeat
          Node := FileList.GetNextSelected(Node);
          if not Assigned(Node) then Break;

          Data := FileList.GetNodeData(Node);
          Inc(Size, Grf.files[Data.i].RealLen);