El Sanchez
18-11-2012, 18:49
как системные иконки прикрутить? »
Johny777, держи. На основе твоего предыдущего кода.
[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program
;BitmapResource=Drive:img_small.bmp
[Code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
type
_ULARGE_INTEGER = record
LowPart: DWORD;
HighPart: DWORD;
end;
DriveInfo = record
DriveLetter: String;
DriveName: String;
DriveFileSystemName: String;
DriveSize: Extended;
DriveFreeSize: array [0..1] of Extended;
DriveType: String;
end;
const
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = $2;
DRIVE_FIXED = $3;
MAX_PATH = 260;
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function GetVolumeInformation(lpRootPathName, lpVolumeNameBuffer: String; nVolumeNameSize, lpVolumeSerialNumber: DWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: String; nFileSystemNameSize: DWORD): BOOL; external 'GetVolumeInformation{#A}@kernel32.dll stdcall';
function GetDriveType(lpRootPathName: String): UINT; external 'GetDriveType{#A}@kernel32.dll stdcall';
function GetDiskFreeSpaceEx(lpDirectoryName: String; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes: _ULARGE_INTEGER): BOOL; external 'GetDiskFreeSpaceEx{#A}@kernel32.dll stdcall';
function ExtractIcon(hInst: THandle; lpszExeFileName: String; nIconIndex: UINT): HICON; external 'ExtractIcon{#A}@shell32.dll stdcall';
function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of Char;
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], SizeOf(pszBuf));
except end;
end;
function Size64(QuadPart: _ULARGE_INTEGER): Extended;
begin
Result := $7FFFFFFF;
Result := ((QuadPart.HighPart + integer(QuadPart.LowPart < 0))*Result + QuadPart.HighPart + integer(QuadPart.LowPart < 0))*2 + QuadPart.LowPart;
end;
procedure GetDrivesInfo(var DriveArray: array of DriveInfo);
var
i, e: Integer;
UndefDriveLetter: String;
DriveType: UINT;
DrivePath: String;
VolumeName, FileSystemName: String;
ComponentLength, SerialNumber, FileSystemFlags: DWORD;
FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes: _ULARGE_INTEGER;
begin
for i := 67 to 90 do // Loop from C..Z to determine available drives
begin
UndefDriveLetter := Chr(i) + ':\';
DriveType := GetDriveType(UndefDriveLetter);
case DriveType of
DRIVE_REMOVABLE, DRIVE_FIXED: begin
VolumeName := StringOfChar(#32, MAX_PATH);
FileSystemName := StringOfChar(#32, MAX_PATH);
GetVolumeInformation(UndefDriveLetter, VolumeName, MAX_PATH, SerialNumber, ComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);
GetDiskFreeSpaceEx(UndefDriveLetter, FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes);
if Trim(VolumeName) = '' then VolumeName := 'Без имени';
SetArrayLength(DriveArray, GetArrayLength(DriveArray)+1);
e := GetArrayLength(DriveArray)-1;
DriveArray[e].DriveLetter := UndefDriveLetter;
DriveArray[e].DriveName := VolumeName;
DriveArray[e].DriveFileSystemName := FileSystemName;
DriveArray[e].DriveSize := Size64(TotalNumberOfBytes);
DriveArray[e].DriveFreeSize[0] := Size64(TotalNumberOfFreeBytes);
if DriveArray[e].DriveSize > 0 then DriveArray[e].DriveFreeSize[1] := DriveArray[e].DriveFreeSize[0]*100/DriveArray[e].DriveSize;
if DriveType = DRIVE_REMOVABLE then DriveArray[e].DriveType := 'Съёмный диск';
if DriveType = DRIVE_FIXED then if CompareText(UndefDriveLetter, ExpandConstant('{drive:{win}}\')) = 0 then DriveArray[e].DriveType := 'Локальный диск (сис.)' else DriveArray[e].DriveType := 'Локальный диск';
end;
DRIVE_NO_ROOT_DIR: Continue;
end;
end;
end;
procedure DriveListViewOnClick(Sender: TObject);
begin
if Assigned(TListView(Sender).Selected) then
WizardForm.DirEdit.Text := TListView(Sender).Selected.Caption + Copy(WizardForm.DirEdit.Text, 4, Length(WizardForm.DirEdit.Text));
end;
procedure DriveListViewColumnClick(Sender: TObject; Column: TListColumn);
begin
TListView(Sender).Tag := Column.Index;
with TListView(Sender) do
begin
if DesignInfo = 0 then DesignInfo := 1 else DesignInfo := -DesignInfo;
AlphaSort;
end;
end;
procedure DriveListViewOnCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
begin
with TListView(Sender) do
begin
if Tag = 0 then
Compare := DesignInfo*CompareText(Item1.Caption, Item2.Caption)
else
Compare := DesignInfo*CompareText(Item1.SubItems[Tag-1], Item2.SubItems[Tag-1]);
end;
end;
procedure InitializeWizard;
var
ReadyArray: array of DriveInfo;
DriveListView: TListView;
NewColumn: TListColumn;
ListItem: TListItem;
ImgList: TImageList;
i: Integer;
ico: TIcon;
begin
WizardForm.OuterNotebook.Hide;
WizardForm.Width := ScaleX(700);
WizardForm.Bevel.Hide;
WizardForm.DirEdit.Parent := WizardForm;
WizardForm.DirEdit.SetBounds(ScaleX(27), ScaleY(27), WizardForm.Width-ScaleX(71), ScaleY(21));
GetDrivesInfo(ReadyArray);
DriveListView := TListView.Create(nil);
with DriveListView do
begin
Parent := WizardForm;
ViewStyle := vsReport;
ReadOnly := True;
SetBounds(WizardForm.DirEdit.Left, WizardForm.DirEdit.Top + ScaleY(40), WizardForm.DirEdit.Width, ScaleY(200));
OnClick := @DriveListViewOnClick;
OnColumnClick := @DriveListViewColumnClick;
OnCompare := @DriveListViewOnCompare;
ImgList := TImageList.Create(DriveListView);
ico := TIcon.Create;
ico.Handle := ExtractIcon(HInstance, ExpandConstant('{sys}\shell32.dll'), 8);
ImgList.AddIcon(ico);
ico.Handle := ExtractIcon(HInstance, ExpandConstant('{sys}\shell32.dll'), 7);
ImgList.AddIcon(ico);
ico.Free;
SmallImages := ImgList;
NewColumn := Columns.Add;
NewColumn.Caption := 'Диск';
NewColumn.Width := ScaleX(65);
NewColumn := Columns.Add;
NewColumn.Caption := 'Имя';
NewColumn.Width := ScaleX(90);
NewColumn := Columns.Add;
NewColumn.Caption := 'Файловая система';
NewColumn.Width := ScaleX(105);
NewColumn := Columns.Add;
NewColumn.Caption := 'Ёмкость';
NewColumn.Width := ScaleX(65);
NewColumn := Columns.Add;
NewColumn.Caption := 'Свободно';
NewColumn.Width := ScaleX(90);
NewColumn := Columns.Add;
NewColumn.Caption := 'Тип';
NewColumn.Width := ScaleX(130);
for i := 0 to GetArrayLength(ReadyArray)-1 do
begin
ListItem := Items.Add;
with ListItem do
begin
Caption := ReadyArray[i].DriveLetter;
SubItems.Add(ReadyArray[i].DriveName);
SubItems.Add(ReadyArray[i].DriveFileSystemName);
SubItems.Add(BytesToSize(ReadyArray[i].DriveSize));
SubItems.Add(Format('%s (%d%%)', [BytesToSize(ReadyArray[i].DriveFreeSize[0]), Round(ReadyArray[i].DriveFreeSize[1])]));
SubItems.Add(ReadyArray[i].DriveType);
case ReadyArray[i].DriveType of
'Локальный диск', 'Локальный диск (сис.)': ImageIndex := 0;
'Съёмный диск': ImageIndex := 1;
else
ImageIndex := 1;
end;
end;
end;
end;
end;
Johny777, держи. На основе твоего предыдущего кода.
[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program
;BitmapResource=Drive:img_small.bmp
[Code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
type
_ULARGE_INTEGER = record
LowPart: DWORD;
HighPart: DWORD;
end;
DriveInfo = record
DriveLetter: String;
DriveName: String;
DriveFileSystemName: String;
DriveSize: Extended;
DriveFreeSize: array [0..1] of Extended;
DriveType: String;
end;
const
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = $2;
DRIVE_FIXED = $3;
MAX_PATH = 260;
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function GetVolumeInformation(lpRootPathName, lpVolumeNameBuffer: String; nVolumeNameSize, lpVolumeSerialNumber: DWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: String; nFileSystemNameSize: DWORD): BOOL; external 'GetVolumeInformation{#A}@kernel32.dll stdcall';
function GetDriveType(lpRootPathName: String): UINT; external 'GetDriveType{#A}@kernel32.dll stdcall';
function GetDiskFreeSpaceEx(lpDirectoryName: String; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes: _ULARGE_INTEGER): BOOL; external 'GetDiskFreeSpaceEx{#A}@kernel32.dll stdcall';
function ExtractIcon(hInst: THandle; lpszExeFileName: String; nIconIndex: UINT): HICON; external 'ExtractIcon{#A}@shell32.dll stdcall';
function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of Char;
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], SizeOf(pszBuf));
except end;
end;
function Size64(QuadPart: _ULARGE_INTEGER): Extended;
begin
Result := $7FFFFFFF;
Result := ((QuadPart.HighPart + integer(QuadPart.LowPart < 0))*Result + QuadPart.HighPart + integer(QuadPart.LowPart < 0))*2 + QuadPart.LowPart;
end;
procedure GetDrivesInfo(var DriveArray: array of DriveInfo);
var
i, e: Integer;
UndefDriveLetter: String;
DriveType: UINT;
DrivePath: String;
VolumeName, FileSystemName: String;
ComponentLength, SerialNumber, FileSystemFlags: DWORD;
FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes: _ULARGE_INTEGER;
begin
for i := 67 to 90 do // Loop from C..Z to determine available drives
begin
UndefDriveLetter := Chr(i) + ':\';
DriveType := GetDriveType(UndefDriveLetter);
case DriveType of
DRIVE_REMOVABLE, DRIVE_FIXED: begin
VolumeName := StringOfChar(#32, MAX_PATH);
FileSystemName := StringOfChar(#32, MAX_PATH);
GetVolumeInformation(UndefDriveLetter, VolumeName, MAX_PATH, SerialNumber, ComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);
GetDiskFreeSpaceEx(UndefDriveLetter, FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes);
if Trim(VolumeName) = '' then VolumeName := 'Без имени';
SetArrayLength(DriveArray, GetArrayLength(DriveArray)+1);
e := GetArrayLength(DriveArray)-1;
DriveArray[e].DriveLetter := UndefDriveLetter;
DriveArray[e].DriveName := VolumeName;
DriveArray[e].DriveFileSystemName := FileSystemName;
DriveArray[e].DriveSize := Size64(TotalNumberOfBytes);
DriveArray[e].DriveFreeSize[0] := Size64(TotalNumberOfFreeBytes);
if DriveArray[e].DriveSize > 0 then DriveArray[e].DriveFreeSize[1] := DriveArray[e].DriveFreeSize[0]*100/DriveArray[e].DriveSize;
if DriveType = DRIVE_REMOVABLE then DriveArray[e].DriveType := 'Съёмный диск';
if DriveType = DRIVE_FIXED then if CompareText(UndefDriveLetter, ExpandConstant('{drive:{win}}\')) = 0 then DriveArray[e].DriveType := 'Локальный диск (сис.)' else DriveArray[e].DriveType := 'Локальный диск';
end;
DRIVE_NO_ROOT_DIR: Continue;
end;
end;
end;
procedure DriveListViewOnClick(Sender: TObject);
begin
if Assigned(TListView(Sender).Selected) then
WizardForm.DirEdit.Text := TListView(Sender).Selected.Caption + Copy(WizardForm.DirEdit.Text, 4, Length(WizardForm.DirEdit.Text));
end;
procedure DriveListViewColumnClick(Sender: TObject; Column: TListColumn);
begin
TListView(Sender).Tag := Column.Index;
with TListView(Sender) do
begin
if DesignInfo = 0 then DesignInfo := 1 else DesignInfo := -DesignInfo;
AlphaSort;
end;
end;
procedure DriveListViewOnCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
begin
with TListView(Sender) do
begin
if Tag = 0 then
Compare := DesignInfo*CompareText(Item1.Caption, Item2.Caption)
else
Compare := DesignInfo*CompareText(Item1.SubItems[Tag-1], Item2.SubItems[Tag-1]);
end;
end;
procedure InitializeWizard;
var
ReadyArray: array of DriveInfo;
DriveListView: TListView;
NewColumn: TListColumn;
ListItem: TListItem;
ImgList: TImageList;
i: Integer;
ico: TIcon;
begin
WizardForm.OuterNotebook.Hide;
WizardForm.Width := ScaleX(700);
WizardForm.Bevel.Hide;
WizardForm.DirEdit.Parent := WizardForm;
WizardForm.DirEdit.SetBounds(ScaleX(27), ScaleY(27), WizardForm.Width-ScaleX(71), ScaleY(21));
GetDrivesInfo(ReadyArray);
DriveListView := TListView.Create(nil);
with DriveListView do
begin
Parent := WizardForm;
ViewStyle := vsReport;
ReadOnly := True;
SetBounds(WizardForm.DirEdit.Left, WizardForm.DirEdit.Top + ScaleY(40), WizardForm.DirEdit.Width, ScaleY(200));
OnClick := @DriveListViewOnClick;
OnColumnClick := @DriveListViewColumnClick;
OnCompare := @DriveListViewOnCompare;
ImgList := TImageList.Create(DriveListView);
ico := TIcon.Create;
ico.Handle := ExtractIcon(HInstance, ExpandConstant('{sys}\shell32.dll'), 8);
ImgList.AddIcon(ico);
ico.Handle := ExtractIcon(HInstance, ExpandConstant('{sys}\shell32.dll'), 7);
ImgList.AddIcon(ico);
ico.Free;
SmallImages := ImgList;
NewColumn := Columns.Add;
NewColumn.Caption := 'Диск';
NewColumn.Width := ScaleX(65);
NewColumn := Columns.Add;
NewColumn.Caption := 'Имя';
NewColumn.Width := ScaleX(90);
NewColumn := Columns.Add;
NewColumn.Caption := 'Файловая система';
NewColumn.Width := ScaleX(105);
NewColumn := Columns.Add;
NewColumn.Caption := 'Ёмкость';
NewColumn.Width := ScaleX(65);
NewColumn := Columns.Add;
NewColumn.Caption := 'Свободно';
NewColumn.Width := ScaleX(90);
NewColumn := Columns.Add;
NewColumn.Caption := 'Тип';
NewColumn.Width := ScaleX(130);
for i := 0 to GetArrayLength(ReadyArray)-1 do
begin
ListItem := Items.Add;
with ListItem do
begin
Caption := ReadyArray[i].DriveLetter;
SubItems.Add(ReadyArray[i].DriveName);
SubItems.Add(ReadyArray[i].DriveFileSystemName);
SubItems.Add(BytesToSize(ReadyArray[i].DriveSize));
SubItems.Add(Format('%s (%d%%)', [BytesToSize(ReadyArray[i].DriveFreeSize[0]), Round(ReadyArray[i].DriveFreeSize[1])]));
SubItems.Add(ReadyArray[i].DriveType);
case ReadyArray[i].DriveType of
'Локальный диск', 'Локальный диск (сис.)': ImageIndex := 0;
'Съёмный диск': ImageIndex := 1;
else
ImageIndex := 1;
end;
end;
end;
end;
end;