求哪位坛友帮忙完善地雷战Inno Setup美化安装包界面脚本，谢谢。

wtang0429 · 发表于 2021-4-28 16:55

地雷战Inno Setup美化安装包界面脚本

链接: https://caiyun.139.com/m/i?145Clb8WxDwr9
提取码：KvWL

麻烦哪位坛友有空时帮忙修改一下这个地雷战Inno Setup美化安装包界面脚本为什么打包的组件选择安装包安装界面没有出现组件选择界面？谢谢。

还有这个地雷战根据系统简繁英日自动选择语言退出提示字安装包美化代码如何设置代码打包的组件选择安装包在组件选择好后在安装开始时自动隐藏或者手动隐藏组件选择界面看完整安装画面，谢谢。

wtang0429 · 发表于 2021-4-28 16:53

本帖最后由 wtang0429 于 2024-1-23 23:25 编辑

地雷战Inno Setup美化安装包界面脚本

; Script generated by the Inno Setup Script Wizard.
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!

#define MyAppName "地雷战中文版"
#define MyAppVersion "1.6.1.0"
#define MyAppPublisher "wtang0429"
#define MyAppURL "www.linxinfa.game"
; #define MyCopyright "wtang0429所有"
#define MyAppPkgDir1 ".\pkgs\v1"
#define MyAppPkgDir2 ".\pkgs\v2"
#define MyAppExeName "DLZ.exe"

; 生成目录setup.exe 所在文件夹
#define MySetupOutDir ".\output"
#define MySetupOutBaseFilename "地雷战中文版_setup"

; 制作setup.exe所用的资源文件夹
#define MyResDir ".\res"
; 在注册表上记录上一次安装的位置
#define MyRegInstallPath_sk "Software\我的应用\linxinfa\install"
#define MyRegInstallPath_vn "installPath"
; 点击license 打开的网页连接
#define MyAppLkLicenseURL 'http://www.linxinfa.game/rule.html'
; 安装目录至少需要的空间 100; 100 MB，TODO 要获取一些Minisize 之类的来计算，这里先写死
#define MyAppNeedSpaceByte 100
; 外部程序调用本setup.exe时，会向外部传安装进度的window api Message ID
#define WM_MY_INSTALL_PROGRESS 6364
; 安装时显示进度条，背景切换图的，图片数
#define InsBgAniPicCount 5

[Setup]
; NOTE: The value of AppId uniquely identifies this application.
; Do not use the same AppId value in installers for other applications.
; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)
AppId=123456789
AppName={#MyAppName}
AppVersion={#MyAppVersion}
;AppVerName={#MyAppName} {#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}

VersionInfoDescription={#MyAppName}安装程序
VersionInfoCompany={#MyAppPublisher}
VersionInfoVersion={#MyAppVersion}
VersionInfoProductVersion={#MyAppVersion}
;VersionInfoCopyright={#MyCopyright}

;DefaultDirName={pf}\{#MyAppName}
DefaultDirName=C:\ANTI-JAP
DefaultGroupName={#MyAppName}
LicenseFile={#MyResDir}\License.txt
OutputDir={#MySetupOutDir}
OutputBaseFilename={#MySetupOutBaseFilename}
SetupIconFile={#MyResDir}\SetupIcon.ico
Compression=lzma2/ultra64
SolidCompression=yes

UsePreviousAppDir=no
;管理员权限
PrivilegesRequired=admin

;先让一些默认的界面不要显示
DisableReadyPage=yes
;DisableProgramGroupPage=yes
;DirExistsWarning=no
DisableWelcomePage=no
DisableDirPage=no

[Languages]
Name: "chs"; MessagesFile: "compiler:Languages\ChineseSimp.isl"

[Types]
Name: full; Description: 标准安装
Name: compact; Description: 完全安装
Name: custom; Description: 自定义安装; Flags: iscustom

[Components]
Name: a1; Description: "地雷战主程序"; Flags: fixed; Types: custom compact full
Name: a2; Description: "地雷战ddraw版";Types: custom; Flags: exclusive;

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

; 互斥可选安装组件示例
[Files]
Source: "{#MyResDir}\tmp\*"; DestDir: "{tmp}"; Flags: dontcopy solidbreak ; Attribs: hidden system
Source: "{#MyAppPkgDir1}\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs; Components: a1
Source: "{#MyAppPkgDir2}\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs; Components: a2
;Source: "..\..\test_prj\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs
;Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy

; NOTE: Don't use "Flags: ignoreversion" on any shared system files

; 随组件安装与否决定是否建立快捷方式示例
[Icons]
Name: "{group}\地雷战"; Filename: "{app}\DLZ.exe";WorkingDir: "{app}";Components: a1;
Name: "{group}\{cm:UninstallProgram,地雷战}"; Filename: "{uninstallexe}";WorkingDir: "{app}";
Name: "{commondesktop}\地雷战"; Filename: "{app}\DLZ.exe";WorkingDir: "{app}";Components: a1;

[Run]
Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: runascurrentuser nowait postinstall skipifsilent

;[UninstallRun]
;Filename: http://happyfish.lkgame.com/uninstallsurvey; Flags: shellexec runmaximized; Tasks: ; Languages:

[Registry]
Root:HKCU;Subkey: "{#MyRegInstallPath_sk}" ; ValueType:string; ValueName:"{#MyRegInstallPath_vn}"; ValueData:"{app}";Flags:uninsdeletekeyifempty

[Code]
#include "DllsImport.iss"
#include "HoverEvent.iss"
#include "SetupMisc.iss"

var
  g_notifyWnd : HWND;             // 发送通知的回调窗口
  g_notifyFinished : Boolean;    // 是否已经发送结束消息？

var
  dNeedSpaceByte:Longint; //需要的安装的空间大小，（字节)
  PBOldProc:Longint;
  imgBg1, imgBg2 :Longint;
  btnClose, btnMin:HWND;

  DpiScalePctg:integer;
  CurrentDPI:integer;

  // page welcome
  btnOneKey,btnCustomInstall:HWND;
  chkLicense:HWND;
  lblLicense,lblWelcome,lblAgree:TLabel;
  imgBigIcon1, imgLogo1, imgOneKeySh:Longint;

  // page select dir
  btnSelectDir1,btnNext1,btnBack1:HWND;
  edtSelectDir1:TEdit;
  chkQuickLaunch:HWND;  // 快速启动栏 (check box )
  lblQuickLaunch:TLabel;// 快速启动栏 (上面的label)
  lblNeedSpace, lblDiskSpace,lblTipWDir :TLabel;

  isSelectedQuickLaunch:boolean;

  // page install
  imgProgressBar, imgProgressBarBg:Longint; //进度条
  lblTipProgress :TLabel;

  // page finish;
  btnFinish:HWND;

var
  PageStateLbl1,PageStateLbl2,PageStateLbl3, PageStateLblK1,PageStateLblK2: TLabel;

procedure ShoutcutRunAsAdmin(Filename:string);
var
  Buffer:String;
  Stream:TStream;
begin
  Filename := ExpandConstant(Filename);
  //Log(Format('ShoutcutRunAsAdmin File=%s )',[Filename]))
  Stream:=TFileStream.Create(FileName,fmOpenReadWrite);
  try
Stream.Seek(21,soFromBeginning);
SetLength(Buffer, 1)
Stream.ReadBuffer(Buffer,1);
Buffer[1] := Chr(Ord(Buffer[1]) or $20);
Stream.Seek(-1, soFromCurrent);
Stream.WriteBuffer(Buffer, 1);
  finally
Stream.Free;
  end;
end;

function DpiScale(v:integer):integer;
begin
  Result:=v*DpiScalePctg/1000;
end;

function GetCmdlineParam(PName:String):String;
var
  CmdLine : String;
  CmdLineLen : Integer;
  i : Integer;
begin
  CmdLineLen:=ParamCount();
  for i:=0 to CmdLineLen do
  begin
  CmdLine:=ParamStr(i);
  if CmdLine= PName then
begin
   CmdLine:=ParamStr(i+1);
   Result := CmdLine;
   Exit;
end;
  end;
  Result := '0';
end;

// 获取安装路径，默认在可用空间最大的盘
function GetInstallPath(Param: String):String;
var destDisk ,i: byte;
maxSpace : Cardinal;
tmpFree,tmpTotal : Cardinal;
strPath:String;
begin
  destDisk := 97;
  maxSpace := 0;
  for i := 0 to 25 do
begin
   if  GetSpaceOnDisk(Chr(97+i)+':\', True, tmpFree, tmpTotal) then
   begin
      if maxSpace < tmpFree then
      begin
      maxSpace := tmpFree;
      destDisk := 97+i;
      end
   end
end;
if GetCmdlineParam('-installPath') = '0' then
   begin
      if RegQueryStringValue(HKEY_CURRENT_USER, '{#MyRegInstallPath_sk}', '{#MyRegInstallPath_vn}', strPath) then
      begin
      Result := strPath;
      end
      else
      begin
         Result := Chr(destDisk) + ':\ANTI-JAP' ;
      end
   end
else
   begin
   Result := GetCmdlineParam('-installPath');
   end;
//MsgBox(Result, mbInformation, MB_OK);
end;

procedure Notify_Init();
begin
   g_notifyWnd := FindWindowByWindowName(GetCmdlineParam('-notify_wnd'));
   g_notifyFinished := false;
end;

procedure Notify_DoNotifyProgress( pos, total: Longint);
begin
if g_notifyWnd <> 0 then
begin
   PostMessage(g_notifyWnd, {#WM_MY_INSTALL_PROGRESS}, pos, total );
end;
end;

procedure Notify_DoNotifyFinish();
begin
g_notifyFinished := true;
if g_notifyWnd <> 0 then
begin
   PostMessage(g_notifyWnd, {#WM_MY_INSTALL_PROGRESS}, 10000, 9999);
end;
end;

function PageState_CreateLabel(text:string; x, y:integer):TLabel;
var lbl:TLabel;
begin
  lbl := TLabel.Create(WizardForm);
  with lbl do
  begin
Parent := WizardForm;
Caption := text;
Transparent := true;
Font.Size:= 10;
Font.Name:='微软雅黑';
Font.Color:=$ffffff; //$555555
Left := x;
Top := y;
  end;
  result := lbl;
end;

procedure PageState_Init();
begin
  PageStateLbl1  := PageState_CreateLabel('欢迎' , DpiScale(501), DpiScale(69));
  PageStateLblK1 := PageState_CreateLabel('>'    , DpiScale(532), DpiScale(69));
  PageStateLbl2  := PageState_CreateLabel('下载安装', DpiScale(543), DpiScale(69));
  PageStateLblK2 := PageState_CreateLabel('>'    , DpiScale(598), DpiScale(69));
  PageStateLbl3  := PageState_CreateLabel('完成' , DpiScale(610), DpiScale(69));
end;

procedure SetTLabelBold(lbl:TLabel; isBold:boolean);
begin
if isBold then begin
lbl.Font.Style := lbl.Font.Style + [fsBold];
end else begin
lbl.Font.Style := lbl.Font.Style - [fsBold];
end;
end;

procedure PageState_Set(idx:integer);
begin
  SetTLabelBold(PageStateLbl1, idx = 1);
  SetTLabelBold(PageStateLbl2, idx = 2);
  SetTLabelBold(PageStateLbl3, idx = 3);
end;

procedure TconSetVisible(lbl:TControl; bVis:boolean);
begin
  if bVis then
begin
   lbl.Show;
end
  else
begin
   lbl.Hide;
      end;
end;

procedure BtnClose_OnClick(hBtn:HWND);
begin
  if ExitSetupMsgBox then
  begin
WizardForm.Release;
WizardForm.Close;
// stop and rollback actions you did from your after install
// process and kill the setup process itself
ExitProcess(0);
  end;
end;
procedure btnCustomInstallOnClick(hBtn:HWND);
begin
  WizardForm.NextButton.OnClick(WizardForm);
end;

procedure btnMin_OnClick(hBtn:HWND);
begin
  SendMessage(WizardForm.Handle,WM_SYSCOMMAND,61472,0);
end;

procedure lblLicenseClick(sender :TObject);
var
  ErrorCode: Integer;
begin
  ShellExec('open', '{#MyAppLkLicenseURL}', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;

procedure chkLicenseOnClick(bBtn :HWND);
var
isCheck:boolean;
begin
isCheck := BtnGetChecked(chkLicense);
if isCheck then
begin
         BtnSetEnabled(btnCustomInstall, True);
         BtnSetEnabled(btnOneKey, True);
end
else
begin
   BtnSetEnabled(btnCustomInstall, False);
         BtnSetEnabled(btnOneKey, False);
end;
end;

procedure btnOneKey_OnClick(hBtn:HWND);
begin
  WizardForm.NextButton.OnClick(WizardForm);
  WizardForm.NextButton.OnClick(WizardForm);
end;

procedure OnHoverControlChanged(Control: TControl);
begin
      if lblLicense <> nil then
      begin
            if lblLicense = Control then
            begin
                     lblLicense.Font.Style := lblLicense.Font.Style + [fsUnderline];
            end
            else
            begin
                     lblLicense.Font.Style := lblLicense.Font.Style - [fsUnderline];
            end;
      end ;
end;

procedure InitGui_PageWelcome();
var
  BtnOneKeyFont:TFont;
  tmpFont:TFont;
begin
  chkLicense :=BtnCreate(WizardForm.Handle,DpiScale(33),DpiScale(410),
  DpiScale(15),DpiScale(15), ExpandConstant('{tmp}\check.png'),1, True);
  BtnSetChecked(chkLicense, True);
  BtnSetEvent(chkLicense,BtnClickEventID,WrapBtnCallback(@chkLicenseOnClick,1));

  //btnCustomInstall := BtnCreate(WizardForm.Handle,DpiScale(543),DpiScale(409), DpiScale(87), DpiScale(15), ExpandConstant('{tmp}\btnCustomInstall.png'),1,False)
  //BtnSetEvent(btnCustomInstall,BtnClickEventID,WrapBtnCallback(@btnCustomInstallOnClick,1));
  tmpFont := TFont.Create;
  with tmpFont do begin
Size := 12;
Name :='黑体';
Color:=$986800;
  end;

  btnCustomInstall:=BtnCreate(WizardForm.Handle,DpiScale(540),DpiScale(417),DpiScale(89), DpiScale(30), ExpandConstant('{tmp}\btn.png'), 1, False)
  BtnSetEvent(btnCustomInstall,BtnClickEventID,WrapBtnCallback(@btnCustomInstallOnClick,1));
  BtnSetText(btnCustomInstall, '自定义');
  BtnSetFont(btnCustomInstall, tmpFont.Handle);
  BtnSetFontColor(btnCustomInstall,$986800,$986800,$986800,$AFAFAF);

  btnOneKey:=BtnCreate(WizardForm.Handle,DpiScale(240),DpiScale(260),DpiScale(177), DpiScale(43), ExpandConstant('{tmp}\btnOneKeyInstall.png'),1,False)

  BtnSetText(btnOneKey, '一键安装');
  BtnOneKeyFont := TFont.Create;
  with BtnOneKeyFont do begin
      Size := 20;
      Name:='黑体';
      Color:=$ffffff;
  end;
  BtnSetFont(btnOneKey, BtnOneKeyFont.Handle);
  BtnSetFontColor(btnOneKey,$FAFAFA,$FFFFFF,$FFFFFF,$FFFFFF);
  BtnSetEvent(btnOneKey,BtnClickEventID,WrapBtnCallback(@btnOneKey_OnClick,1));

  lblWelcome := TLabel.Create(WizardForm);
  with lblWelcome do
  begin
Parent := WizardForm;
Caption := '欢迎安装地雷战中文版应用程序';
Transparent := true;
Font.Size:= 20
Font.Name:='黑体'
Font.Color:=$ffffff
Left := DpiScale(190);
Top := DpiScale(195);
  end;

  lblAgree := TLabel.Create(WizardForm);
  with lblAgree do
  begin
Parent := WizardForm;
Caption := '我已阅读并同意';
Transparent := true;
Font.Size:= 10
Font.Name:='微软雅黑'
Font.Color:=$ffffff
Left := DpiScale(50);
Top := DpiScale(408);
  end;

  lblLicense := TLabel.Create(WizardForm);
  with lblLicense do
  begin
Parent := WizardForm;
Caption := '《应用许可协议》';
Transparent := true;
Font.Size:= 10
Font.Name:='微软雅黑'
Font.Color:=$ffffff
Left:= DpiScale(143);
Top := DpiScale(408);
OnClick:=@lblLicenseClick;
Cursor:=crHand;
  end;
  HoverEvent_Init(@OnHoverControlChanged);
end;

function GetNeedSpaceText():string;
var
  iv:string;
begin
  iv:= Misc_FomatByteText(dNeedSpaceByte*1024*1024);
  result:=format('所需要磁盘空间：%s',[iv]);
end;

function GetCurDirFreeSpace():Cardinal;
var
curPath:string;
FreeSpace,TotalSpace:Cardinal;
begin
  curPath := edtSelectDir1.Text;
  GetSpaceOnDisk(ExtractFileDrive(curPath),True,FreeSpace,TotalSpace);
  result := FreeSpace;
end;

function GetDiskSpaceText(FreeSpace:Cardinal):string;
var
  iv:string;
begin

  if FreeSpace > 1024 then
  begin iv := Format('%.0f GB',[FreeSpace/1024.0 ]) ;
  end
  else
  begin iv := Format('%d MB',[FreeSpace]);
  end;
  result:=format('可用磁盘空间：%s',[iv]);
end;

procedure WhenInstallDirChangeCheckDiskSpace();
var
  FreeSpace:Cardinal;
begin
  FreeSpace := GetCurDirFreeSpace();
  lblNeedSpace.Caption := GetNeedSpaceText();
  lblDiskSpace.Caption := GetDiskSpaceText(FreeSpace);
  TconSetVisible(lblTipWDir, (WizardForm.CurPageID = wpSelectDir) and (FreeSpace <= 0) );
end;

procedure EdtSelectDir1_EditChanged(Sender: TObject);
begin
  WizardForm.DirEdit.Text:=edtSelectDir1.Text;
  WhenInstallDirChangeCheckDiskSpace();
end;

procedure BtnSelectDir1_OnClick(hBtn:HWND);
begin
  WizardForm.DirBrowseButton.OnClick(WizardForm);
  edtSelectDir1.Text:=WizardForm.DirEdit.Text;
  WhenInstallDirChangeCheckDiskSpace();
end;
procedure BtnNext1_OnClick(hBtn:HWND);
var
  FreeSpace:Cardinal;
begin
  //检查一下有否有空间
  FreeSpace := GetCurDirFreeSpace();
  if FreeSpace <= 0 then
  begin
msgbox('该目录为无效路径，请重新选择其他路径', mbInformation,MB_OK);
exit;
  end;
  Log(Format('FreeSpace %d, Need:%d', [FreeSpace,  dNeedSpaceByte] ));
  if FreeSpace  < dNeedSpaceByte then
  begin
msgbox('该目录所在磁盘空间不足，请重新选择其他路径', mbInformation,MB_OK);
exit;
  end;
  WizardForm.NextButton.OnClick(WizardForm);
end;
procedure BtnBack1_OnClick(hBtn:HWND);
begin
  WizardForm.BackButton.OnClick(WizardForm);
end;

procedure chkQuickLaunch_OnClick(bBtn :HWND);
begin
isSelectedQuickLaunch := BtnGetChecked(chkQuickLaunch);
end;

procedure InitGui_PageSelectDir();
var
  tmpFont:TFont;
begin

  edtSelectDir1 := TEdit.Create(WizardForm);
  with edtSelectDir1 do
  begin
Parent:= WizardForm;
Text := WizardForm.DirEdit.Text;
Font.Size:= 10
Font.Color:=$555555
Left:= DpiScale(132);
Top := DpiScale(189);
Width:= DpiScale(311);
Height:= DpiScale(24);
BorderStyle:=bsNone;
TabStop := false;
OnChange:=@EdtSelectDir1_EditChanged;
  end;

  btnSelectDir1:=BtnCreate(WizardForm.Handle,DpiScale(452),DpiScale(185),DpiScale(89), DpiScale(30), ExpandConstant('{tmp}\btn.png'), 1, False)
  BtnSetEvent(btnSelectDir1,BtnClickEventID,WrapBtnCallback(@BtnSelectDir1_OnClick,1));
  BtnSetText(btnSelectDir1, '浏览');
  tmpFont := TFont.Create;
  with tmpFont do begin
Size := 12;
Name :='黑体';
Color:=$986800;
  end;
  BtnSetFont(btnSelectDir1, tmpFont.Handle);
  BtnSetFontColor(btnSelectDir1,$986800,$986800,$986800,$AFAFAF);

  btnNext1:=BtnCreate(WizardForm.Handle,DpiScale(550),DpiScale(417),DpiScale(89), DpiScale(30), ExpandConstant('{tmp}\btn.png'), 1, False)
  BtnSetEvent(btnNext1,BtnClickEventID,WrapBtnCallback(@BtnNext1_OnClick,1));
  BtnSetText(btnNext1, '下一步');
  BtnSetFont(btnNext1, tmpFont.Handle);
  BtnSetFontColor(btnNext1,$986800,$986800,$986800,$AFAFAF);

  btnBack1:=BtnCreate(WizardForm.Handle,DpiScale(460),DpiScale(417),DpiScale(89), DpiScale(30), ExpandConstant('{tmp}\btn.png'), 1, False)
  BtnSetEvent(btnBack1,BtnClickEventID,WrapBtnCallback(@BtnBack1_OnClick,1));
  BtnSetText(btnBack1, '上一步');
  BtnSetFont(btnBack1, tmpFont.Handle);
  BtnSetFontColor(btnBack1,$986800,$986800,$986800,$AFAFAF);

  isSelectedQuickLaunch := True
  chkQuickLaunch :=BtnCreate(WizardForm.Handle,DpiScale(133),DpiScale(261),DpiScale(15),DpiScale(15), ExpandConstant('{tmp}\check.png'),1, True);
  BtnSetChecked(chkQuickLaunch, isSelectedQuickLaunch);
  BtnSetEvent(chkQuickLaunch,BtnClickEventID,WrapBtnCallback(@chkQuickLaunch_OnClick,1));

  lblQuickLaunch := TLabel.Create(WizardForm);
  with lblQuickLaunch do
  begin
Parent := WizardForm;
Caption := '快速启动栏';
Transparent := true;
Font.Size:= 10
Font.Name:='微软雅黑'
Font.Color:=$ffffff
Left := DpiScale(150);
Top := DpiScale(259);
  end;

  lblNeedSpace := TLabel.Create(WizardForm);
  with lblNeedSpace do
  begin
Parent := WizardForm;
Caption := '';
Transparent := true;
Font.Size:= 10
Font.Name:='微软雅黑'
Font.Color:=$ffffff
Left := DpiScale(130);
Top := DpiScale(228);
  end;

  lblDiskSpace := TLabel.Create(WizardForm);
  with lblDiskSpace do
  begin
Parent := WizardForm;
Caption := '';
Transparent := true;
Font.Size:= 10
Font.Name:='微软雅黑'
Font.Color:=$ffffff
Left := DpiScale(320);
Top := DpiScale(228);
  end;

  lblTipWDir := TLabel.Create(WizardForm);
  with lblTipWDir do
  begin
Parent := WizardForm;
Caption := '该目录为无效路径，请重新选择其他路径';
Transparent := true;
Font.Size:= 10
Font.Name:='微软雅黑'
Font.Color:=$000099
Left := DpiScale(129);
Top := DpiScale(167);
  end;
  WhenInstallDirChangeCheckDiskSpace();
end;

Const
  InsBgAni_HoldTime = 5000;
  InsBgAni_SwitchTime = 500;
  InsBgAni_ImgCount = {#InsBgAniPicCount};
var
  InsBgAni_ImgArr : array[0 .. InsBgAni_ImgCount ] of Longint;
  InsBgAni_Time : Longint;

procedure PageInstall_TimerProc(H: LongWord; Msg: LongWord; IdEvent: LongWord; Time: LongWord);
var
  allAniTime, i, idx, nIdx, t0, t1, alpha:Longint;
  tImg :Longint;
begin
  if InsBgAni_Time >= 0 then
  begin
allAniTime := (InsBgAni_HoldTime + InsBgAni_SwitchTime) * InsBgAni_ImgCount;


InsBgAni_Time := (InsBgAni_Time + 50) mod allAniTime;

      idx := InsBgAni_Time div (InsBgAni_HoldTime + InsBgAni_SwitchTime);
  t0 := InsBgAni_Time mod (InsBgAni_HoldTime + InsBgAni_SwitchTime);
      if t0 < InsBgAni_HoldTime then
      begin
            for i:= 0 to InsBgAni_ImgCount do
            begin
               tImg :=InsBgAni_ImgArr
               if i = idx then
               begin
                     ImgSetTransparent(tImg, 255);
               end
               else
                     ImgSetTransparent(tImg, 0);
            end;
      end
      else
      begin
      alpha := (t0 -InsBgAni_HoldTime) *255 / InsBgAni_SwitchTime;
nIdx := (Idx + 1) mod  InsBgAni_ImgCount;
      for i:= 0 to InsBgAni_ImgCount do
            begin
               tImg :=InsBgAni_ImgArr
               if i = idx then
               begin
                  ImgSetTransparent(tImg, 255-alpha);
               end
               else if i = nIdx then
               begin
                  ImgSetTransparent(tImg, alpha);
               end
               else
               begin
                  ImgSetTransparent(tImg, 0);
               end;
            end;
      end;
ImgApplyChanges(WizardForm.Handle);
  end;
end;

procedure PageInstall_SetProgress(pr:Extended);
var
  w:longint;
begin
  w:=Round(577*pr/100);
  ImgSetPosition(imgProgressBar, DpiScale(38), DpiScale(429), DpiScale(w),DpiScale(29));
  ImgSetVisiblePart(imgProgressBar,0,0, w, 29);
  ImgApplyChanges(WizardForm.Handle);
  lblTipProgress.Caption := Format('正在为您安装 %d%%',[Round(pr)]);
end;

procedure InitGui_PageInstall();
var
  tmpFont:TFont;
begin

  imgProgressBarBg:=ImgLoad(WizardForm.Handle,ExpandConstant('{tmp}\progressBg.png'), 0,0,0,0,True,True);
  ImgSetPosition(imgProgressBarBg, DpiScale(38), DpiScale(429), DpiScale(577),DpiScale(19));
  imgProgressBar:=ImgLoad(WizardForm.Handle,ExpandConstant('{tmp}\progress.png'),0,0,0,0,True,True);

  lblTipProgress := TLabel.Create(WizardForm);
  with lblTipProgress do
  begin
Parent := WizardForm;
Caption := '正在为您安装';
Transparent := true;
Font.Size:= 10;
Font.Name:='微软雅黑';
Font.Color:=$ffffff;
Left := DpiScale(275);
Top := DpiScale(400);
  end;

  InsBgAni_Time := -1;//Stop ani;
  SetTimer(0, 0, 50, WrapTimerProc(@PageInstall_TimerProc, 4));
end;

procedure btnFinish_OnClick(hBtn:HWND);
begin
  WizardForm.NextButton.OnClick(WizardForm);
end;

procedure InitGui_PageFinish();
var
tmpFont:TFont;
begin
  btnFinish:=BtnCreate(WizardForm.Handle, DpiScale(240), DpiScale(404), DpiScale(177),DpiScale(43), ExpandConstant('{tmp}\btnOneKeyInstall.png'),1,False)
  BtnSetText(btnFinish, '完成安装');
  tmpFont := TFont.Create;
  with tmpFont do begin
      Size := 20;
      Name:='黑体';
      Color:=$000000;
  end;
  BtnSetFont(btnFinish, tmpFont.Handle);
  BtnSetFontColor(btnFinish,$FAFAFA,$FFFFFF,$FFFFFF,$FFFFFF);
  BtnSetEvent(btnFinish,BtnClickEventID,WrapBtnCallback(@btnFinish_OnClick,1));
end;

procedure SetTaskValueByDesc(desc:string; value:boolean);
var tmpInx:integer;
begin
tmpInx := WizardForm.TasksList.Items.IndexOf(desc);
if tmpInx <> -1 then
begin
   Log(Format('CurPageID = wpInstalling | set quicklaunchicon = %d ', [ value ] ));
   WizardForm.TasksList.Checked[tmpInx] := value;
end;
end;

//页面发生变化
procedure CurPageChanged(CurPageID: Integer);
var
  isWpWelcome,isWpSelectDir,isWpInstalling,isWpFinished : boolean;
  nErrCode:integer;
  i:integer;
begin
  Log(format( 'CurPageID id = %d',[ CurPageID ]));
  isWpWelcome := CurPageID = wpWelcome;
  isWpSelectDir  := CurPageID = wpSelectDir;
  isWpInstalling := CurPageID = wpInstalling;
  isWpFinished := CurPageID = wpFinished;

  BtnSetEnabled(btnClose, isWpWelcome or isWpSelectDir);

  BtnSetVisibility(btnOneKey,    isWpWelcome);
  BtnSetVisibility(btnCustomInstall, isWpWelcome);
  BtnSetVisibility(chkLicense,    isWpWelcome);
  ImgSetVisibility(imgBigIcon1,    isWpWelcome);
  ImgSetVisibility(imgOneKeySh,    isWpWelcome);
  TconSetVisible(lblAgree,       isWpWelcome);
  TconSetVisible(lblWelcome,       isWpWelcome);
  TconSetVisible(lblLicense,       isWpWelcome);

  ImgSetVisibility(imgBg1, isWpWelcome or isWpSelectDir);
  ImgSetVisibility(imgLogo1, isWpWelcome or isWpSelectDir);

  TconSetVisible(edtSelectDir1, isWpSelectDir);
  TconSetVisible(lblQuickLaunch,  isWpSelectDir);
  TconSetVisible(lblNeedSpace, isWpSelectDir);
  TconSetVisible(lblDiskSpace, isWpSelectDir);
  TconSetVisible(lblTipWDir,    false);
  BtnSetVisibility(btnSelectDir1, isWpSelectDir);
  BtnSetVisibility(btnNext1,    isWpSelectDir);
  BtnSetVisibility(btnBack1,    isWpSelectDir);
  BtnSetVisibility(chkQuickLaunch,isWpSelectDir);

  for i := 1 to InsBgAni_ImgCount do
   ImgSetVisibility(InsBgAni_ImgArr[i-1], isWpInstalling);
  ImgSetVisibility(imgProgressBar, isWpInstalling);
  ImgSetVisibility(imgProgressBarBg, isWpInstalling);
  TconSetVisible(lblTipProgress,    isWpInstalling);

  ImgSetVisibility(imgBg2, isWpFinished);
  BtnSetVisibility(btnFinish, isWpFinished);

  if CurPageID = wpWelcome then
  begin
//Log('CurPageID = wpWelcome');
PageState_Set(1);
  end;

  if CurPageID = wpSelectDir then
  begin
//Log('CurPageID = wpSelectDir');
//Log(WizardForm.DiskSpaceLabel.Caption);
      edtSelectDir1.Text:=WizardForm.DirEdit.Text;
//Misc_SetTEdit_TextVCenter(edtSelectDir1);
WhenInstallDirChangeCheckDiskSpace();
//WizardForm.DiskSpaceLabel.Visible:=True;
PageState_Set(1);
  end;

  if isWpInstalling then
  begin
SetTaskValueByDesc('quicklaunchicon', isSelectedQuickLaunch);

Notify_Init();
PageState_Set(2);
InsBgAni_Time := 1;
  end
  else
  begin
InsBgAni_Time := 0;
  end;

  if isWpFinished then
  begin
//Log('CurPageID = wpFinished');
PageState_Set(3);

ShellExec('taskbarpin', '{app}\{#MyAppExeName}', '', '', SW_SHOWNORMAL, ewNoWait, nErrCode);
Notify_DoNotifyFinish();
  end;

  ImgApplyChanges(WizardForm.Handle);
end;

function PBProc(h:hWnd;Msg,wParam,lParam:Longint):Longint;
var
  pr, pos,total: Longint;
  w : integer;
begin
  Result:=CallWindowProc(PBOldProc,h,Msg,wParam,lParam);
  if (Msg=$402) and (WizardForm.ProgressGauge.Position>WizardForm.ProgressGauge.Min) then
  begin
pos:=WizardForm.ProgressGauge.Position-WizardForm.ProgressGauge.Min;
total:=WizardForm.ProgressGauge.Max-WizardForm.ProgressGauge.Min;
pr:=pos*100/total;
PageInstall_SetProgress(pr);
Notify_DoNotifyProgress(pos, total);
  end;
end;

procedure InitializeWizard();
var
  winW:integer;
  winH:integer;
  i:integer;
begin
  CurrentDPI  := WizardForm.Font.PixelsPerInch;
  DpiScalePctg  := 1000* CurrentDPI / 96;

  winW:=DpiScale(660)
  winH:=DpiScale(480)

  WizardForm.InnerNotebook.Hide;
  WizardForm.OuterNotebook.hide;
  WizardForm.BorderStyle:=bsNone;
  WizardForm.Position:=poDesktopCenter;

  WizardForm.Width:=winW;
  WizardForm.Height:=winH;
  WizardForm.Color:=clWhite ;

  WizardForm.Bevel.Hide;
  WizardForm.NextButton.Width:=0;
  WizardForm.BackButton.Width:=0;
  WizardForm.CancelButton.Width:=0;

  Misc_SetFormRoundRectRgn(WizardForm, 20);//圆角
  Misc_SetForm_Dragable(WizardForm);

  dNeedSpaceByte := {#MyAppNeedSpaceByte}

  //WizardForm.ComponentsDiskSpaceLabel.Left := 0;
  //WizardForm.ComponentsDiskSpaceLabel.Top := 100;
  //WizardForm.ComponentsList.Visible := True;
  //WizardForm.ComponentsDiskSpaceLabel.Visible := True;

  // 将tmp的资源，解压到安装运行时搞出来的临时目录
  ExtractTemporaryFile('bg.png');
  ExtractTemporaryFile('bg2.png');
  ExtractTemporaryFile('btclose.png');
  ExtractTemporaryFile('btmin.png');
  ExtractTemporaryFile('btn.png');
  ExtractTemporaryFile('btnOneKeyInstall.png');
  ExtractTemporaryFile('check.png');
  ExtractTemporaryFile('progress.png');
  ExtractTemporaryFile('progressBg.png');

  for i := 1 to InsBgAni_ImgCount do
ExtractTemporaryFile(Format('pic%d.png',) );

  imgBg1 := ImgLoad(WizardForm.Handle,ExpandConstant('{tmp}\bg.png'),(0),(0),winW,winH,True,True);
  imgBg2 := ImgLoad(WizardForm.Handle,ExpandConstant('{tmp}\bg2.png'),(0),(0),winW,winH,True,True);
  ImgSetVisibility(imgBg2,false);

  for i := 1 to InsBgAni_ImgCount do
  begin
InsBgAni_ImgArr[i-1] := ImgLoad( WizardForm.Handle, ExpandConstant(Format('{tmp}\pic%d.png',)),(0),(0), winW, winH,True,True);
ImgSetVisibility(InsBgAni_ImgArr[i-1],false);
  end;

  btnClose:= BtnCreate(WizardForm.Handle, DpiScale(617), DpiScale(2), DpiScale(39),DpiScale(19), ExpandConstant('{tmp}\btclose.png'),1,False)
  BtnSetEvent(btnClose,BtnClickEventID,WrapBtnCallback(@BtnClose_OnClick,1));

  btnMin:=BtnCreate(WizardForm.Handle,DpiScale(585),DpiScale(2),DpiScale(39),DpiScale(19),ExpandConstant('{tmp}\btmin.png'),1,False)
  BtnSetEvent(btnMin,BtnClickEventID,WrapBtnCallback(@btnMin_OnClick,1));

  InitGui_PageWelcome();
  InitGui_PageSelectDir();
  InitGui_PageInstall();
  InitGui_PageFinish();

  PageState_Init();

  PBOldProc:=SetWindowLong(WizardForm.ProgressGauge.Handle,-4,PBCallBack(@PBProc,4));

  ImgApplyChanges(WizardForm.Handle);

  CurPageChanged(WizardForm.CurPageID);
end;

function ShouldSkipPage(PageID: Integer): Boolean;
begin
// wpWelcome, wpLicense, wpPassword, wpInfoBefore, wpUserInfo, wpSelectDir, wpSelectComponents, wpSelectProgramGroup, wpSelectTasks, wpReady, wpPreparing, wpInstalling, wpInfoAfter, wpFinished
  case PageID of
wpWelcome:          result:=false;
wpLicense:          result:=true;
wpPassword:          result:=true;
wpInfoBefore:       result:=true;
wpUserInfo:          result:=true;
wpSelectDir:          result:=false;
wpSelectComponents: result:=true;
wpSelectProgramGroup:  result:=true;
wpSelectTasks:       result:=true;
wpReady:             result:=true;
wpPreparing:          result:=true;
wpInstalling:       result:=false;
wpInfoAfter:          result:=true;
wpFinished:          result:=false;
  else  result:=true;
  end;
end;

procedure DeinitializeSetup();
begin
gdipShutdown;
if PBOldProc<>0 then SetWindowLong(WizardForm.ProgressGauge.Handle,-4,PBOldProc);
end;

wtang0429 · 发表于 2021-4-28 16:56

地雷战Inno Setup美化安装包界面脚本

地雷战根据系统简繁英日自动选择语言退出提示字安装包美化代码

wtang0429 · 发表于 2021-4-28 18:49

Inno美化安装包脚本1在选择安装Inno Setup5.6.1版工具界面选择 unicode 版本安装

Inno美化安装包脚本1安装Inno Setup5.6.1版图

wtang0429 · 发表于 2021-4-28 18:59

Inno美化安装包脚本1安装速度快很多就是不清楚什么原因没有出现组件选择界面截图：

Inno美化安装包脚本2安装速度慢很多就是不清楚如何设置代码打包的组件选择安装包在组件选择好后在安装开始时自动隐藏或者手动隐藏组件选择界面看完整安装画面截图：

leening · 发表于 2024-1-23 16:32

你不懂代码根本自己弄不了，模板就这么设计的，没给接口。要不自己添加，要不找个别的模板自己改。这个模板我也有

huge_nebula · 发表于 2024-1-23 17:32

我的妈类，这是个啥，这还不够美的么

楼主有安装包么

wtang0429 · 发表于 2024-1-24 21:59

本帖最后由 wtang0429 于 2024-2-7 19:54 编辑

huge_nebula 发表于 2024-1-23 17:32
我的妈类，这是个啥，这还不够美的么

楼主有安装包么

地雷战美化安装包不好发的，3DM论坛现在不能发任何国产游戏了。

[求助] 求哪位坛友帮忙完善地雷战Inno Setup美化安装包界面脚本，谢谢。

评分

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

评分