GLScene/Demos/utilities/ArchiveEdit/Main.pas

unit Main;

interface

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.StrUtils,
  System.ImageList,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.Menus,
  Vcl.ImgList,
  Vcl.ExtCtrls,
  Vcl.ComCtrls,
  Vcl.Imaging.Jpeg,

  GLS.ArchiveManager,
  GLS.SceneViewer,

  GLS.BaseClasses,
  GLS.VectorTypes,
  GLS.Scene,
  GLS.VectorGeometry,
  GLS.SimpleNavigation,
  GLS.Material,
  GLS.VectorFileObjects,
  GLS.Objects,
  GLS.Coordinates,
  GLS.Graphics,
  GLS.State,
  GLS.CompositeImage,
  // FileFormats 3D
  GLS.FileJPEG,
  GLS.FilePAK,
  GLS.FileZLIB,

  GLS.FileMS3D,
  GLS.File3DS,
  GLS.FileMD2,
  GLS.FileMD3,
  GLS.FileLMTS,
  GLS.FileOBJ,
  GLS.FileSMD,
  GLS.FileTGA,
  GLS.FilePNG,
  GLS.FileDDS,

  GLS.Utils;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    TreeView: TTreeView;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ImageList1: TImageList;
    ListView: TListView;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Bevel1: TBevel;
    Edit1: TMenuItem;
    Createfolder1: TMenuItem;
    Addfiles1: TMenuItem;
    Deleteselectedfile1: TMenuItem;
    Deleteselectedfolder1: TMenuItem;
    N2: TMenuItem;
    Extractselectedfiles1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Compression1: TMenuItem;
    Max1: TMenuItem;
    None1: TMenuItem;
    Fast1: TMenuItem;
    Default1: TMenuItem;
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLSprite1: TGLSprite;
    GLFreeForm1: TGLFreeForm;
    GLMaterialLibrary1: TGLMaterialLibrary;
    GLSimpleNavigation1: TGLSimpleNavigation;
    GLSArchiveManager1: TGLSArchiveManager;
    GLCube1: TGLCube;
    procedure FormCreate(Sender: TObject);
    procedure TreeViewRefresh;
    procedure FileListRefresh;
    procedure AddNode(text: string; node: TTreeNode);
    function TreeIndexOf(s: string; node: TTreeNode): integer;
    function ListIndexOf(s: string): integer;
    procedure TreeViewCollapsing(Sender: TObject; node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure ListViewClick(Sender: TObject);
    procedure ListViewDblClick(Sender: TObject);
    procedure TreeViewChange(Sender: TObject; node: TTreeNode);
    procedure ListViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListViewChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Createfolder1Click(Sender: TObject);
    procedure Addfiles1Click(Sender: TObject);
    procedure Deleteselectedfile1Click(Sender: TObject);
    procedure Deleteselectedfolder1Click(Sender: TObject);
    procedure TreeViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Extractselectedfiles1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure None1Click(Sender: TObject);
  private
     
  public
     
  end;

var
  Form1: TForm1;
  CurPath, Selection: string;
  ArchiveManager: TGLSArchiveManager;
  Archive: TLibArchive;
  vMenu: TMenuItem;

//-------------------------------------
implementation
//-------------------------------------

uses
  FolderDialog, 
  FolderSelect;

{$R *.dfm}
{.$R icons.res}

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
  SetGLSceneMediaDir();
  Bmp := TBitmap.Create;
  Bmp.LoadFromResourceName(HInstance, 'icons');
  ImageList1.AddMasked(Bmp, clWhite);
  Bmp.Free;
  ArchiveManager := TGLSArchiveManager.Create(Self);
  Archive := ArchiveManager.Archives.Add;
  vMenu := None1;
end;


procedure TForm1.AddNode(text: string; node: TTreeNode);
var
  s: string;
  c: integer;
begin
  c := Pos('/', text);
  if c = 0 then
    exit;
  s := Copy(text, 1, c - 1);
  Delete(text, 1, c);
  if TreeIndexOf(s, node) = -1 then
    AddNode(text, TreeView.Items.AddChild(node, s))
  else
    AddNode(text, node[TreeIndexOf(s, node)]);
end;

function TForm1.TreeIndexOf(s: string; node: TTreeNode): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to node.Count - 1 do
    if node[i].text = s then
      Result := i;
end;

function TForm1.ListIndexOf(s: string): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to ListView.Items.Count - 1 do
    if ListView.Items[i].Caption = s then
      Result := i;
end;

procedure TForm1.TreeViewRefresh;
var
  i: integer;
begin
  with TreeView do
  begin
    Items.Clear;
    Items.AddChild(Items.GetFirstNode, ExtractFileName(Archive.FileName));
    for i := 0 to Archive.ContentList.Count - 1 do
      AddNode(Archive.ContentList[i], Items.GetFirstNode);
    Items[0].Expanded := True;
    Items[0].SelectedIndex := 1;
    Items[0].ImageIndex := 1;
  end;
  TreeView.Selected := TreeView.Items.GetFirstNode;
end;

function MakeMemSize(size: integer): string;
const
  kb = 1024;
  mb = kb * kb;
  gb = mb * kb;
begin
  case size of
    0 .. kb - 1:
      Result := IntToStr(size) + ' B';
    kb .. mb - 1:
      Result := Format('%.2f KB', [size / kb]);
    mb .. gb - 1:
      Result := Format('%.2f MB', [size / mb]);
  else
    Result := Format('%.2f GB', [size / gb]);
  end;
end;

procedure TForm1.FileListRefresh;
var
  i, j: integer;
  s, name: string;
  n: TTreeNode;
  dir: Boolean;
begin
  n := TreeView.Selected;
  s := n.text;
  if s = ExtractFileName(Archive.FileName) then
    s := '';
  while Assigned(n.parent) do
  begin
    n := n.parent;
    if n.AbsoluteIndex <> 0 then
      s := n.text + '/' + s;
  end;
  if s <> '' then
    s := s + '/';
  CurPath := s;

  ListView.Clear;
  for i := 0 to Archive.ContentList.Count - 1 do
    if Copy(Archive.ContentList[i], 1, Length(s)) = s then
    begin
      name := RightStr(Archive.ContentList[i], Length(Archive.ContentList[i]) -
        Length(s));
      j := Pos('/', name);
      if j = 0 then
        dir := False
      else
        dir := True;

      if dir = True then
        name := Copy(name, 1, j - 1);
      if ListIndexOf(name) = -1 then
        with ListView.Items.Add do
        begin
          Caption := Name;
          if dir = True then
          begin
            SubItems.Add('-');
            SubItems.Add('-')
          end
          else
          begin
            SubItems.Add(MakeMemSize(Archive.GetContentSize(i)));
            SubItems.Add(MakeMemSize(Archive.GetContentSize(i)))
          end;

          if dir = True then
            ImageIndex := 0
          else
            ImageIndex := 2;
        end;
    end;
end;

procedure TForm1.TreeViewCollapsing(Sender: TObject; node: TTreeNode;
  var AllowCollapse: Boolean);
begin
  if node.AbsoluteIndex = 0 then
    AllowCollapse := False
  else
    AllowCollapse := True;
end;

procedure TForm1.ListViewClick(Sender: TObject);
var
  s: string;
  len, x: Byte;
  strm: TStream;
  img: TGLCompositeImage;
  objSize: Single;
begin
  if not Assigned(ListView.Selected) then
    exit;
  s := ListView.Selected.Caption;
  Selection := CurPath + s;

  if ListView.Selected.ImageIndex = 2 then
  begin
    len := Length(s);
    s := LowerCase(s);
    if (Copy(s, len - 3, 5) = 'ms3d') or (Copy(s, len - 2, 5) = '3ds') or
      (Copy(s, len - 2, 5) = 'md2') or (Copy(s, len - 2, 5) = 'md3') or
      (Copy(s, len - 2, 5) = 'obj') or (Copy(s, len - 3, 5) = 'lmts') or
      (Copy(s, len - 2, 5) = 'smd') then
    begin
      GLFreeForm1.LoadFromStream(Selection, Archive.GetContent(Selection));
      GLCube1.Visible := False;
      GLFreeForm1.Visible := True;
      GLCamera1.Position.SetPoint(30, 40, 50);

      objSize := GLFreeForm1.BoundingSphereRadius;
      if objSize > 0 then
      begin
        if objSize < 1 then
        begin
          GLCamera1.SceneScale := 1 / objSize;
          objSize := 1;
        end
        else
          GLCamera1.SceneScale := 1;
        GLCamera1.AdjustDistanceToTarget(objSize * 0.12);
        GLCamera1.DepthOfView := 1.5 * GLCamera1.DistanceToTarget + 1 * objSize;
      end;

    end;
    if (Copy(s, len - 2, 5) = 'jpg') or (Copy(s, len - 2, 5) = 'dds')
    { or (Copy(s,len-2,5)='tga') } or (Copy(s, len - 2, 5) = 'png') then
    begin
      strm := Archive.GetContent(Selection);
      img := GLMaterialLibrary1.TextureByName('image')
        .Image as TGLCompositeImage;
      img.LoadFromStream(strm);

      GLCube1.Material.LibMaterialName := 'image';
      GLCube1.Visible := True;
      GLFreeForm1.Visible := False;
      GLCamera1.Position.SetPoint(3, 4, 5);
    end;
  end;
end;

procedure TForm1.ListViewDblClick(Sender: TObject);
var
  s: string;
  n: TTreeNode;
begin
  if not Assigned(ListView.Selected) then
    exit;
  if ListView.Selected.ImageIndex = 2 then
    exit;
  s := ListView.Selected.Caption;
  n := TreeView.Selected;
  TreeView.Selected := n[TreeIndexOf(s, n)];
end;

procedure TForm1.TreeViewChange(Sender: TObject; node: TTreeNode);
begin
  FileListRefresh;
end;

procedure TForm1.ListViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ListView.Enabled = False then
    exit;
  ListViewClick(Sender);
  if Key = VK_RETURN then
    ListViewDblClick(Sender);
  if Key = VK_DELETE then
    Deleteselectedfile1Click(Self);
end;

procedure TForm1.ListViewChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  ListViewClick(Sender);
end;

procedure TForm1.New1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    Archive.Clear;
    Archive.CreateArchive(SaveDialog1.FileName, True);
    Archive.LoadFromFile(SaveDialog1.FileName);
    TreeViewRefresh;
    ListView.Enabled := True;
  end;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
  OpenDialog1.DefaultExt := SaveDialog1.DefaultExt;
  OpenDialog1.Filter := SaveDialog1.Filter;
  OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
  if OpenDialog1.Execute then
  begin
    Archive.Clear;
    Archive.LoadFromFile(OpenDialog1.FileName);
    TreeViewRefresh;
    ListView.Enabled := True;
  end;
end;

procedure TForm1.Createfolder1Click(Sender: TObject);
var
  F: TMemoryStream;
begin
  if not Assigned(Archive) then
    exit;
  if FDialog.ShowModal = mrOk then
  begin
    F := TMemoryStream.Create;
    try
      Archive.AddFromStream('temp.tmp', CurPath + FDialog.Edit1.text + '/', F);
    finally
      F.Free;
    end;
    TreeViewRefresh;
  end;
end;

procedure TForm1.Addfiles1Click(Sender: TObject);
var
  i: integer;
begin
  if not Assigned(Archive) then
    exit;
  OpenDialog1.DefaultExt := '';
  OpenDialog1.Filter := 'All Files|*.*';
  OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect];
  if OpenDialog1.Execute then
  begin
    for i := 0 to OpenDialog1.Files.Count - 1 do
      if ExtractFileName(OpenDialog1.Files[i]) <> '' then
        Archive.AddFromFile(OpenDialog1.Files[i], CurPath);
    TreeViewRefresh;
  end;
end;

procedure TForm1.Deleteselectedfile1Click(Sender: TObject);
var
  i: integer;
  s: TStrings;
begin
  if ListView.SelCount = 0 then
    exit;
  s := TStringList.Create;
  for i := 0 to ListView.Items.Count - 1 do
    if ListView.Items[i].Selected then
      s.Add(CurPath + ListView.Items[i].Caption);
  for i := 0 to s.Count - 1 do
    Archive.RemoveContent(s[i]);

  s.Free;
  FileListRefresh;
  if ListView.Items.Count = 0 then
    TreeViewRefresh;
end;

procedure TForm1.Deleteselectedfolder1Click(Sender: TObject);
var
  i, l: integer;
  s: TStrings;
begin
  s := TStringList.Create;
  s.AddStrings(Archive.ContentList);
  l := Length(CurPath);
  for i := 0 to s.Count - 1 do
    if Copy(s[i], 1, l) = CurPath then
      Archive.RemoveContent(s[i]);
  s.Free;
  TreeViewRefresh;
end;

procedure TForm1.TreeViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ListView.Enabled = False then
    exit;
  if Key = VK_DELETE then
    Deleteselectedfolder1Click(Self);
end;

procedure TForm1.Extractselectedfiles1Click(Sender: TObject);
var
  i: integer;
begin
  if ListView.SelCount = 0 then
    exit;
  if FolderSel.ShowModal = mrOk then
  begin
    for i := 0 to ListView.Items.Count - 1 do
      if ListView.Items[i].Selected then
        Archive.Extract(CurPath + ListView.Items[i].Caption,
          FolderSel.ShellView.Path + '\'
          + ListView.Items[i].Caption);
  end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ArchiveManager.Free;
end;

procedure TForm1.None1Click(Sender: TObject);
begin
  vMenu.Checked := False;
  vMenu := (Sender As TMenuItem);
  case vMenu.Tag of
    0: Archive.CompressionLevel := clNone;
    1: Archive.CompressionLevel := clFastest;
    2: Archive.CompressionLevel := clDefault;
    3: Archive.CompressionLevel := clMax;
  end;
  vMenu.Checked := True;
end;

end.