Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (до версии 2009) - часть 6

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

log1stable



Junior Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
var CurrentFile, CurrentDisc, Path: string;  
    Number, NumberDir, Discs, FirstTop, FirstLeft: Integer;  
    FindRec: TFindRec;  
    CreatedLabels: string;  
     
type  
  TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);  
 
const  
  DRIVE_UNKNOWN = 0;  
  DRIVE_NO_ROOT_DIR = 1;  
  DRIVE_REMOVEABLE = 2;  
  DRIVE_FIXED = 3;  
  DRIVE_REMOTE = 4;  
  DRIVE_CDROM = 5;  
  DRIVE_RAMDISK = 6;  
 
Функция определения типа диска:
function GetDriveType(nDrive: string): Longint; external 'GetDriveTypeW@kernel32.dll stdcall';  
procedure TreeLabelEnter(Sender: TObject); forward;  
procedure TreeLabelLeave(Sender: TObject); forward;  
procedure TreeLabelClick(Sender: TObject); forward;  
 
procedure ShowMessage(Name: String);  
begin  
MsgBox(Name,MbInformation,MB_OK);  
end;  
 
function GetDiscs(): TStringList;  
var  
  i: integer;  
  buk: array[0..26] of char;  
begin  
for i:=1 to 26 do  
  begin  
    buk[i] := Chr(i+64)  
    if (GetDriveType(PChar(buk[i]+':\')) <> 1) and not (GetDriveType(PChar(buk[i]+':\')) = 5) then  
      begin  
        with TLabel.Create(WizardForm) do  
          begin  
            Parent:=WizardForm;  
            AutoSize:=True;  
            Top:=FirstTop+Number*Height+4;  
            Left:=FirstLeft;  
            Caption:=buk[i]+':\';  
            Cursor:=crHand;  
            Hint:=Caption; //Например "D:\"  
            OnMouseEnter:=@TreeLabelEnter;  
            OnMouseLeave:=@TreeLabelLeave;  
            OnClick:=@TreeLabelClick;  
            Discs:=Discs+1;  
          end;  
        Number:=Number+1;  
      end;  
  end;  
end;  
 
procedure TreeLabelEnter(Sender: TObject);  
begin  
if Sender is TLabel then  
  begin  
    TLabel(Sender).Font.Style:=[fsBold];  
  end;  
end;  
 
procedure TreeLabelLeave(Sender: TObject);  
begin  
if Sender is TLabel then  
  begin  
    TLabel(Sender).Font.Style:=[];  
  end;  
end;  
 
var MyTop: integer;  
 
procedure DeleteTreeLabels(Sender: TObject);  
var i: integer;  
begin  
 
end;  
 
procedure TreeLabelClick(Sender: TObject);  
var  
  i, j: integer;  
begin  
  for i:=1 to Length(TLabel(Sender).Hint) do  
    begin  
      if TLabel(Sender).Hint[i]='\' then j:=j+1;  
    end;  
WizardForm.Caption:=Путь установки: '+TLabel(Sender).Hint;  
WizardForm.DirEdit.Text:=TLabel(Sender).Hint;  
if FindFirst(TLabel(Sender).Hint+'\*', FindRec) then begin  
    try  
      repeat  
        if (FindRec.Attributes) and (FILE_ATTRIBUTE_DIRECTORY) <> 0 then  
          if (FindRec.Name<>'.') and (FindRec.Name<>'..') and (FindRec.Name<>'$Recycle.Bin')  
             and (FindRec.Name<>'Boot') and (FindRec.Name<>'Recovery') and (FindRec.Name<>'ProgramData')  
             and (FindRec.Name<>'System Volume Information') and (FindRec.Name<>'$RECYCLE.BIN')  
             and (FindRec.Name<>'msdownld.tmp') then  
            begin  
              Number:=Number+1;  
              with TLabel.Create(WizardForm) do  
                begin  
                  AutoSize:=True;  
                  Parent:=WizardForm;  
                  Left:=j*10;  
                  Top:=Number*Height+4;  
                  Caption:=FindRec.Name;  
                  Cursor:=crHand;  
                  Name:='Label_'+IntToStr(Number);  
                  CreatedLabels:=CreatedLabels+','+Name;  
                  Tag:=Number;  
                  Hint:=TLabel(Sender).Hint+Caption+'\'; Например "Диск\Родительска папка\Эта подпапка" "(D:\1\2)"  
                  OnMouseEnter:=@TreeLabelEnter;  
                  OnMouseLeave:=@TreeLabelLeave;  
                  OnClick:=@TreeLabelClick;  
                end;  
            end;  
    until not FindNext(FindRec);  
    finally  
      FindClose(FindRec);  
    end;  
  end;  
end;  
 
На создании формы:  
begin  
FirstTop:=10;  
FirstLeft:=10;  
GetDiscs;  
end;

Всего записей: 146 | Зарегистр. 15-07-2011 | Отправлено: 04:59 12-12-2013
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (до версии 2009) - часть 6


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru