Victor_Dobrov, всё понял. Большое спасибо!
» Inno Setup (создание инсталяционных пакетов)
Victor_Dobrov
а мне ответить?
а мне ответить?
Victor_Dobrov Можете помочь доработать данный скрипт выбора дисков. В нём в принципе всё нормально, но я не знаю, как убрать, чтобы он не отображал диски, на которые невозможно выполнить установку (например, CD ROM) и сделать как у вас в корона скин здесь только GB и MB, а у вас ТБ, ГБ, Мб, Кб, Бт. Буду очень Вам признателен!!!
[more=Подробнее..][Setup]
AppName=Drive Checked
AppVerName=Drive Checked
DefaultDirName={pf}\Drive Checked
[Languages]
Name: "ru"; MessagesFile: "compiler:Languages\Russian.isl"
[Messages]
ru.SelectDirBrowseLabel=Нажмите "Далее", чтобы продолжить. Для установки на другой диск, выберите из списка.
[Code]
var
cbDrive: TComboBox;
DrvLetters: array of string;
FreeSpaceLabel: TLabel;
function GetDriveType(lpDisk: string): integer;
external 'GetDriveTypeA@kernel32.dll stdcall';
function GetLogicalDriveStrings(nLenDrives: LongInt; lpDrives: string): integer;
external 'GetLogicalDriveStringsA@kernel32.dll stdcall';
const
DRIVE_UNKNOWN=0;
DRIVE_NO_ROOT_DIR=1;
DRIVE_REMOVABLE=2;
DRIVE_FIXED=3;
DRIVE_REMOTE=4;
DRIVE_CDROM=5;
DRIVE_RAMDISK=6;
function DriveTypeString(dtype: integer): string;
begin
case dtype of
DRIVE_NO_ROOT_DIR: Result:='Неверный путь';
DRIVE_REMOVABLE: Result:='Съемный';
DRIVE_FIXED: Result:='';
DRIVE_REMOTE: Result:='Сетевой';
DRIVE_CDROM: Result:='CD-ROM';
DRIVE_RAMDISK: Result:='Ram диск';
else
Result:='Неизвестный';
end;
end;
procedure cbDriveOnClick(Sender: TObject);
begin
WizardForm.DirEdit.Text:=DrvLetters[cbDrive.ItemIndex]+'Program Files\Disk Checked';
end;
procedure FillCombo();
var
n: integer;
drivesletters: string; lenletters: integer;
drive: string;
disktype, posnull: integer;
sd: string;
begin
sd:=UpperCase(ExpandConstant('{sd}'));
drivesletters:=StringOfChar(' ', 64);
lenletters:=GetLogicalDriveStrings(63, drivesletters);
SetLength(drivesletters, lenletters);
drive:='';
n:=0;
while ((Length(drivesletters) > 0)) do
begin
posnull:=Pos(#0, drivesletters);
if posnull > 0 then
begin
drive:=UpperCase(Copy(drivesletters, 1, posnull-1));
disktype:=GetDriveType(drive);
if (not(disktype=DRIVE_REMOVABLE)) then
begin
cbDrive.Items.Add(drive+DriveTypeString(disktype))
SetArrayLength(DrvLetters, N+1);
DrvLetters[n]:=drive;
if (Copy(drive, 1, 2)=sd) then cbDrive.ItemIndex:=n;
n:=n+1;
end
drivesletters:=Copy(drivesletters, posnull+1, Length(drivesletters));
end
end;
cbDriveOnClick(cbDrive);
end;
procedure GetFreeSpaceCaption(Sender: TObject);
var
Path: string;
FreeMB, TotalMB: cardinal;
begin
Path:=ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB > 1024 then
FreeSpaceLabel.Caption:='Свободно на диске: ' + FloatToStr(round(FreeMB/1024*100)/100) + ' GB'
else
FreeSpaceLabel.Caption:='Свободно на диске: ' + IntToStr(FreeMB) + ' MB'
end;
procedure InitializeWizard();
begin
cbDrive:=TComboBox.Create(WizardForm.SelectDirPage);
FreeSpaceLabel:=TLabel.Create(WizardForm);
with cbDrive do
begin
Parent:=WizardForm.DirEdit.Parent;
Left:=WizardForm.DirEdit.Left;
Top:=WizardForm.DirEdit.Top+WizardForm.DirEdit.Height*2-15;
Width:=WizardForm.DirEdit.Width+83;
Style:=csDropDownList;
end
with FreeSpaceLabel do
begin
Parent:=WizardForm.SelectDirPage;
Left:=ScaleX(0);
Top:=Scaley(195);
Width:=ScaleX(209);
Height:=ScaleY(13);
end;
WizardForm.DirBrowseButton.Visible:=true;
WizardForm.DirEdit.Enabled:=true;
WizardForm.DirEdit.OnChange:=@GetFreeSpaceCaption;
WizardForm.DirEdit.Text:=WizardForm.DirEdit.Text+#0;
FillCombo;
cbDrive.OnClick:=@cbDriveOnClick;
end;[/more]
[more=Подробнее..][Setup]
AppName=Drive Checked
AppVerName=Drive Checked
DefaultDirName={pf}\Drive Checked
[Languages]
Name: "ru"; MessagesFile: "compiler:Languages\Russian.isl"
[Messages]
ru.SelectDirBrowseLabel=Нажмите "Далее", чтобы продолжить. Для установки на другой диск, выберите из списка.
[Code]
var
cbDrive: TComboBox;
DrvLetters: array of string;
FreeSpaceLabel: TLabel;
function GetDriveType(lpDisk: string): integer;
external 'GetDriveTypeA@kernel32.dll stdcall';
function GetLogicalDriveStrings(nLenDrives: LongInt; lpDrives: string): integer;
external 'GetLogicalDriveStringsA@kernel32.dll stdcall';
const
DRIVE_UNKNOWN=0;
DRIVE_NO_ROOT_DIR=1;
DRIVE_REMOVABLE=2;
DRIVE_FIXED=3;
DRIVE_REMOTE=4;
DRIVE_CDROM=5;
DRIVE_RAMDISK=6;
function DriveTypeString(dtype: integer): string;
begin
case dtype of
DRIVE_NO_ROOT_DIR: Result:='Неверный путь';
DRIVE_REMOVABLE: Result:='Съемный';
DRIVE_FIXED: Result:='';
DRIVE_REMOTE: Result:='Сетевой';
DRIVE_CDROM: Result:='CD-ROM';
DRIVE_RAMDISK: Result:='Ram диск';
else
Result:='Неизвестный';
end;
end;
procedure cbDriveOnClick(Sender: TObject);
begin
WizardForm.DirEdit.Text:=DrvLetters[cbDrive.ItemIndex]+'Program Files\Disk Checked';
end;
procedure FillCombo();
var
n: integer;
drivesletters: string; lenletters: integer;
drive: string;
disktype, posnull: integer;
sd: string;
begin
sd:=UpperCase(ExpandConstant('{sd}'));
drivesletters:=StringOfChar(' ', 64);
lenletters:=GetLogicalDriveStrings(63, drivesletters);
SetLength(drivesletters, lenletters);
drive:='';
n:=0;
while ((Length(drivesletters) > 0)) do
begin
posnull:=Pos(#0, drivesletters);
if posnull > 0 then
begin
drive:=UpperCase(Copy(drivesletters, 1, posnull-1));
disktype:=GetDriveType(drive);
if (not(disktype=DRIVE_REMOVABLE)) then
begin
cbDrive.Items.Add(drive+DriveTypeString(disktype))
SetArrayLength(DrvLetters, N+1);
DrvLetters[n]:=drive;
if (Copy(drive, 1, 2)=sd) then cbDrive.ItemIndex:=n;
n:=n+1;
end
drivesletters:=Copy(drivesletters, posnull+1, Length(drivesletters));
end
end;
cbDriveOnClick(cbDrive);
end;
procedure GetFreeSpaceCaption(Sender: TObject);
var
Path: string;
FreeMB, TotalMB: cardinal;
begin
Path:=ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB > 1024 then
FreeSpaceLabel.Caption:='Свободно на диске: ' + FloatToStr(round(FreeMB/1024*100)/100) + ' GB'
else
FreeSpaceLabel.Caption:='Свободно на диске: ' + IntToStr(FreeMB) + ' MB'
end;
procedure InitializeWizard();
begin
cbDrive:=TComboBox.Create(WizardForm.SelectDirPage);
FreeSpaceLabel:=TLabel.Create(WizardForm);
with cbDrive do
begin
Parent:=WizardForm.DirEdit.Parent;
Left:=WizardForm.DirEdit.Left;
Top:=WizardForm.DirEdit.Top+WizardForm.DirEdit.Height*2-15;
Width:=WizardForm.DirEdit.Width+83;
Style:=csDropDownList;
end
with FreeSpaceLabel do
begin
Parent:=WizardForm.SelectDirPage;
Left:=ScaleX(0);
Top:=Scaley(195);
Width:=ScaleX(209);
Height:=ScaleY(13);
end;
WizardForm.DirBrowseButton.Visible:=true;
WizardForm.DirEdit.Enabled:=true;
WizardForm.DirEdit.OnChange:=@GetFreeSpaceCaption;
WizardForm.DirEdit.Text:=WizardForm.DirEdit.Text+#0;
FillCombo;
cbDrive.OnClick:=@cbDriveOnClick;
end;[/more]
Victor_Dobrov, вопрос по поводу проверки минимальных системных требований в InnoSetupUpgrade.
1. При NeedSys:= 5.1; NeedSp:= 2; на Vista 6.0.6001 Service Pack 1 пишет "Требуется сборка 5,1, пакет обновления 2" - лиловый цвет, хотя версия сборки выше.
2. Минимальные требования cpu=3,0 ггц (пентиум 4), для Core 2 Duo и Core 2 Quad значения не указаны. И при NeedMHZ:= 3000; на Core 2 Duo T8300(2,4 ггц) и на Core 2 Quad Q6600(2,4 ггц) пишет "Требуемая частота процессора 3000 Мгц." - красный цвет, хотя эти процессоры по умолчанию мощнее. То есть для себя я мог бы установить NeedMHZ:= 2200;, а как быть со старыми процессорами?
1. При NeedSys:= 5.1; NeedSp:= 2; на Vista 6.0.6001 Service Pack 1 пишет "Требуется сборка 5,1, пакет обновления 2" - лиловый цвет, хотя версия сборки выше.
2. Минимальные требования cpu=3,0 ггц (пентиум 4), для Core 2 Duo и Core 2 Quad значения не указаны. И при NeedMHZ:= 3000; на Core 2 Duo T8300(2,4 ггц) и на Core 2 Quad Q6600(2,4 ггц) пишет "Требуемая частота процессора 3000 Мгц." - красный цвет, хотя эти процессоры по умолчанию мощнее. То есть для себя я мог бы установить NeedMHZ:= 2200;, а как быть со старыми процессорами?
EagleSH
Цитата:
Цитата:
Я в этом не спец, как вариант, пропиши каждой кнопке BringToFront. Или попробуй использовать ISSkin.dll, возможно, кнопки мигать перестанут.
Don_Juan
Поменяй условие if (not(disktype=DRIVE_REMOVABLE)) на if disktype = DRIVE_FIXED
nik1967
InnoSetupUpgrade - это пройденный этап. В Corona Skin проверка требований работает лучше и дорабатывать старый скрипт (который я забросил) для меня напрасная трата времени.
Цитата:
есть движущийся фон в окне inno, но кнопки, выбор пути промигивают. как заставить их жёстко стоять и не мигать? и как сверху наложить транспорент?
Цитата:
а мне ответить?
Я в этом не спец, как вариант, пропиши каждой кнопке BringToFront. Или попробуй использовать ISSkin.dll, возможно, кнопки мигать перестанут.
Don_Juan
Поменяй условие if (not(disktype=DRIVE_REMOVABLE)) на if disktype = DRIVE_FIXED
nik1967
InnoSetupUpgrade - это пройденный этап. В Corona Skin проверка требований работает лучше и дорабатывать старый скрипт (который я забросил) для меня напрасная трата времени.
Victor_Dobrov
Спасибо. А еще такой вопрос: Как сделать, чтобы менялась только буква диска при смене, а не под папка вместе с ней.
Спасибо. А еще такой вопрос: Как сделать, чтобы менялась только буква диска при смене, а не под папка вместе с ней.
Victor_Dobrov
Спасибо за оперативный ответ! И всё-таки по поводу проверки минимальных системных требований теперь уже Corona Skin:
1. При NeedSys:= 5.1; NeedSp:= 2; на Vista 6.0.6001 Service Pack 1 пишет "Требуется версия 5,1 или выше, пакет обновления 2" - лиловый цвет, хотя версия сборки выше. Увы, это осталось.
2. По проверкам цпу всё отлично,сенкс.
3. И ещё одно: после нажатии на надпись "Объём папок"(всплывающая надпись "подсчёт размера папок займёт некоторое время") выводится сообщение "Подождите пожалуйста.Идёт подсчёт размера папок". Через пару секунд выводится сообщение "Runtime Error" "Math error". Процесс зависает. Выход только через диспетчер задач Windows.
Спасибо за оперативный ответ! И всё-таки по поводу проверки минимальных системных требований теперь уже Corona Skin:
1. При NeedSys:= 5.1; NeedSp:= 2; на Vista 6.0.6001 Service Pack 1 пишет "Требуется версия 5,1 или выше, пакет обновления 2" - лиловый цвет, хотя версия сборки выше. Увы, это осталось.
2. По проверкам цпу всё отлично,сенкс.
3. И ещё одно: после нажатии на надпись "Объём папок"(всплывающая надпись "подсчёт размера папок займёт некоторое время") выводится сообщение "Подождите пожалуйста.Идёт подсчёт размера папок". Через пару секунд выводится сообщение "Runtime Error" "Math error". Процесс зависает. Выход только через диспетчер задач Windows.
nik1967
По номеру сборки и сервиспака ошибку исправлю в следующей версии.
Цитата:
Такой ошибки при подсчёте папок никогда не получал.
Если не трудно, проверь вот этот скрипт: [more=DirSizeCalc]
[Setup]
AppName=Calc DirSize
AppVerName=Calc DirSize
CreateAppDir=false
[Code]
/////////// NEW ///////////////////////
type
TMsg = record
hwnd: HWnd;
msg: Word;
wParam: Word;
lParam: Word;
time: Longint;
pt: TPoint;
end;
var
Browse, SizeButton: TButton; LSize: TLabel; Folder: String; Work: Boolean;
Msg: TMsg;
function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax, wRemoveMsg: LongInt): LongInt; external 'PeekMessageW@user32.dll stdcall';
procedure ProcessMessage();
begin
Work:= False;
end;
/////////// NEW ///////////////////////
const
oneMB= 1024*1024; VK_SHIFT = $10;
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
Function ByteOrGB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= FloatToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Mb' else
Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb'
StringChange(Result, ',', '.')
End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo; if Lo< 0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2; for Hi:= Hi-1 Downto 0 do Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;
function CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Extended;
var
FSR, DSR: TFindRec; FindResult: Boolean; APath: string;
res: longint;
Begin
APath:= AddBackslash(fromDir);
FindResult:= FindFirst(APath + fileMask, FSR);
Try
while FindResult do
begin
/////////// NEW ///////////////////////
res:= PeekMessage(Msg, SizeButton.Handle, $0201, $0203, 1);
if res <> 0 then
begin
ProcessMessage();
Exit;
end;
/////////// NEW ///////////////////////
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result:= Result + Size64(FSR.SizeHigh, FSR.SizeLow)
//if GetKeyState(VK_SHIFT) < 0 then Work:= false; // флаг сброшен, это значит, что клавиша прерывания работы нажималась
if not Work then Exit; // прерывание подсчёта, если нажата клавиша
FindResult:= FindNext(FSR);
end;
FindResult := FindFirst(APath + '*.*', DSR);
while FindResult and SubDirsAllow do
begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
// если есть хоть одна рекурсия, то подсчёт почему-то не прерывается
FindResult:= FindNext(DSR);
end;
Finally
FindClose(FSR); FindClose(DSR);
end;
End;
Procedure SizeButtonOnClick(Sender: TObject); var res: Extended;
Begin
LSize.Caption:= 'Please wait...' #13#10 'Calculating folders'; WizardForm.Repaint
Work:= true; // флаг нажатия клавиши прерывания работы функции CalcDirSize.
SizeButton.Caption:= 'Stop'; // NEW
res:= CalcDirSize(Folder, '*', True); // если подсчёт (или копирование в SHFileOperation) идёт долго, то должна быть возможность его прервать
LSize.Caption:= 'DirSize = ' + ByteOrGB(res, true) + #13#10 + Folder
SizeButton.Caption := 'Calc';
End;
Procedure BrowseOnClick(Sender: TObject);
Begin
if BrowseForFolder('Calc Folder', Folder, false) then SizeButtonOnClick(SizeButton);
End;
Procedure InitializeWizard;
begin
Browse:= TButton.Create(WizardForm);
Browse.SetBounds(WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width, WizardForm.CancelButton.Top, 48, WizardForm.CancelButton.Height)
Browse.Caption := 'Change';
Browse.OnClick := @BrowseOnClick;
Browse.Parent := WizardForm;
SizeButton:= TButton.Create(WizardForm);
SizeButton.SetBounds(Browse.Left + Browse.Width, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width/2, WizardForm.CancelButton.Height)
SizeButton.Caption := 'Calc';
SizeButton.OnClick := @SizeButtonOnClick;
SizeButton.Parent := WizardForm;
Folder:= ExpandConstant('{win}') // для начала берём эту папку
LSize:= TLabel.Create(WizardForm);
LSize.SetBounds(SizeButton.Left + SizeButton.Width + 8, SizeButton.Top, 12, 12)
LSize.Caption:= 'Click Calc button' #13#10 'Current dir: ' + Folder;
LSize.Parent:= WizardForm;
end;
[/more] нормально работает?.
По номеру сборки и сервиспака ошибку исправлю в следующей версии.
Цитата:
"Runtime Error" "Math error".
Такой ошибки при подсчёте папок никогда не получал.
Если не трудно, проверь вот этот скрипт: [more=DirSizeCalc]
[Setup]
AppName=Calc DirSize
AppVerName=Calc DirSize
CreateAppDir=false
[Code]
/////////// NEW ///////////////////////
type
TMsg = record
hwnd: HWnd;
msg: Word;
wParam: Word;
lParam: Word;
time: Longint;
pt: TPoint;
end;
var
Browse, SizeButton: TButton; LSize: TLabel; Folder: String; Work: Boolean;
Msg: TMsg;
function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax, wRemoveMsg: LongInt): LongInt; external 'PeekMessageW@user32.dll stdcall';
procedure ProcessMessage();
begin
Work:= False;
end;
/////////// NEW ///////////////////////
const
oneMB= 1024*1024; VK_SHIFT = $10;
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
Function ByteOrGB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= FloatToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Mb' else
Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb'
StringChange(Result, ',', '.')
End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo; if Lo< 0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2; for Hi:= Hi-1 Downto 0 do Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;
function CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Extended;
var
FSR, DSR: TFindRec; FindResult: Boolean; APath: string;
res: longint;
Begin
APath:= AddBackslash(fromDir);
FindResult:= FindFirst(APath + fileMask, FSR);
Try
while FindResult do
begin
/////////// NEW ///////////////////////
res:= PeekMessage(Msg, SizeButton.Handle, $0201, $0203, 1);
if res <> 0 then
begin
ProcessMessage();
Exit;
end;
/////////// NEW ///////////////////////
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result:= Result + Size64(FSR.SizeHigh, FSR.SizeLow)
//if GetKeyState(VK_SHIFT) < 0 then Work:= false; // флаг сброшен, это значит, что клавиша прерывания работы нажималась
if not Work then Exit; // прерывание подсчёта, если нажата клавиша
FindResult:= FindNext(FSR);
end;
FindResult := FindFirst(APath + '*.*', DSR);
while FindResult and SubDirsAllow do
begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
// если есть хоть одна рекурсия, то подсчёт почему-то не прерывается
FindResult:= FindNext(DSR);
end;
Finally
FindClose(FSR); FindClose(DSR);
end;
End;
Procedure SizeButtonOnClick(Sender: TObject); var res: Extended;
Begin
LSize.Caption:= 'Please wait...' #13#10 'Calculating folders'; WizardForm.Repaint
Work:= true; // флаг нажатия клавиши прерывания работы функции CalcDirSize.
SizeButton.Caption:= 'Stop'; // NEW
res:= CalcDirSize(Folder, '*', True); // если подсчёт (или копирование в SHFileOperation) идёт долго, то должна быть возможность его прервать
LSize.Caption:= 'DirSize = ' + ByteOrGB(res, true) + #13#10 + Folder
SizeButton.Caption := 'Calc';
End;
Procedure BrowseOnClick(Sender: TObject);
Begin
if BrowseForFolder('Calc Folder', Folder, false) then SizeButtonOnClick(SizeButton);
End;
Procedure InitializeWizard;
begin
Browse:= TButton.Create(WizardForm);
Browse.SetBounds(WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width, WizardForm.CancelButton.Top, 48, WizardForm.CancelButton.Height)
Browse.Caption := 'Change';
Browse.OnClick := @BrowseOnClick;
Browse.Parent := WizardForm;
SizeButton:= TButton.Create(WizardForm);
SizeButton.SetBounds(Browse.Left + Browse.Width, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width/2, WizardForm.CancelButton.Height)
SizeButton.Caption := 'Calc';
SizeButton.OnClick := @SizeButtonOnClick;
SizeButton.Parent := WizardForm;
Folder:= ExpandConstant('{win}') // для начала берём эту папку
LSize:= TLabel.Create(WizardForm);
LSize.SetBounds(SizeButton.Left + SizeButton.Width + 8, SizeButton.Top, 12, 12)
LSize.Caption:= 'Click Calc button' #13#10 'Current dir: ' + Folder;
LSize.Parent:= WizardForm;
end;
[/more] нормально работает?.
Victor_Dobrov, скрипт: DirSizeCalc работает хорошо. В Corona Skin обзор папок и подсчёт размера работает тоже хорошо. Надпись "Объём папок" слева (рядом с чекбоксом), справа данные.
Victor_Dobrov и господа, кто компетентен:
как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.
как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.
Ну ктонить поможет.
Dermuin
На предыдущей странице не совсем понятен твой вопрос. Запустить программу можно после установки. В примерах можно найти это. На последней странице можно добавить галочку, и если она checked, то после нажатия кнопки Закрыть происходит запуск приложения.
На предыдущей странице не совсем понятен твой вопрос. Запустить программу можно после установки. В примерах можно найти это. На последней странице можно добавить галочку, и если она checked, то после нажатия кнопки Закрыть происходит запуск приложения.
sanmon, ну уж не знаю - чё там непонятного, я в 3 секунды разобрался:
Прекомпрессия: precomp -slow image.img
На выходе имеем файл image.pcf - это и есть файл с разжатыми zLib-потоками, который, в отличие от оригинала image.img, жмётся тем же севензипом на ура.
Обратная рекомпрессия: precomp -r image.pcf
На выходе имеем файл image.img, т.е. исходный оригинал.
Что ещё непонятно - говори, подскажу.
Прекомпрессия: precomp -slow image.img
На выходе имеем файл image.pcf - это и есть файл с разжатыми zLib-потоками, который, в отличие от оригинала image.img, жмётся тем же севензипом на ура.
Обратная рекомпрессия: precomp -r image.pcf
На выходе имеем файл image.img, т.е. исходный оригинал.
Что ещё непонятно - говори, подскажу.
Victor_Dobrov и господа, кто компетентен:
как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.
вопрос в силе.
ещё интересует момент, нужно при старте инстала прописать переменную числовую, к примеру number=1
как в секции [code] организовать свою тему, которая бы добавляла к текстовой переменной, к примеру number$=demo числовую number, на выходе имеем demo1
делаем чё там нада с этой demo1, увеличиваем number, тоесть получается number=number+1
в следущий такт получается demo2, потом demo3 и тд. делаем проверку на 50 к примеру, если number=50 делаем его снова 1 и так по кругу.
короче тема такая, чтоб пока работает инсталлер, постоянно выполняется моя процедурка
надеюсь понятно объяснил. такое возможно ваще?
как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.
вопрос в силе.
ещё интересует момент, нужно при старте инстала прописать переменную числовую, к примеру number=1
как в секции [code] организовать свою тему, которая бы добавляла к текстовой переменной, к примеру number$=demo числовую number, на выходе имеем demo1
делаем чё там нада с этой demo1, увеличиваем number, тоесть получается number=number+1
в следущий такт получается demo2, потом demo3 и тд. делаем проверку на 50 к примеру, если number=50 делаем его снова 1 и так по кругу.
короче тема такая, чтоб пока работает инсталлер, постоянно выполняется моя процедурка
надеюсь понятно объяснил. такое возможно ваще?
EagleSH
Не поощряю использование матерных слов в качестве переменных. Советую удалить их из поста.
Не поощряю использование матерных слов в качестве переменных. Советую удалить их из поста.
EagleSH
Цитата:
Попробуй так: [more]
[Setup]
AppName=Timer
AppVerName=InnoCallback Timer
CreateAppDir=false
[Files]
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
[Code]
var Sec: Integer;
type
TTimerProc=procedure(h:longword; msg:longword; idevent:longword; dwTime:longword);
function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): Longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd: longword; nIDEvent, uElapse: Longword; lpTimerFunc: Longword): Longword; external 'SetTimer@user32.dll stdcall';
//Note, we musn't declare our routine as Stdcall
procedure MyTimerProc(h: Longword; msg: Longword; idevent: Longword; dwTime: Longword);
begin
if sec > 49 then sec:= 0; sec:= sec + 1;
WizardForm.Caption:= 'Timer: ' + IntToStr(sec)
end;
function InitializeSetup: Boolean;
var timercallback, callback: Longword;
begin
timercallback:= WrapTimerProc(@MyTimerProc, 4); //Our proc has 4 arguments
settimer(0,0,1000,timercallback); //Create a timer and give it our callback as an argument
result:=true; //keep loading setup..
end;
[/more]
Цитата:
Смотри как пример Vista Lite Skin (или Inno Setup Scripting), там один фон на каждой странице.
Цитата:
чтобы, пока работает инсталлер, постоянно выполняется моя процедурка
Попробуй так: [more]
[Setup]
AppName=Timer
AppVerName=InnoCallback Timer
CreateAppDir=false
[Files]
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
[Code]
var Sec: Integer;
type
TTimerProc=procedure(h:longword; msg:longword; idevent:longword; dwTime:longword);
function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): Longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd: longword; nIDEvent, uElapse: Longword; lpTimerFunc: Longword): Longword; external 'SetTimer@user32.dll stdcall';
//Note, we musn't declare our routine as Stdcall
procedure MyTimerProc(h: Longword; msg: Longword; idevent: Longword; dwTime: Longword);
begin
if sec > 49 then sec:= 0; sec:= sec + 1;
WizardForm.Caption:= 'Timer: ' + IntToStr(sec)
end;
function InitializeSetup: Boolean;
var timercallback, callback: Longword;
begin
timercallback:= WrapTimerProc(@MyTimerProc, 4); //Our proc has 4 arguments
settimer(0,0,1000,timercallback); //Create a timer and give it our callback as an argument
result:=true; //keep loading setup..
end;
[/more]
Цитата:
как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.
Смотри как пример Vista Lite Skin (или Inno Setup Scripting), там один фон на каждой странице.
Victor_Dobrov
Цитата:
пробывал
не получается, точнее получилось, но перекрывается текст, тоесть надписи оказыватся под картинкой... (с кнопками всё нормально)
может глянешь? был бы благодарен.
вот каая фигня получается:
Цитата:
Смотри как пример Vista Lite Skin (или Inno Setup Scripting), там один фон на каждой странице.
пробывал
не получается, точнее получилось, но перекрывается текст, тоесть надписи оказыватся под картинкой... (с кнопками всё нормально)
может глянешь? был бы благодарен.
вот каая фигня получается:
Victor_Dobrov
Решил переделать внешний CoronaSkin под себя и вот что вышло
http://s1.ipicture.ru/uploads/081222/CYwswYRysm.jpg
можно это (я имею виду цвет фона надписей имя фамилия пользователя и организация) как-то в нормальный вид привести.
и еще что вы думаете по моему вопросу http://forum.ru-board.com/topic.cgi?forum=5&topic=27438&start=1900#16, просто мне важно знать ответ на данный вопрос (пусть даже он будет отрицательным)
Решил переделать внешний CoronaSkin под себя и вот что вышло
http://s1.ipicture.ru/uploads/081222/CYwswYRysm.jpg
можно это (я имею виду цвет фона надписей имя фамилия пользователя и организация) как-то в нормальный вид привести.
и еще что вы думаете по моему вопросу http://forum.ru-board.com/topic.cgi?forum=5&topic=27438&start=1900#16, просто мне важно знать ответ на данный вопрос (пусть даже он будет отрицательным)
Dermuin
Цитата:
если правильно понял задачу, то
procedure CurStepChanged(CurStep: TSetupStep);
var:
MyProgramm4Run, WorkDir4myProgramm, MyParameters: String;
res: Integer;
begin
if CurStep=ssDone then
begin
if MsgBox('Запустить С.Т.А.Л.К.Е.Р. - Чистое небо?', mbConfirmation, MB_YESNO) = IDYES then
begin
MyProgramm4Run:= ExpandConstant('{app}\STALKER.exe'); // полный путь к EXE
WorkDir4myProgramm:= ExpandConstant('{app}'); // полный путь к рабочей папке если нужно, а не нужно, то ''
MyParameters:= ''; // пареметры если нужно передать твоей STALKER.exe
Exec(MyProgramm4Run, MyParameters, WorkDir4myProgramm, SW_SHOW, ewWaitUntilTerminated, res);
end;
end;
end;
Цитата:
... Запустить Программу XXXX ...
если правильно понял задачу, то
procedure CurStepChanged(CurStep: TSetupStep);
var:
MyProgramm4Run, WorkDir4myProgramm, MyParameters: String;
res: Integer;
begin
if CurStep=ssDone then
begin
if MsgBox('Запустить С.Т.А.Л.К.Е.Р. - Чистое небо?', mbConfirmation, MB_YESNO) = IDYES then
begin
MyProgramm4Run:= ExpandConstant('{app}\STALKER.exe'); // полный путь к EXE
WorkDir4myProgramm:= ExpandConstant('{app}'); // полный путь к рабочей папке если нужно, а не нужно, то ''
MyParameters:= ''; // пареметры если нужно передать твоей STALKER.exe
Exec(MyProgramm4Run, MyParameters, WorkDir4myProgramm, SW_SHOW, ewWaitUntilTerminated, res);
end;
end;
end;
Victor_Dobrov, по поводу скрипта DirSizeCalc: вчера поторопился, полностью не потестил. Вообщем, если сперва нажать на Change, выбрать папку и нажать OK - то всё хорошо. А вот если нажать на Calc, то приложение зависает и выдаёт сообщение: Runtime Error
Line 76:
Math error.
76.{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
Line 76:
Math error.
76.{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
Victor_Dobrov
с таймером то что нужно! спасибо!
осталось с Vista Skin + isxbb
с таймером то что нужно! спасибо!
осталось с Vista Skin + isxbb
EagleSH
Цитата:
Я не пользуюсь Vista Lite Skin-ом и isxbb, но возможно, стоит изменить порядок создания компонентов, например, сначала создай фон, а затем всё остальное.
mikutu
Цитата:
Скин легко настраивается при помощи констант. Поменяй константу BackGroundColor и пропиши в InitializeSkin строку WizardForm.Font.Color:= clWhite. Или ставь цвет отдельно для каждого компонента.
nik1967
Цитата:
Если ничего не менять, то подсчитывается папка Windows. Скорей всего, ошибка получается при доступе к какой-то системной папке, у которой установлена особая политика безопасности.
Ещё раз повторю, что я такой ошибки не видел, хотя тестировал скрипт на многих компьютерах (от Win98 до Vista).
Цитата:
осталось с Vista Skin + isxbb
Я не пользуюсь Vista Lite Skin-ом и isxbb, но возможно, стоит изменить порядок создания компонентов, например, сначала создай фон, а затем всё остальное.
mikutu
Цитата:
Решил переделать CoronaSkin под себя и вот что вышло
можно это (я имею виду цвет фона надписей имя фамилия пользователя и организация) как-то в нормальный вид привести.
Скин легко настраивается при помощи констант. Поменяй константу BackGroundColor и пропиши в InitializeSkin строку WizardForm.Font.Color:= clWhite. Или ставь цвет отдельно для каждого компонента.
nik1967
Цитата:
по поводу скрипта DirSizeCalc: если сперва нажать на Change, выбрать папку и нажать OK - то всё хорошо. А вот если нажать на Calc, то приложение зависает и выдаёт сообщение: Runtime Error
Line 76:
Math error.
Если ничего не менять, то подсчитывается папка Windows. Скорей всего, ошибка получается при доступе к какой-то системной папке, у которой установлена особая политика безопасности.
Ещё раз повторю, что я такой ошибки не видел, хотя тестировал скрипт на многих компьютерах (от Win98 до Vista).
Victor_Dobrov
Цитата:
так и делаю, фон первым ложится, потом остальное - результат на скрине.
Цитата:
Я не пользуюсь Vista Lite Skin-ом и isxbb, но возможно, стоит изменить порядок создания компонентов, например, сначала создай фон, а затем всё остальное.
так и делаю, фон первым ложится, потом остальное - результат на скрине.
Victor_Dobrov, спасибо за разъяснение. Тогда не подскажете, как сделать надпись "Объём папок" неактивной? (Corona Skin)
cdman67
Цитата:
хм, уболтал. выложу здесь, может кому еще пригодится
вот [more=примерчик][Setup]
AppName=My Program
AppVerName=My Program v.1.2
DirExistsWarning=no
DefaultDirName={pf}\My Program
[Code_]
type
TThreadEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ThreadID: DWORD;
th32OwnerProcessID: DWORD;
tpBasePri: Longint;
tpDeltaPri: Longint;
dwFlags: DWORD;
end;
TGUIThreadinfo = record
cbSize: DWORD;
flags: DWORD;
hwndActive: HWND;
hwndFocus: HWND;
hwndCapture: HWND;
hwndMenuOwner: HWND;
hwndMoveSize: HWND;
hwndCaret: HWND;
rcCaret: TRect;
end;
TMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;
TProcessEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD;
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD;
cntThreads: DWORD;
th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array[0..259] of Char;
end;
var
AppHandle:HWND;
function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
function Thread32First(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32First@kernel32.dll stdcall';
function Thread32Next(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32Next@kernel32.dll stdcall';
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32Next@kernel32.dll stdcall';
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';
function GetGUIThreadInfo (idThread: DWORD; var pgui: TGUIThreadinfo): BOOL; external 'GetGUIThreadInfo@user32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, wFlags: Longint):boolean; external 'SetWindowPos@user32.dll stdcall';
function WaitForInputIdle(hProcess: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForInputIdle@user32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll';
function GetAppHandle:HWND;
begin
Result:=GetWindowLong(MainForm.Handle,-8);
end;
procedure AppProcessMessage;
var
Msg: TMsg;
begin
while PeekMessage(Msg,AppHandle,0,0,1) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
procedure GetProcessParam(const FileName:string; var PHandle:THandle; var PID:Cardinal);
var
h:THandle;
PS:TProcessEntry32;
fn:string;
i:integer;
begin
h:=CreateToolHelp32Snapshot($00000002,0);
if h=0 then Exit;
PS.dwSize:=SizeOf(PS);
if Process32First(h,PS) then
repeat
fn:=''; //идиотизм, но по-другому не получилось
for i:=0 to 254 do begin
if PS.szExeFile[i]=#0 then Break;
fn:=fn+PS.szExeFile[i];
end;
if AnsiUpperCase(fn)=AnsiUpperCase(FileName) then begin
PID:=PS.th32ProcessID;
Break;
end;
until not Process32Next(h,PS);
CloseHandle(h);
PHandle:=OpenProcess($001F0FFF,False,PID);
end;
procedure GetWndHandle(PID:Cardinal; var hWnd:HWND);
var
h:THandle;
TS:TThreadEntry32;
GUIThreadInfo:TGUIThreadInfo;
begin
h:=CreateToolhelp32Snapshot($00000004,0);
if h=0 then Exit;
TS.dwSize:=SizeOf(TS);
GUIThreadinfo.cbSize:=SizeOf(GUIThreadinfo);
if Thread32First(h,TS) then
repeat
if PID=TS.th32OwnerProcessID then
if GetGUIThreadInfo(TS.th32ThreadID,GUIThreadInfo) then
if (GUIThreadInfo.hwndActive>0) then begin
hWnd:=GUIThreadInfo.hwndActive;
Break;
end;
until not Thread32Next(h,TS);
CloseHandle(h);
end;
procedure ExecAppAndMoveWindow(Filename,Params,WorkingDir:string;X,Y:integer;WaitingProcess:boolean);
var
ErrorCode: Integer;
PID:Cardinal;
PH:THandle;
PWndHandle:HWND;
begin
//при таком подходе SW_HIDE ставить нельзя, окно не найдется, что хреново, будет видно перемещение окна
if not ShellExec('',Filename,Params,WorkingDir,SW_SHOW,ewNoWait,ErrorCode) then Exit;
PH:=0;
PID:=0;
PWndHandle:=0;
GetProcessParam(FileName,PH,PID);
try
if (PID<>0) and (PH<>0) then begin
WaitForInputIdle(PH,DWORD($FFFFFFFF));
//здесь надо бы юзать EnumThreadWindows (тогда бы можно было использовать SW_HIDE в ShellExec и все бы было красиво),
//но это тащить с собой innocallback.dll, поэтому попробуем по-другому
GetWndHandle(PID,PWndHandle);
if PWndHandle<>0 then begin
SetWindowPos(PWndHandle,0,X,Y,0,0,$41);
if WaitingProcess then begin
AppHandle:=GetAppHandle;
while WaitForSingleObject(PH,200)<>0 do AppProcessMessage;
end;
end;
end;
finally
CloseHandle(PH);
end;
end;
procedure InitializeWizard();
begin
//огрангичения - если запущено несколько одноименных процессов, то работать будет криво, лучше наверное сказать - не будет
//из неприятного - видно перемещение окна. от этого можно избавиться если использовать innocallback.dll
ExecAppAndMoveWindow('notepad.exe','e:\test.txt','',250,250,True);
end;[/more]
здесь есть свои ограничения и неприятности
по правильному нужно писать dll и делать совсем по-другому
Добавлено:
EagleSH
зачем тебе для рисования фона на форме isxbb? это можно и без нее сделать
Цитата:
Добрый день, господа !!! Подскажите, возможен ли вывод окна SFX-архива, запускаемого в процессе инсталляции, в произвольном месте экрана или эта задача принципиально нерешабельна средствами инно ? Если этот вопрос уже освещался - просьба подтвердить, я не поленюсь перелопатить все 4 ветки )
хм, уболтал. выложу здесь, может кому еще пригодится
вот [more=примерчик][Setup]
AppName=My Program
AppVerName=My Program v.1.2
DirExistsWarning=no
DefaultDirName={pf}\My Program
[Code_]
type
TThreadEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ThreadID: DWORD;
th32OwnerProcessID: DWORD;
tpBasePri: Longint;
tpDeltaPri: Longint;
dwFlags: DWORD;
end;
TGUIThreadinfo = record
cbSize: DWORD;
flags: DWORD;
hwndActive: HWND;
hwndFocus: HWND;
hwndCapture: HWND;
hwndMenuOwner: HWND;
hwndMoveSize: HWND;
hwndCaret: HWND;
rcCaret: TRect;
end;
TMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;
TProcessEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD;
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD;
cntThreads: DWORD;
th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array[0..259] of Char;
end;
var
AppHandle:HWND;
function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
function Thread32First(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32First@kernel32.dll stdcall';
function Thread32Next(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32Next@kernel32.dll stdcall';
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32Next@kernel32.dll stdcall';
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';
function GetGUIThreadInfo (idThread: DWORD; var pgui: TGUIThreadinfo): BOOL; external 'GetGUIThreadInfo@user32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, wFlags: Longint):boolean; external 'SetWindowPos@user32.dll stdcall';
function WaitForInputIdle(hProcess: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForInputIdle@user32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll';
function GetAppHandle:HWND;
begin
Result:=GetWindowLong(MainForm.Handle,-8);
end;
procedure AppProcessMessage;
var
Msg: TMsg;
begin
while PeekMessage(Msg,AppHandle,0,0,1) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
procedure GetProcessParam(const FileName:string; var PHandle:THandle; var PID:Cardinal);
var
h:THandle;
PS:TProcessEntry32;
fn:string;
i:integer;
begin
h:=CreateToolHelp32Snapshot($00000002,0);
if h=0 then Exit;
PS.dwSize:=SizeOf(PS);
if Process32First(h,PS) then
repeat
fn:=''; //идиотизм, но по-другому не получилось
for i:=0 to 254 do begin
if PS.szExeFile[i]=#0 then Break;
fn:=fn+PS.szExeFile[i];
end;
if AnsiUpperCase(fn)=AnsiUpperCase(FileName) then begin
PID:=PS.th32ProcessID;
Break;
end;
until not Process32Next(h,PS);
CloseHandle(h);
PHandle:=OpenProcess($001F0FFF,False,PID);
end;
procedure GetWndHandle(PID:Cardinal; var hWnd:HWND);
var
h:THandle;
TS:TThreadEntry32;
GUIThreadInfo:TGUIThreadInfo;
begin
h:=CreateToolhelp32Snapshot($00000004,0);
if h=0 then Exit;
TS.dwSize:=SizeOf(TS);
GUIThreadinfo.cbSize:=SizeOf(GUIThreadinfo);
if Thread32First(h,TS) then
repeat
if PID=TS.th32OwnerProcessID then
if GetGUIThreadInfo(TS.th32ThreadID,GUIThreadInfo) then
if (GUIThreadInfo.hwndActive>0) then begin
hWnd:=GUIThreadInfo.hwndActive;
Break;
end;
until not Thread32Next(h,TS);
CloseHandle(h);
end;
procedure ExecAppAndMoveWindow(Filename,Params,WorkingDir:string;X,Y:integer;WaitingProcess:boolean);
var
ErrorCode: Integer;
PID:Cardinal;
PH:THandle;
PWndHandle:HWND;
begin
//при таком подходе SW_HIDE ставить нельзя, окно не найдется, что хреново, будет видно перемещение окна
if not ShellExec('',Filename,Params,WorkingDir,SW_SHOW,ewNoWait,ErrorCode) then Exit;
PH:=0;
PID:=0;
PWndHandle:=0;
GetProcessParam(FileName,PH,PID);
try
if (PID<>0) and (PH<>0) then begin
WaitForInputIdle(PH,DWORD($FFFFFFFF));
//здесь надо бы юзать EnumThreadWindows (тогда бы можно было использовать SW_HIDE в ShellExec и все бы было красиво),
//но это тащить с собой innocallback.dll, поэтому попробуем по-другому
GetWndHandle(PID,PWndHandle);
if PWndHandle<>0 then begin
SetWindowPos(PWndHandle,0,X,Y,0,0,$41);
if WaitingProcess then begin
AppHandle:=GetAppHandle;
while WaitForSingleObject(PH,200)<>0 do AppProcessMessage;
end;
end;
end;
finally
CloseHandle(PH);
end;
end;
procedure InitializeWizard();
begin
//огрангичения - если запущено несколько одноименных процессов, то работать будет криво, лучше наверное сказать - не будет
//из неприятного - видно перемещение окна. от этого можно избавиться если использовать innocallback.dll
ExecAppAndMoveWindow('notepad.exe','e:\test.txt','',250,250,True);
end;[/more]
здесь есть свои ограничения и неприятности
по правильному нужно писать dll и делать совсем по-другому
Добавлено:
EagleSH
зачем тебе для рисования фона на форме isxbb? это можно и без нее сделать
Victor_Dobrov или кто в курсе, кто мне объяснит, почему не отображаются файлы, которые в данный момент копируются???
добавил по аналогии PageNameLabel, PageDescriptionLabel и банан
[more]
var
PageNameLabel, PageDescriptionLabel, FileNameLabel: TLabel;
procedure InitializeWizard();
begin
PageNameLabel := TLabel.Create(WizardForm);
with PageNameLabel do
begin
Left := ScaleX(10);
Top := ScaleY(10);
Width := ScaleX(300);
Height := ScaleY(14);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
Font.Style := [fsBold];
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;
PageDescriptionLabel := TLabel.Create(WizardForm);
with PageDescriptionLabel do
begin
Left := ScaleX(15);
Top := ScaleY(25);
Width := ScaleX(475);
Height := ScaleY(30);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;
FileNameLabel := TLabel.Create(WizardForm);
with FileNameLabel do
begin
Left := ScaleX(15);
Top := ScaleY(65);
Width := ScaleX(475);
Height := ScaleY(30);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;
with WizardForm do
begin
PageNameLabel.Hide;
PageDescriptionLabel.Hide;
FileNameLabel.Hide;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
PageNameLabel.Caption := WizardForm.PageNameLabel.Caption;
PageDescriptionLabel.Caption := WizardForm.PageDescriptionLabel.Caption;
FileNameLabel.Caption := WizardForm.FileNameLabel.Caption;
end;
[/more]
добавил по аналогии PageNameLabel, PageDescriptionLabel и банан
[more]
var
PageNameLabel, PageDescriptionLabel, FileNameLabel: TLabel;
procedure InitializeWizard();
begin
PageNameLabel := TLabel.Create(WizardForm);
with PageNameLabel do
begin
Left := ScaleX(10);
Top := ScaleY(10);
Width := ScaleX(300);
Height := ScaleY(14);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
Font.Style := [fsBold];
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;
PageDescriptionLabel := TLabel.Create(WizardForm);
with PageDescriptionLabel do
begin
Left := ScaleX(15);
Top := ScaleY(25);
Width := ScaleX(475);
Height := ScaleY(30);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;
FileNameLabel := TLabel.Create(WizardForm);
with FileNameLabel do
begin
Left := ScaleX(15);
Top := ScaleY(65);
Width := ScaleX(475);
Height := ScaleY(30);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;
with WizardForm do
begin
PageNameLabel.Hide;
PageDescriptionLabel.Hide;
FileNameLabel.Hide;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
PageNameLabel.Caption := WizardForm.PageNameLabel.Caption;
PageDescriptionLabel.Caption := WizardForm.PageDescriptionLabel.Caption;
FileNameLabel.Caption := WizardForm.FileNameLabel.Caption;
end;
[/more]
Апаю свои два вопроса:
Дописывание параметров к ярлыку при выборе определенных компонентов.
Список компонентов с хитрой структурой.
Пока решения так и не придумал...
Дописывание параметров к ярлыку при выборе определенных компонентов.
Список компонентов с хитрой структурой.
Пока решения так и не придумал...
Привет, народ. У меня к Вам вопросик, вроде где-то на страницах ветки видел ответ на него, да уже не помню где именно, а заново перелистывать страницу за страницей нет сил..
Сам вопрос: как сделать, чтобы в зависимости от выбора языка установки на страницах wpLicense и wpInfoAfter файл лицензии и второй файл показывались на своих соответствующих языках. в программе установки три языка, имеются по три файла лицензии для каждого.
Заранее спасибо!
Вопрос решен, ответ найден на 97-й странице, с другой стороны перечитал почти с середины ветку, копнул другой разной информации.. =)
Сам вопрос: как сделать, чтобы в зависимости от выбора языка установки на страницах wpLicense и wpInfoAfter файл лицензии и второй файл показывались на своих соответствующих языках. в программе установки три языка, имеются по три файла лицензии для каждого.
Заранее спасибо!
Вопрос решен, ответ найден на 97-й странице, с другой стороны перечитал почти с середины ветку, копнул другой разной информации.. =)
Итак, первый мой вопрос решён с помощью функции IsComponentSelected.
[more=Пример кода]
Код: [Components]
Name: cmp1; Description: desc1
Name: cmp2; Description: desc2
Name: cmp3; Description: desc3
[Code]
function BuildCommandlineParams(CLP: String): String;
begin
CLP:='';
if IsComponentSelected('cmp1') then CLP:=CLP+'param1';
if IsComponentSelected('cmp2') then CLP:=CLP+'param2';
if IsComponentSelected('cmp3') then CLP:=CLP+'param3';
Result:=CLP;
end;
[Icons]
Name: name; Filename: filename; Parameters: {code:BuildCommandlineParams}
[more=Пример кода]
Код: [Components]
Name: cmp1; Description: desc1
Name: cmp2; Description: desc2
Name: cmp3; Description: desc3
[Code]
function BuildCommandlineParams(CLP: String): String;
begin
CLP:='';
if IsComponentSelected('cmp1') then CLP:=CLP+'param1';
if IsComponentSelected('cmp2') then CLP:=CLP+'param2';
if IsComponentSelected('cmp3') then CLP:=CLP+'param3';
Result:=CLP;
end;
[Icons]
Name: name; Filename: filename; Parameters: {code:BuildCommandlineParams}
Страницы: 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970
Предыдущая тема: Презентация
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.