FAQ FAQ по Inno Setup

sergey3695

Ветеран
Модератор
В: Как сделать анимированный баннер?
О: Так (спасибо El Sanchez)
Код:
[Setup]
AppName=test
AppVerName=test
DefaultDirName={tmp}
Uninstallable=no
CreateUninstallRegKey=no
OutputDir=.

[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl

[Files]
Source: "giphy.gif"; Flags: dontcopy solidbreak

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
  WS_CHILD = $40000000;
  WS_VISIBLE = $10000000;
  WS_DISABLED = $08000000;

// ATL Functions
function AtlAxWinInit: BOOL; external 'AtlAxWinInit@atl.dll stdcall';
function AtlAxCreateControl(lpszName: string; hWnd: HWND; pStream, ppUnkContainer: Longint): HResult; external 'AtlAxCreateControl@atl.dll stdcall';

// Window Functions
function GetSysColor(nIndex: Integer): DWORD; external 'GetSysColor@user32.dll stdcall';
function CreateWindowEx(dwExStyle: DWORD; lpClassName, lpWindowName: string; dwStyle: DWORD; x, y, nWidth, nHeight: Integer; hWndParent: HWND; hMenu: HMENU; hInstance, lpParam: Longint): HWND; external 'CreateWindowEx{#A}@user32.dll stdcall';
function DestroyWindow(hWnd: HWND): BOOL; external 'DestroyWindow@user32.dll stdcall';

var
  GIFWndHandle: HWND;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ShowAnimatedGIF(AWndParent: HWND; ALeft, ATop, AWidth, AHeight: Integer; AUrl: string; AColor: TColor): HWND;
(*
Parameters:
  AWndParent...: A handle to the parent window
  ALeft........: The initial horizontal position of the window
  ATop.........: The initial vertical position of the window
  AWidth.......: The width of the window
  AHeight......: The height of the window
  AUrl.........: The URL or full path of the GIF file
  AColor.......: Color background
Return value:
  A handle to ActiveX control host window
*)
var
  HTMLStr: string;
  ResultCode: HResult;
begin
  if not AtlAxWinInit then Exit;
  Result := CreateWindowEx(0, 'AtlAxWin', '', WS_CHILD or WS_VISIBLE or WS_DISABLED, ALeft, ATop, AWidth, AHeight, AWndParent, 0, 0, 0);
  if Result = 0 then
    RaiseException(SysErrorMessage(DLLGetLastError));

  if AColor < 0 then
    AColor := GetSysColor(AColor and $0000FF);
  HTMLStr := Format('about:<html><body leftmargin="0" topmargin="0" scroll="no" bgcolor="#%.2x%.2x%.2x"><p align="center"><img src="%s" height="100%%"></img></p></body></html>', [AColor and $0000FF, AColor and $00FF00 shr 8, AColor and $FF0000 shr 16, AUrl]);

  ResultCode := AtlAxCreateControl(HTMLStr, Result, 0, 0);
  if ResultCode <> 0 then
    RaiseException(SysErrorMessage(ResultCode));
end;

///////////////////////////
procedure InitializeWizard;
begin
  ExtractTemporaryFile('giphy.gif');
  GIFWndHandle := ShowAnimatedGIF(WizardForm.SelectDirPage.Handle,
    0, WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + ScaleY(5), WizardForm.SelectDirPage.Width, WizardForm.DiskSpaceLabel.Top - WizardForm.DirEdit.Top - WizardForm.DirEdit.Height - ScaleY(5),
     ExpandConstant('{tmp}\giphy.gif'), WizardForm.SelectDirPage.Color);
end;

////////////////////////////
procedure DeinitializeSetup;
begin
  if GIFWndHandle <> 0 then
    DestroyWindow(GIFWndHandle);
end;
 

sergey3695

Ветеран
Модератор
В: Как сделать HexToStr и StrToHex?
О: Так
Код:
[Setup]
AppName=test
AppVerName=test
DefaultDirName={tmp}
Uninstallable=no
CreateUninstallRegKey=no
OutputDir=.

[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl

[Code]
function HexToStr(str_hex: string): string;
var
  i: Integer;
begin
  Result:= '';
  StringChange(str_hex, ',', '');
  for i:= 1 to Length(str_hex) div 2 do
    Result:= Result +  Chr(StrToInt('$' + Copy(str_hex, (i-1)*2+1, 2)));
end;

function StrToHex(str: string): string;
var
  i: Integer;
begin
  Result:= '';
  for i:= 1 to Length(str) do
    Result:= Result +  Format('%.2x', [Ord(str[i]), Ord(str[i])]);
end;

procedure InitializeWizard;
var
  S: string;
begin
  S := HexToStr('6D6F757365');
  MsgBox(S, mbInformation, MB_OK);
  S := StrToHex('mouse');
  MsgBox(S, mbInformation, MB_OK);
end;
 

sergey3695

Ветеран
Модератор
В: Как отрисовать миниатюру?
О: Так
Код:
[Setup]
AppName=MainForm
AppVerName=MainForm 1.0
DefaultDirName={pf}\MainForm
// Нужно вырубить эту страницу т.к. там ставится фокус на кнопку Next
DisableReadyPage=yes
OutputDir=.

[Code]
function GetForegroundWindow: HWND; external 'GetForegroundWindow@user32.dll stdcall delayload';
function SetForegroundWindow(hWnd: HWND): BOOL; external 'SetForegroundWindow@user32.dll stdcall delayload';

procedure MShow(Sender: TObject);
begin
  MainForm.Show;
if GetForegroundWindow = WizardForm.Handle then
  SetForegroundWindow(MainForm.Handle);
end;

procedure DirOnClick(Sender: TObject);
var
  UserSelectDir: String;
begin
  UserSelectDir:= WizardForm.DirEdit.Text;
if BrowseForFolder(SetupMessage(msgBrowseDialogLabel), UserSelectDir, True) then
  WizardForm.DirEdit.Text:= UserSelectDir;
end;

procedure InitializeWizard();
var
  r: TRect;
begin
with MainForm do
begin
  Width:= WizardForm.Width;
  Height:= WizardForm.Height;
  BorderIcons := WizardForm.BorderIcons;
  BorderStyle := WizardForm.BorderStyle;
  Position:= poDesktopCenter;
with TBitmapImage.Create(MainForm) do
begin
  Parent:= MainForm;
  Width:= MainForm.ClientWidth;
  Height:= MainForm.ClientHeight;
with Bitmap do begin
  Width:= Width;
  Height:= Height;
  Canvas.Brush.Color:= clWindow;
  r.Left:=0;
  r.Top:=0;
  r.Right:=WizardfOrm.ClientWidth;
  r.Bottom:=WizardForm.ClientHeight;
  Canvas.FillRect(r);
end;
end;
end;
  WizardForm.Left:= -10000;
  WizardForm.OnShow:= @MShow;
//
  WizardForm.NextButton.Parent:= MainForm;
  WizardForm.BackButton.Parent:= MainForm;
  WizardForm.CancelButton.Parent:= MainForm;
  WizardForm.OuterNotebook.Parent:= MainForm;
  WizardForm.Bevel.Parent:= MainForm;
  WizardForm.DirBrowseButton.OnClick:= @DirOnClick;
end;

function GetSystemMenu(hWnd: HWND; bRevert: BOOL): LongWord; external 'GetSystemMenu@user32.dll stdcall';
function EnableMenuItem(hMenu: THandle; uIDEnableItem: Longword; uEnable: Longword): Boolean; external 'EnableMenuItem@user32.dll stdcall';

const
  MF_BYCOMMAND = 0;
  MF_ENABLED = 0;
  MF_GRAYED = 1;
  MF_DISABLED = 2;
  SC_CLOSE = 61536;

procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID=wpSelectDir then
  WizardForm.NextButton.Caption:= SetupMessage(msgButtonInstall);
if CurPageID=wpFinished then
  EnableMenuItem(GetSystemMenu(MainForm.Handle, false), SC_CLOSE, MF_DISABLED or MF_BYCOMMAND);
end;
 
Последнее редактирование:

sergey3695

Ветеран
Модератор
В: Как менять формат в Языковых параметрах для приложения на момент запуска?
О: Пример с Dead Space 3
Код:
[Setup]
AppName=Language
AppVersion=1.0
DefaultDirName=no
CreateUninstallRegKey=no
SetupIconFile=101.ico
Uninstallable=no
Compression=none
OutputDir=.

[Code]
#include "Modules\ExecAndWait.iss"

function ShowWindow(hWnd: Integer; uType: Integer): Integer; external 'ShowWindow@user32.dll stdcall';

var
  lang, switch: string;
 
function InitializeSetup(): Boolean;
begin
  ShowWindow(Application.Handle, 0);
if (FileExists(ExpandConstant('{src}\deadspace3_Game.exe')) and FileExists(ExpandConstant('{src}\GDFBinary_en_US.dll'))) or (FileExists(ExpandConstant('{src}\deadspace3_Game.exe')) and FileExists(ExpandConstant('{src}\GDFBinary_ru_RU.dll'))) then
begin
  RegQueryStringValue(HKEY_CURRENT_USER, 'Control Panel\International', 'LocaleName', lang);
if FileExists(ExpandConstant('{src}\GDFBinary_en_US.dll')) then
  switch:= 'en-US';
if FileExists(ExpandConstant('{src}\GDFBinary_ru_RU.dll')) then
  switch:= 'ru-RU';
if switch<>lang then
  RegWriteStringValue(HKEY_CURRENT_USER, 'Control Panel\International', 'LocaleName', switch);
if ExtractFileName(ExpandConstant('{srcexe}'))<>'deadspace3_Game.exe' then
  ExecAndWait(ExpandConstant('{src}\deadspace3_Game.exe'), '', SW_SHOW, true, 0);
if switch<>lang then
  RegWriteStringValue(HKEY_CURRENT_USER, 'Control Panel\International', 'LocaleName', lang);
end else
  MsgBox('Error!', mbError, MB_OK);
  Result:= False;
end;
 

Вложения

Последнее редактирование:

sergey3695

Ветеран
Модератор
В: Как сменить раскладку? (пример для англ.)
О: Так
Код:
[Setup]
AppName=LoadKeyboard
AppVersion=1.0
DefaultDirName=no
CreateUninstallRegKey=no
SetupIconFile=102.ico
OutputBaseFilename=Start
Uninstallable=no
Compression=none
OutputDir=.

[Code]
#include "Modules\ExecAndWait.iss"

function LoadKeyboardLayout(hWnd: string; uType: cardinal): Integer; external 'LoadKeyboardLayoutW@user32.dll stdcall';
function GetKeyboardLayout(id: integer): Integer; external 'GetKeyboardLayout@user32.dll stdcall';

function GetActiveKbdLayout: LongWord;
begin
  result:= GetKeyboardLayout(0) shr $10;
end;

function InitializeSetup(): Boolean;
begin
if FileExists(ExpandConstant('{src}\bio4.exe')) then
begin
if GetActiveKbdLayout<>1033 then
  LoadKeyboardLayout('00000409', 1);
if ExtractFileName(ExpandConstant('{srcexe}'))<>'bio4.exe' then
  ExecAndWait(ExpandConstant('{src}\bio4.exe'), '', SW_SHOW, false, 0);
end else
  MsgBox('Error!', mbError, MB_OK);
  Result:= False;
end;
p.s. и тут re4 :D

Если вы хотите загрузить и активировать раскладку клавиатуры для всего процесса, вы можете попытаться объединить флаг KLF_ACTIVATE с помощью KLF_SETFORPROCESS
KLF_ACTIVATE or KLF_SETFORPROCESS
const KLF_SETFORPROCESS = $00000100;
 
Последнее редактирование:

sergey3695

Ветеран
Модератор
В: Как передать параметры приложению?
О: Так
Код:
[Code]
function Param: string;
begin
  Result:= Copy(GetCmdTail, pos(ExtractFileName(ExpandConstant('{srcexe}')),GetCmdTail)+Length(ExtractFileName(ExpandConstant('{srcexe}')))+1, Length(GetCmdTail));
end;
 

Xabib2302

Новичок
В: Как сделать чтобы при выборе или отмене компонента и задачи добавлялась или удалялась часть команды в секции Run?
О: Примерно так. Это самый простой вариант без большого кода. Данным методом подставляю ноль или единицу.
Код:
; Скрипт создан через Мастер Inno Setup Script.
; ИСПОЛЬЗУЙТЕ ДОКУМЕНТАЦИЮ ДЛЯ ПОДРОБНОСТЕЙ ИСПОЛЬЗОВАНИЯ INNO SETUP!

#define MyAppName "Моя программа"
#define MyAppVersion "1.5"
#define MyAppPublisher "Моя компания, Inc."
#define MyAppURL "http://www.сайт.com/"
#define MyAppExeName "MyProg.exe"

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

[Languages]
Name: "english"; MessagesFile: "compiler:Languages\English.isl"
Name: "russian"; MessagesFile: "compiler:Languages\Russian.isl"
Name: "ukrainian"; MessagesFile: "compiler:Languages\Ukrainian.isl"

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

[Run]
Filename: msiexec.exe; Parameters: "/I ""{tmp}\Setup.msi"" /qf ALL_USERS=1 EULA_ACCEPTED=1 LAUNCH_FINEREADER=0 INSTALLDIR=""{app}"" {code:GetParam_1} {code:GetParam_2} {code:GetParam_3} {code:GetParam_4} {code:GetParam_5} {code:GetParam_6}"; Check: not WizardSilent; Flags: waituntilterminated hidewizard;

[Ini]
filename: {src}\script.ini; section: "Command"; key: "LANG"; string: "TRANSFORMS=1049.mst"; Languages: russian;
filename: {src}\script.ini; section: "Command"; key: "LANG"; string: "TRANSFORMS=1033.mst"; Languages: english;
filename: {src}\script.ini; section: "Command"; key: "LANG"; string: "TRANSFORMS=1058.mst"; Languages: ukrainian;
filename: {src}\script.ini; section: "Command"; key: "SHCTDESKTOP"; string: "SHCTDESKTOP=1"; Tasks: desktopicon;
filename: {src}\script.ini; section: "Command"; key: "EXPLORER"; string: "EXPLORER=1"; Components: ABBYYFN\EXPLORER;
filename: {src}\script.ini; section: "Command"; key: "HF"; string: "HF=1"; Components: ABBYYFN\HF;
filename: {src}\script.ini; section: "Command"; key: "SSR"; string: "SSR=1"; Components: ABBYYFN\SSR;
filename: {src}\script.ini; section: "Command"; key: "COMPARATOR"; string: "COMPARATOR=1"; Components: ABBYYFN\COMPARATOR;
filename: {src}\script.ini; section: "Command"; key: "SHCTDESKTOP"; string: "SHCTDESKTOP=0"; Tasks: not desktopicon;
filename: {src}\script.ini; section: "Command"; key: "EXPLORER"; string: "EXPLORER=0"; Components: not ABBYYFN\EXPLORER;
filename: {src}\script.ini; section: "Command"; key: "HF"; string: "HF=0"; Components: not ABBYYFN\HF;
filename: {src}\script.ini; section: "Command"; key: "SSR"; string: "SSR=0"; Components: not ABBYYFN\SSR;
filename: {src}\script.ini; section: "Command"; key: "COMPARATOR"; string: "COMPARATOR=0"; Components: not ABBYYFN\COMPARATOR;

[Components]
Name: ABBYYFN; Description: "ABBYY FineReader 14"; Flags: checkablealone;
Name: ABBYYFN\EXPLORER; Description: "Интеграция с Проводником Windows"; Flags: checkablealone;
Name: ABBYYFN\HF; Description: "ABBYY Hot Folder"; Flags: checkablealone;
Name: ABBYYFN\SSR; Description: "ABBYY Screenshot Reader"; Flags: checkablealone;
Name: ABBYYFN\COMPARATOR; Description: "ABBYY Сравнение документов"; Flags: checkablealone;

[code]
function GetParam_1(s: String): String;
begin
  Result:=GetIniString('Command', 'LANG', '', ExpandConstant('{src}\script.ini'));
end;
function GetParam_2(s: String): String;
begin
  Result:=GetIniString('Command', 'SHCTDESKTOP', '', ExpandConstant('{src}\script.ini'));
end;
function GetParam_3(s: String): String;
begin
  Result:=GetIniString('Command', 'EXPLORER', '', ExpandConstant('{src}\script.ini'));
end;
function GetParam_4(s: String): String;
begin
  Result:=GetIniString('Command', 'HF', '', ExpandConstant('{src}\script.ini'));
end;
function GetParam_5(s: String): String;
begin
  Result:=GetIniString('Command', 'SSR', '', ExpandConstant('{src}\script.ini'));
end;
function GetParam_6(s: String): String;
begin
  Result:=GetIniString('Command', 'COMPARATOR', '', ExpandConstant('{src}\script.ini'));
end;
 
Последнее редактирование:

nik1967

Old Men
Проверенный
Понадобилось получить размер установленной игры (именно установленной уже), ну типа размер папки.
Наткнулся у себя на такой скрипт (да простит меня автор, не помню, откуда взял, или кто мне дал :( (скрипт конечно же)).
Код:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[code]
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.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 GetFileSize(FilePath:string):Extended;            // размер файла
var
       oFS: Variant;
begin
       try
               if not FileExists(FilePath) then Exit;
               oFS := CreateOleObject('Scripting.FileSystemObject');
               Result := oFS.GetFile(FilePath).Size;
       except
               Result:= 0;
    end;
end;

function GetFolderSize(path: String): Extended;            // размер папки
var
    oFS: Variant;
begin
    try
        if not DirExists(path) then Exit;
        oFS:= CreateOleObject('Scripting.FileSystemObject');
        Result:= oFS.GetFolder(path).Size;
    except
        Result:= 0;
    end;
end;

function FileVersion(FilePath:string):string;              // версия файла
var
  oFS: Variant;
begin
  oFS := CreateOleObject('Scripting.FileSystemObject');
  Result := oFS.GetFileVersion(FilePath);
end;

function DriveName(FilePath:string):string;                // получение буквы жёсткого диска на котором лежит файл
var
  oFS: Variant;
begin
  oFS := CreateOleObject('Scripting.FileSystemObject');
  Result := oFS.GetDriveName(FilePath);
end;

function CreateFolderUniqueName:string;                    // генерирование уникального имени папки для использования её в %Temp%
var
  oFS: Variant;
begin
  oFS := CreateOleObject('Scripting.FileSystemObject');
  Result := oFS.GetTempName;
end;

function DriveExists(Drive:string):boolean;                // проверка наличия жёсткого диска по букве:
var
  oFS: Variant;
begin
  oFS := CreateOleObject('Scripting.FileSystemObject');
  Result := oFS.DriveExists(Drive);
end;

function FolderExists(Folder:string):boolean;              // альтернатива функции DirExists
var
  oFS: Variant;
begin
  oFS := CreateOleObject('Scripting.FileSystemObject');
  Result := oFS.FolderExists(Folder);
end;

procedure InitializeWizard();
begin
if DriveExists('C') then MsgBox('ok', mbInformation, MB_OK);
if FolderExists('C:\Program Files') then MsgBox('ok', mbInformation, MB_OK);
  MsgBox(BytesToSize(GetFileSize('D:\Games\S.T.A.L.K.E.R. - Lost Alpha\gamedata.dba')), mbInformation, MB_OK);
  MsgBox(FileVersion('C:\Windows\regedit.exe'), mbInformation, MB_OK);
  MsgBox(DriveName('C:\Windows\regedit.exe'), mbInformation, MB_OK);
  MsgBox(CreateFolderUniqueName, mbInformation, MB_OK);
  MsgBox(BytesToSize(GetFolderSize('F:\Games\R.G. Catalyst\The Sinking City')), mbInformation, MB_OK);
end;
Может кому и будет полезно.
Для себя переписал
Код:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[code]
function NumToStr(Float: Extended): String;
begin
  Result:= Format('%.0n', [Float]);
  StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
  SetLength(Result, Length(Result)-1);
end;

function MbOrTb(Byte: Extended): String;
begin
  if Byte < 1024 then Result:= NumToStr(Byte)+'mb' else
    if Byte/100 < 1024 then Result:= NumToStr((Byte/1024*100)/100)+'gb' else
      Result:= NumToStr((Byte/(1024*1024)*100)/100)+'tb';
end;

function GetFolderSize(path: String): Extended;            // размер папки
var
    oFS: Variant;
begin
    try
        if not DirExists(path) then Exit;
        oFS:= CreateOleObject('Scripting.FileSystemObject');
        Result:= oFS.GetFolder(path).Size div 1048576;
    except
        Result:= 0;
    end;
end;

procedure InitializeWizard();
begin
  MsgBox(MbOrTb(GetFolderSize('F:\Games\R.G. Catalyst\The Sinking City')), mbInformation, MB_OK);
  //MsgBox(NumToStr(GetFolderSize('F:\Games\R.G. Catalyst\The Sinking City')), mbInformation, MB_OK);   //если нужно в мегабайтах
end;
А, это
В: Как узнать размер папки?
О: Вот так.

А, еще, вдруг кто не знал, как сделать необходимое количество цифр после запятой
Код:
Result:= format('%.0n', [Float]); StringChange(Result, ',', '.'); Целые
Result:= format('%.1n', [Float]); StringChange(Result, ',', '.'); Десятые
Result:= format('%.2n', [Float]); StringChange(Result, ',', '.'); Сотые
Result:= format('%.3n', [Float]); StringChange(Result, ',', '.'); Тысячные
P.S. Не знаю, как на 7-ке, а на 10-ке нельзя получить размер некоторых папок с системного диска. Разрешения, будь они неладны.
 
Последнее редактирование:

Xabib2302

Новичок
В: Как заменить иконку в диалоге Select Languages?
О: Вот так.
Код:
#include 'botva2.iss'

[Setup]
AppName=Example
AppVerName=Example
DefaultDirName={pf}\Example
DefaultGroupName=Example
OutputDir=.

[Languages]
Name: "english"; MessagesFile: "compiler:Languages\English.isl"
Name: "russian"; MessagesFile: "compiler:Languages\Russian.isl"

[Files]
Source: Files\*; Flags: dontcopy;

[Code]
function InitializeSetup:boolean;
begin
  if not FileExists(ExpandConstant('{tmp}\botva2.dll')) then ExtractTemporaryFile('botva2.dll');
  Result:=True;
end;

function InitializeLanguageDialog(): Boolean;
var
  Panel: TPanel;
begin
  if not FileExists(ExpandConstant('{tmp}\botva2.dll')) then ExtractTemporaryFile('botva2.dll');
  if not FileExists(ExpandConstant('{tmp}\Icon.png')) then ExtractTemporaryFile('Icon.png');
 with SelectLanguageForm do begin
  Panel:= TPanel.Create(SelectLanguageForm)
 with Panel do begin
  SetBounds(IconBitmapImage.Left,IconBitmapImage.Top,IconBitmapImage.Width+ScaleX(50),IconBitmapImage.Height+ScaleY(50));
  BevelInner:= bsNone;
  BevelOuter:= bsNone;
  Parent:= SelectLanguageForm;
 end;
  Width:= Width+ScaleX(50);
  SelectLabel.Left:= SelectLabel.Left+ScaleX(50);
  LangCombo.Left:= LangCombo.Left+ScaleX(50);
  OKButton.Left:= OKButton.Left+ScaleX(50);
  CancelButton.Left:= CancelButton.Left+ScaleX(50);
  ImgLoad(Panel.Handle,'Icon.png',0,0,IconBitmapImage.Width+ScaleX(50),IconBitmapImage.Height+ScaleY(50),True,True);
  ImgApplyChanges(Panel.Handle);
  IconBitmapImage.Hide;
 end;
 Result := True;
end;

procedure DeinitializeSetup;
begin
  gdipShutDown;
end;
 

Вложения

sergey3695

Ветеран
Модератор
В: Как отрисовать миниатюру? (2)
О: Так. Thanks DiCaPrIo from FileForums.
Код:
[Setup]
AppName=test
AppVerName=test
DefaultDirName={tmp}
Uninstallable=no
CreateUninstallRegKey=no
OutputDir=.

[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl

[Code]
function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; external 'SetWindowLongW@user32.dll stdcall';
function GetWindowLong(Wnd: HWnd; Index: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';
Function GetWindow (HWND: Longint; uCmd: cardinal): Longint;external 'GetWindow@user32.dll stdcall';

procedure InitializeWizard();
begin
  SetWindowLong(WizardForm.Handle, -8,GetWindowLong(GetWindow(WizardForm.Handle, 4),-8));
end;
 

SBalykov

Старожил
Не все инсталляторы устанавливают значки в системном трее на разных системах.
Предлагаю способ как этого добиться...

В: Как Создать значок в панели задач для windows 7-10? (2)
О: Так. Thanks El Sanchez for ideas.
Код:
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirName=MyApp
Uninstallable=no
CreateUninstallRegKey=no
OutputDir=.

[Files]
// Файлы игры
//=============================================================
Source: sourse\MyApp.exe; DestDir: {app}\;

[code]
const
CLSID_TaskbandPin = '{90AA3A4E-1CBA-4233-B8BB-535773D48449}';
IID_IPinnedList = '{0DD79AE2-D156-45D4-9EEB-3B549769E940}';
CLSCTX_INPROC_SERVER = 1;
PLMC_EXPLORER = 4;
S_OK = 0;

type
PItemIDList = LongWord;
IPinnedList = interface(IUnknown)'{0DD79AE2-D156-45D4-9EEB-3B549769E940}'
procedure EnumObjects;
procedure GetPinnableInfo;
procedure IsPinnable;
procedure Resolve;
procedure LegacyModify;
procedure GetChangeCount;
function IsPinned(pidl: PItemIDList): HRESULT;
procedure GetPinnedItem;
procedure GetAppIDForPinnedItem;
procedure ItemChangeNotify;
procedure UpdateForRemovedItemsAsNecessary;
procedure PinShellLink;
procedure GetPinnedItemForAppID;
function Modify(unpin, pin: PItemIDList; ModifyCaller: LongWord): HRESULT;
end;

var
LPIDL: PItemIDList;
LUnk: IUnknown;
LPinnedList: IPinnedList;
LShellApp: Variant;
LVerb: string;

function CoCreateInstance(rclsid: TCLSID; pUnkOuter: LongWord; dwClsContext: DWORD; riid: TIID; out ppv: IUnknown): HRESULT; external 'CoCreateInstance@ole32.dll stdcall delayload';
function ILCreateFromPath(const pszPath: string): PItemIDList; external 'ILCreateFromPathW@shell32.dll stdcall delayload';
procedure ILFree(pidl: PItemIDList); external 'ILFree@shell32.dll stdcall delayload';

// Проверка версии системы  Win10
//=============================================================
function isWin10: Boolean;
begin
if GetWindowsVersion shr 24 < 10 then
  result := False else
  result := True;
end;

// Значок игры в Панель задач
//=============================================================
function PinToTaskbar(const AFilename: string; AIsPin: Boolean): Boolean;
begin
  Result := False;
if isWin10 then begin
if FileExists(AFilename) then
  try
  LPIDL := ILCreateFromPath(AFilename);
  try
  OleCheck(CoCreateInstance(StringToGUID(CLSID_TaskbandPin), 0, CLSCTX_INPROC_SERVER, StringToGUID(IID_IPinnedList), LUnk));
  LPinnedList := LUnk as IPinnedList;
  except
  LShellApp := CreateOleObject('Shell.Application');
  end;
if AIsPin then begin  // pin to taskbar
if LPinnedList <> nil then begin
  Result := LPinnedList.IsPinned(LPIDL) <> S_OK;
if Result then
  OleCheck(LPinnedList.Modify(0, LPIDL, PLMC_EXPLORER));
  end else
  LVerb := 'taskbarpin';
  end else begin      // unpin from taskbar
if LPinnedList <> nil then begin
  Result := LPinnedList.IsPinned(LPIDL) = S_OK;
if Result then
  OleCheck(LPinnedList.Modify(LPIDL, 0, PLMC_EXPLORER));
  end else
  LVerb := 'taskbarunpin';
  end;
if LVerb <> '' then
  LShellApp.Windows.Item.Document.Application.NameSpace(ExtractFileDir(AFilename)).ParseName(ExtractFileName(AFilename)).InvokeVerb(LVerb);
  except
  Result := False;
  ShowExceptionMessage;
  finally
  ILFree(LPIDL);
  end;
  end else begin
if not FileExists(AFileName) then Exit;
    try
if AIsPin then
  LVerb := 'taskbarpin' else
  LVerb := 'taskbarunpin';
  LShellApp := CreateOleObject('Shell.Application');
  LShellApp.Windows.Item.Document.Application.NameSpace(ExtractFileDir(AFileName)).ParseName(ExtractFileName(AFileName)).InvokeVerb(LVerb);
  Result := True;
  except
  ShowExceptionMessage;
  end;
  end;
end;

procedure CurPageChanged(CurPageID: Integer);
begin
  case CurPageID of
  wpInstalling: PinToTaskbar(ExpandConstant('{app}\MyApp.exe'), False);
    end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  case CurStep of
  ssPostInstall: PinToTaskbar(ExpandConstant('{app}\MyApp.exe'), True);
  end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
  case CurUninstallStep of
    usUninstall:  PinToTaskbar(ExpandConstant('{app}\MyApp.exe'), False); 
  end;
end;
 
Последнее редактирование:

hgdagon

Новичок
В: Как удалить кнопки свернуть, развернуть из окна инсталлятора?
О: Так
Код:
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp

[code]
const
  GWL_STYLE = -16;

  WS_MINIMIZEBOX = $20000;
  WS_MAXIMIZEBOX = $10000;

function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';

procedure initializeWizard();
begin
  SetWindowLong(WizardForm.handle, GWL_STYLE, GetWindowLong(WizardForm.handle, GWL_STYLE)and(not WS_MINIMIZEBOX)and(not WS_MAXIMIZEBOX));
end;
А можно еще и вот так:
Код:
procedure InitializeWizard();
begin
  WizardForm.BorderStyle := bsToolWindow;
end;
 

Krinkels

Он где то тут
Администратор
В: Как создать MsgBox с таймером автозакрытия расположенном на кнопке?
О: Можно так
Авторы: @Хамик @sergey3695
code_language.pascal:
var
  tmr: TTimer;
  i: integer;
  ext: boolean;
  wnd, btn : HWND;
const
  WM_CLOSE = $0010;
  WM_SETTEXT = $C;

function SendMessageW(hWnd: HWND; Msg: UINT; wParam: Longint; lParam: Pansichar): Longint; external 'SendMessageA@user32.dll stdcall';
function GetDlgItem(hWnd: hWnd; nIDDlgItem: integer): HWND; external 'GetDlgItem@user32.dll stdcall';

procedure Timer(Sender: TObject);
begin
  i:= i - 1;
  if (wnd = 0) then
  begin
    wnd := FindWindowByWindowName(SetupMessage(msgSetupAppTitle));
    tmr.Interval:= 1000;
  end;
  if (btn = 0) and (wnd <> 0) then
    btn := GetDlgItem(wnd, 2);
  if (btn <> 0) then
    SendMessageW(btn, WM_SETTEXT, 0, SetupMessage(msgButtonOK) + ' ' + IntToStr(i));
  if (i = 0) then
  begin
  if (ext = true) and (wnd <> 0) then
    SendMessage(wnd, WM_CLOSE, 0, 0);
    tmr.Enabled := false;
  end;
end;

procedure MsgBoxTimeOut(const Text: string; WaitSeconds: integer; AutoClose: boolean);
begin
  i := WaitSeconds + 1;
  ext := AutoClose;
  tmr := TTimer.Create(nil);
  with tmr do
  begin
    Interval := 1;
    OnTimer := @Timer;
  end;
  MsgBox(Text, mbInformation, MB_OK);
  wnd:= 0;
  btn:= 0;
  tmr.Free;
end;

procedure InitializeWizard;
begin
  MsgBoxTimeOut('Текст', 3, true);
end;
 

Krinkels

Он где то тут
Администратор
В: Как прочитать свойство файла(Например его версию, или описание, или копирайты)?
О: Можно так:
code_language.pascal:
[Setup]
AppName=My Application
AppVersion=1.5
CreateAppDir=no

[Code]
const
  GET_COMMENT = 'Comments';
  GET_COMPANY = 'CompanyName';
  GET_DESCRIPTION = 'FileDescription';
  GET_FILEVERSION = 'FileVersion';
  GET_COPYRIGHT = 'LegalCopyright';
  GET_PRODUCTNAME = 'ProductName';
  GET_PRODUCTVERSION = 'ProductVersion';

function GetFileVersionInfoSize(lptstrFilename: String; lpdwHandle: Integer): Integer;
  external 'GetFileVersionInfoSizeW@version.dll stdcall delayload';

function GetFileVersionInfo(
  lptstrFilename: String; dwHandle, dwLen: Integer; var lpData: Byte): Boolean;
  external 'GetFileVersionInfoW@version.dll stdcall delayload';

function VerQueryValue(
  var pBlock: Byte; lpSubBlock: String; var lplpBuffer: DWord;
  var Len: Integer): Boolean;
  external 'VerQueryValueW@version.dll stdcall delayload';

procedure RtlMoveMemoryAsString(Dest: string; Source: DWord; Len: Integer);
  external 'RtlMoveMemory@kernel32.dll stdcall';

procedure RtlMoveMemoryAsBytes(Dest: array of Byte; Source: DWord; Len: Integer);
  external 'RtlMoveMemory@kernel32.dll stdcall';

function GetFileVerInfo(FileName, VerName: String): String;
var
  Len: Integer;
  FileVerInfo: array of Byte;
  Lang: array of Byte;
  Buffer: DWord;
  LangCodepage: string;
  SubBlock: string;
begin
  Result := '';
  if FileExists(FileName) then
  begin
    Len := GetFileVersionInfoSize(FileName, 0);
    if Len > 0 then
    begin
      SetArrayLength(FileVerInfo, Len);
      if GetFileVersionInfo(FileName, 0, Len, FileVerInfo[0]) then
      begin
        if VerQueryValue(FileVerInfo[0], '\VarFileInfo\Translation', Buffer, Len) then
        begin
          if Len >= 4 then
          begin
            SetArrayLength(Lang, 4);
            RtlMoveMemoryAsBytes(Lang, Buffer, 4);
            LangCodepage :=
              Format('%.2x%.2x%.2x%.2x', [Lang[1], Lang[0], Lang[3], Lang[2]]);
            SubBlock := Format('\%s\%s\%s', ['StringFileInfo', LangCodepage, VerName]);
            if VerQueryValue(FileVerInfo[0], SubBlock, Buffer, Len) then
            begin
              SetLength(Result, Len - 1);
              RtlMoveMemoryAsString(Result, Buffer, (Len - 1) * 2);
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure InitializeWizard;
var
  Test: String;
begin
  Test := GetFileVerInfo(ExpandConstant('{src}\MYEXE.exe'), GET_COMMENT );
  MsgBox(Test, mbInformation, MB_OK);
end;
 
Последнее редактирование:

Yaroslav950

Участник
В: Как добавить своё лого на форму c выводом на сайт(4 способа png, bmp)?
О: Так:
Распаковывайте через Winrar. Там будут примеры.
 

Вложения

Последнее редактирование:

Yaroslav950

Участник
В: Как добавить свое видео на форму + расположение его на определенных страницах?
О: Так:
P.S. Наверное работает только на avi форматах.
 

Вложения

Последнее редактирование:
Сверху