GLScene/Examples/Demos/utilities/ArchiveEdit/fMainD.pas

unit fMainD;

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,
  GLScene.VectorTypes,
  GLS.Scene,
  GLScene.VectorGeometry,
  GLS.SimpleNavigation,
  GLS.Material,
  GLS.VectorFileObjects,
  GLS.Objects,
  GLS.Coordinates,
  GLS.Graphics,
  GLS.State,
  GLS.CompositeImage,

  GLS.FileJPEG,
  GLS.PAKArchive,
  GLS.FileZLIB,

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

  GLScene.Utils;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    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;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLSprite1: TGLSprite;
    GLFreeForm1: TGLFreeForm;
    GLMaterialLibrary1: TGLMaterialLibrary;
    GLSimpleNavigation1: TGLSimpleNavigation;
    GLSArchiveManager1: TGLSArchiveManager;
    GLCube1: TGLCube;
    PanelTree: TPanel;
    TreeView: TTreeView;
    GLSceneViewer1: TGLSceneViewer;
    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: TGLLibArchive;
  vMenu: TMenuItem;

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

uses
  fFolderDlg, 
  FolderSelect;

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

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
  var Path: TFileName := GetCurrentAssetPath();
  SetCurrentDir(Path  + '\modelext');

  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];
  OpenDialog1.InitialDir := GetCurrentDir();
  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];
  OpenDialog1.InitialDir := GetCurrentDir();
  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.