log1stable
Junior Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Типа Code
var CurrentFile, CurrentDisc, Path: string;
Number, NumberDir, Discs, FirstTop, FirstLeft: Integer;
FindRec: TFindRec;
CreatedLabels: string;
type
TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);
#ifdef UNICODE
PAnsiChar=PChar;
#define A "W"
#else
#define A "A"
#endif
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 'GetDriveType{#A}@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;
procedure initializewizard;
begin
with WizardForm do
begin
NextButton.Top:=-500;
CancelButton.Top:=-500;
Bevel.Top:=-500;
BeveledLabel.Top:=-500;
OuterNotebook.Top:=-500;
end;
FirstTop:=10;
FirstLeft:=10;
GetDiscs;
end;
|
Всего записей: 146 | Зарегистр. 15-07-2011 | Отправлено: 18:43 11-12-2013 | Исправлено: log1stable, 18:45 11-12-2013 |
|
