Проблема Кастомный TFolderTreeView

zavul0n · 20 Окт 2016

Добрый день. Прошу помощи в отладке скрипта.

Суть: Кастомный TFolderTreeView созданный через TTreeView, который будет считывать диски/папки при запуске инсталлятора. При клике на диск - считывать следующий уровень папок и так далее.

Пока получилось добиться работы только на USB с ничтожно малым кол-вом папок. При попытке открыть список папок на жестком - инсталлятор тупо зависает.

Код:

; Скрипт создан через Мастер Inno Setup Script.
; ИСПОЛЬЗУЙТЕ ДОКУМЕНТАЦИЮ ДЛЯ ПОДРОБНОСТЕЙ ИСПОЛЬЗОВАНИЯ INNO SETUP!

#define MyAppName "My Program"
#define MyAppVersion "1.5"
#define MyAppPublisher "My Company, Inc."
#define MyAppURL "http://www.example.com/"
#define MyAppExeName "MyProg.exe"

[Setup]
; Примечание: Значение AppId идентифицирует это приложение.
; Не используйте одно и тоже значение в разных установках.
; (Для генерации значения GUID, нажмите Инструменты | Генерация GUID.)
AppName={#MyAppName}
AppVersion={#MyAppVersion}
;AppVerName={#MyAppName} {#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
DefaultDirName={pf}\{#MyAppName}
DefaultGroupName={#MyAppName}
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes

[Languages]
Name: "default"; MessagesFile: "compiler:Default.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: "C:\Program Files (x86)\Inno Setup 5\Examples\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion
; Примечание: Не используйте "Flags: ignoreversion" для системных файлов

[Icons]
Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"
Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon

[Run]
Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent

[_code]
#define A = (Defined UNICODE) ? "W" : "A"
const
  DRIVE_REMOVABLE = 2;
  DRIVE_FIXED = 3;
  DRIVE_REMOTE = 4;
  DRIVE_CDROM = 5;

var
  TreeView1: TTreeView;

function GetDriveType(nDrive: string): Longint; external 'GetDriveType{#A}@kernel32.dll stdcall';

procedure NextLevel(ParentNode: TTreeNode);
var
  sr, srChild: TFindRec;
  node: TTreeNode;
  path: string;
begin
   node := ParentNode;
   path := '';
   repeat
      path := node.Text + '\' + path;
      node := node.Parent;
   until node = nil;
   // Находим первую директорию
   if FindFirst( path + '*.*', sr ) then
   begin
      repeat
         if ( sr.Name <> '.' ) and ( sr.Name <> '..' ) then
            if ( sr.Attributes  and FILE_ATTRIBUTE_DIRECTORY  ) = FILE_ATTRIBUTE_DIRECTORY  then
            begin
               // Добавляем найденную папку в TreeView
               node := TreeView1.Items.AddChild( ParentNode, sr.Name );
               node.ImageIndex := 0;
               node.SelectedIndex := 1;
               // Утверждаем, что нет подкаталогов
               node.HasChildren := false;
               // Проверяем, так ли это
               if FindFirst( path + sr.Name + '\*.*', srChild ) then
               begin
                  repeat
                     if ( srChild.Name <> '.' ) and ( srChild.Name <> '..' ) then
                        if ( srChild.Attributes and FILE_ATTRIBUTE_DIRECTORY ) = FILE_ATTRIBUTE_DIRECTORY then
                           node.HasChildren := true;
                  until  FindNext(srChild) = False  or node.HasChildren;
               end;
               FindClose( srChild );
            end;
      until FindNext( sr ) = false;
   end
   else
      ParentNode.HasChildren := false;
   FindClose( sr );
end;

procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
begin
   TreeView1.Items.BeginUpdate;
   node.DeleteChildren;
   NextLevel( node );
   TreeView1.Items.EndUpdate;
end;

procedure InitializeWizard;
var
  node: TTreeNode;
  DriveType: integer;
  i: integer;
begin
  TreeView1 := TTreeView.Create(WizardForm);
  with TreeView1 do
  begin
    Parent := WizardForm.WelcomePage;
    Left := ScaleX(176);
    Top := ScaleY(168);
    Width := ScaleX(321);
    Height := ScaleY(146);
    Indent := 19;
   OnExpanding:=@TreeView1Expanding;
   end;
  TreeView1.Items.BeginUpdate;
  for i := 0 to 25 do
   begin
      DriveType := GetDriveType( PAnsiChar( Chr( i + 65 ) + ':\' ) );
      if DriveType = 1 then continue;
      node := TreeView1.Items.AddChild( nil, Chr( i+65 ) + ':' );
      node.SelectedIndex := node.ImageIndex;
      node.HasChildren := true;
   end;
   // Обновляем TreeView
   TreeView1.Items.EndUpdate;
end;

P.S. Познаний в Delphi - кот наплакал, но при компиляции в Delphi 6 - все работает исправно.
За основу брал вот это - http://decoding.dax.ru/practic/treeview/treeview.html

SBalykov · 21 Окт 2016

zavul0n написал(а):
Добрый день. Прошу помощи в отладке скрипта.

Суть: Кастомный TFolderTreeView созданный через TTreeView, который будет считывать диски/папки при запуске инсталлятора. При клике на диск - считывать следующий уровень папок и так далее.

Пока получилось добиться работы только на USB с ничтожно малым кол-вом папок. При попытке открыть список папок на жестком - инсталлятор тупо зависает.
P.S. Познаний в Delphi - кот наплакал, но при компиляции в Delphi 6 - все работает исправно.
За основу брал вот это - http://decoding.dax.ru/practic/treeview/treeview.html

Код:

; Скрипт создан через Мастер Inno Setup Script.
; ИСПОЛЬЗУЙТЕ ДОКУМЕНТАЦИЮ ДЛЯ ПОДРОБНОСТЕЙ ИСПОЛЬЗОВАНИЯ INNO SETUP!

#define MyAppName "My Program"
#define MyAppVersion "1.5"
#define MyAppPublisher "My Company, Inc."
#define MyAppURL "http://www.example.com/"
#define MyAppExeName "MyProg.exe"

[Setup]
; Примечание: Значение AppId идентифицирует это приложение.
; Не используйте одно и тоже значение в разных установках.
; (Для генерации значения GUID, нажмите Инструменты | Генерация GUID.)
AppName={#MyAppName}
AppVersion={#MyAppVersion}
;AppVerName={#MyAppName} {#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
;DisableDirPage=yes
;DisableProgramGroupPage=yes
DefaultDirName={pf}\{#MyAppName}
DefaultGroupName={#MyAppName}
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes

[Languages]
Name: "default"; MessagesFile: "compiler:Default.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: "C:\Program Files (x86)\Inno Setup 5\Examples\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion
; Примечание: Не используйте "Flags: ignoreversion" для системных файлов

[Icons]
Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"
Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon

[Run]
Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent

[code]
#define A = (Defined UNICODE) ? "W" : "A"
const
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;

type
#ifdef UNICODE
PChar = PAnsiChar;
#else
AnsiChar = Char;
#endif

var
TreeView1: TTreeView;
sr, srChild: TFindRec;
node: TTreeNode;
path: string;
DriveType: integer;
i: integer;

function GetDriveType(nDrive: string): Longint; external 'GetDriveType{#A}@kernel32.dll stdcall';

procedure NextLevel(ParentNode: TTreeNode);
begin
node := ParentNode;
path := '';
repeat
path := AddBackslash(node.Text) + path;
node := node.Parent;
until node = nil;
// Находим первую директорию
if FindFirst(path + '*.*', sr) then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
if (sr.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
begin
// Добавляем найденную папку в TreeView
node := TreeView1.Items.AddChild(ParentNode, sr.Name);
node.ImageIndex := 0;
node.SelectedIndex := 1;
// Утверждаем, что нет подкаталогов
node.HasChildren := True;
// Проверяем, так ли это
if FindFirst(path + sr.Name + '\*.*', srChild) then begin
repeat
if (srChild.Name <> '.') and (srChild.Name <> '..') then
if (srChild.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
node.HasChildren := False;
until
FindNext(srChild) = True or node.HasChildren;
end;
FindClose(srChild);
end;
until FindNext(sr) = false;
end else
ParentNode.HasChildren := false;
FindClose(sr);
end;

procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
begin
TreeView1.Items.BeginUpdate;
node.DeleteChildren;
NextLevel(node);
TreeView1.Items.EndUpdate;
end;

procedure InitializeWizard;
begin
TreeView1 := TTreeView.Create(WizardForm);
with TreeView1 do
begin
Parent := WizardForm.WelcomePage;
Left := ScaleX(176);
Top := ScaleY(180);
Width := ScaleX(311);
Height := ScaleY(126);
Indent := 19;
OnExpanding:=@TreeView1Expanding;
end;
TreeView1.Items.BeginUpdate;
for i := 0 to 25 do
begin
DriveType := GetDriveType(PAnsiChar(Chr(i + 65) + ':\'));
if DriveType = 1 then continue;
node := TreeView1.Items.AddChild(nil, Chr(i+65) + ':');
node.SelectedIndex := node.ImageIndex;
node.HasChildren := True;
end;
// Обновляем TreeView
TreeView1.Items.EndUpdate;
end;

zavul0n · 21 Окт 2016

SBalykov, благодарю. Все исправно работает.
Если в общих чертах - что было не правильно?

SBalykov · 21 Окт 2016

zavul0n написал(а):
SBalykov, благодарю. Все исправно работает.
Если в общих чертах - что было не правильно?

В процедуре проверки ...
было

Код:

// Утверждаем, что нет подкаталогов
node.HasChildren := False;

Должно быть

Код:

// Утверждаем, что подкаталоги существуют
node.HasChildren := True;

zavul0n · 22 Окт 2016

SBalykov, еще раз спасибо. Даже не обратил внимания на этот параметр почему-то.

Теперь очередная проблема. Нужно открыть определенную ветку в дереве каталогов. Как открыть системный диск - я догадался (хвала гуглу), а вот определить и открыть следующую ветку - пока не получилось.
Решил попробовать еще вот это: http://www.delphisources.ru/pages/faq/base/tv_get_node.html
Но что-то объединить с моим скриптом так и не получилось.

SBalykov · 23 Окт 2016

zavul0n,
а, собственно, для чего весь этот огород?
Если для отображения на странице выбора директории установки, то достаточно

Код:

#define MyAppName "My Program"
#define MyAppVersion "1.5"
#define MyAppPublisher "My Company, Inc."
#define MyAppURL "http://www.example.com/"
#define MyAppExeName "MyProg.exe"

[Setup]
AppName={#MyAppName}
AppVersion={#MyAppVersion}
//AppVerName={#MyAppName} {#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
//DisableDirPage=yes
//DisableProgramGroupPage=yes
DefaultDirName={pf}\{#MyAppName}
DefaultGroupName={#MyAppName}
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes

[Languages]
Name: "default"; MessagesFile: "compiler:Default.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: "C:\Program Files (x86)\Inno Setup 5\Examples\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion
//  Примечание: Не используйте "Flags: ignoreversion" для системных файлов

[Icons]
Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"
Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon

[Run]
Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent

[code]
#define A = (Defined UNICODE) ? "W" : "A"

const
DRIVE_REMOVABLE = 2; DRIVE_FIXED = 3; DRIVE_REMOTE = 4; DRIVE_CDROM = 5;

var
node: TTreeNode; path: string; sr, srChild: TFindRec; TreeView1: TTreeView; i, DriveType: integer;

function GetDriveType(nDrive: string): Longint; external 'GetDriveType{#A}@kernel32.dll stdcall';

procedure NextLevel(ParentNode: TTreeNode);
begin
  node := ParentNode;
  path := '';
  repeat
  path := AddBackslash(node.Text) + path;
  node := node.Parent;
  until node = nil;
//  Находим первую директорию
if FindFirst(path + '*.*', sr) then begin
  repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
if (sr.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then begin
//  Добавляем найденную папку в TreeView
  node := TreeView1.Items.AddChild(ParentNode, sr.Name);
  node.ImageIndex := 0;
  node.SelectedIndex := 1;
//  Утверждаем, что есть подкаталоги
  node.HasChildren := True;
//  Проверяем, так ли это
if FindFirst(path + sr.Name + '\*.*', srChild) then begin
  repeat
if (srChild.Name <> '.') and (srChild.Name <> '..') then
if (srChild.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
  node.HasChildren := False;
  until
  FindNext(srChild) = node.HasChildren;
  end;
  FindClose(srChild);
  end;
  until FindNext(sr) = false;
  end else
  ParentNode.HasChildren := false;
  FindClose(sr);
end;

procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
begin
  TreeView1.Items.BeginUpdate;
  node.DeleteChildren;
  NextLevel(node);
  TreeView1.Items.EndUpdate;
end;

procedure InitializeWizard;
begin
  TreeView1 := TTreeView.Create(WizardForm);
with TreeView1 do begin
  Parent := WizardForm.WelcomePage;
  Left := ScaleX(176);
  Top := ScaleY(185);
  Width := ScaleX(311);
  Height := ScaleY(120);
  Indent := 19;
  OnExpanding:=@TreeView1Expanding;
  end;
  for i := 0 to 25 do begin
  DriveType := GetDriveType(PAnsiChar(Chr(i + 65) + ':\'));
if DriveType = 1 then continue;
  node := TreeView1.Items.AddChild(nil, Chr(i+65) + ':');
  node.SelectedIndex := node.ImageIndex;
  node.HasChildren := True;
  end;
end;

procedure CurPageChanged(CurPageID: Integer);
begin
  case CurPageID of
  wpSelectDir : begin
//  Отключаем кнопку обзор и иже с ней
  WizardForm.DirEdit.Width := ScaleX(410);
  WizardForm.DirBrowseButton.Visible := False;
  WizardForm.SelectDirBrowseLabel.Caption := 'Нажмите Далее, чтобы продолжить или Назад, для выбора и изменения места установки ' + '{#MyAppName}'
//  Вывод строки места установки
  WizardForm.DirEdit.Text := MinimizePathName(ExpandConstant(path + '{#MyAppName}'), WizardForm.DirEdit.Font, WizardForm.DirEdit.Width);
  end;
  end;
end;

или

Код:

#define MyAppName "My Program"
#define MyAppVersion "1.5"
#define MyAppPublisher "My Company, Inc."
#define MyAppURL "http://www.example.com/"
#define MyAppExeName "MyProg.exe"

[Setup]
AppName={#MyAppName}
AppVersion={#MyAppVersion}
//AppVerName={#MyAppName} {#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
//DisableDirPage=yes
//DisableProgramGroupPage=yes
DefaultDirName={pf}\{#MyAppName}
DefaultGroupName={#MyAppName}
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes

[Languages]
Name: "default"; MessagesFile: "compiler:Default.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: "C:\Program Files (x86)\Inno Setup 5\Examples\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion
//  Примечание: Не используйте "Flags: ignoreversion" для системных файлов

[Icons]
Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"
Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon

[Run]
Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent

[Code]
var
  DirTreeView: TFolderTreeView;

procedure DirFolderChange(Sender: TObject);
Begin
  WizardForm.DirEdit.Text:=AddBackslash(DirTreeView.Directory) + '{#MyAppName}'
end;

Procedure InitializeWizard;
begin
  WizardForm.DirEdit.Width := ScaleX(417);
  WizardForm.DirBrowseButton.Visible := False;
  DirTreeView:= TFolderTreeView.Create(WizardForm)
  DirTreeView.SetBounds(0,110,417,100)
  DirTreeView.OnChange:= @DirFolderChange
  DirTreeView.Parent:= WizardForm.SelectDirPage
end;

А если для чего-то еще, то не понятно ...

zavul0n · 23 Окт 2016

SBalykov, позиционируется как полная замена штатного DirEdit и TFolderTreeView. Т.к. у последних нет многих функций.
Пока что выглядит примерно вот так:

zettend · 2 Дек 2016

А возможно это юзать с botva2?
Типа такого:

zavul0n · 2 Дек 2016

Incorrect, а почему нет? Конечно можно.
Я же использую.

zavul0n · 28 Дек 2016

Благодаря помощи демоняшки удалось придти к такому решению:

Код:

var dirs: tstringlist;
    found : boolean;
    i,j : integer;
    node, child : TTreeNode;
begin
  dirs := tstringlist.Create;
  dirs.Delimiter := '\';
  dirs.StrictDelimiter := True;
  dirs.DelimitedText := Edit1.Text;

  for I := 0 to TreeView1.Items.Count - 1 do
    begin
      TreeView1.Items[i].Collapse(true);
      if LowerCase(treeview1.items[i].Text) = LowerCase(dirs[0]) then node := TreeView1.Items[i];
    end;

  node.Expand(false);

  for j := 1 to dirs.Count - 1 do
    begin
      child := node.getFirstChild;

      found := false;
      while (not found) and (child <> node.GetLastChild) do
        begin
          Memo1.Lines.Add(child.Text+' '+node.GetLastChild.text);
          if LowerCase(child.Text) = LowerCase(dirs[j]) then
            begin
              child.Expand(false);
              node := child;
              found := true;
            end
          else
            child := node.GetNextChild(child);
        end;
      if not found then break;
    end;

   dirs.Free;
end;

Пока пущай тут полежит, его еще допилить по Inno нужно. Ну или если-кто подмогнет - буду безмерно рад.

Проблема Кастомный TFolderTreeView

zavul0n

Новичок

SBalykov

Старожил

zavul0n

Новичок

SBalykov

Старожил

zavul0n

Новичок

SBalykov

Старожил

zavul0n

Новичок

zettend

Старожил

zavul0n

Новичок

zavul0n

Новичок