PDA

Показать полную графическую версию : Скрипты Inno Setup. Помощь и советы [часть 9]


Страниц : 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 [55] 56 57

Dodakaedr
01-08-2024, 21:05
proffbik, Для этого нужно задействовать секцию [Icons].

proffbik
01-08-2024, 23:01
proffbik, Для этого нужно задействовать секцию [Icons]. »

Благодарю. Могу ли услышать подробнее для более четкого понимания? Если есть пример кода, то был бы очень признателен

[Icons]
Name: "{group}\{#MyAppNameIcon}"; Filename: "{app}\{#MyAppExeName}"; WorkingDir: "{app}"; IconFilename: "{app}\game.ico"
Name: "{commondesktop}\{#MyAppNameIcon}"; Filename: "{app}\{#MyAppExeName}"; WorkingDir: "{app}"; IconFilename: "{app}\game.ico"; Tasks: desktopicon
Name: "{commonappdata}\Microsoft\Internet Explorer\Quick Launch\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: quicklaunchicon

Flix
02-08-2024, 10:15
При создании скрипта через wizard, отмечаю "Разрешить пользователю отключить создание папки в меню пуск". В итоге этот выбор не предоставляется пользователю при установке. Помогите люди добрые) »
Проверь наличие и значение в сценарии директивы AllowNoIcons (https://leserg73.github.io/InnoHelp/ishelp/htm/topic_setup_allownoicons.htm).
Должно быть AllowNoIcons=yes

proffbik
02-08-2024, 23:44
Проверь наличие и значение в сценарии директивы AllowNoIcons.
Должно быть AllowNoIcons=yes »

Благодарю. Решил проблему тем, что скачал версию 5.5.9 unicode и в ней как раз таки высветилась эта строчка AllowNoIcons=yes. А в более новых версиях она почему то не прикрепляется визардом)

proffbik
06-08-2024, 13:04
Приветствую, друзья!

Хочу сделать закрепление иконки на панели задач, испробовал все скрипты выложенные в интернете (От Эль Санчеза и т.п.). Ничего из этого не работает. Есть варианты сделать это?

ZVSRus
11-08-2024, 13:34
Ничего из этого не работает. Есть варианты сделать это?


Примеры от El Sanchez все рабочие. Фуфло никто выкладывать не будет!.

lmiol
12-08-2024, 10:10
Ребята, всем привет. Такая проблема

создал батник, который запускаю вручную -- реестр успешно считывается
если запускаю этот же батник через [run] секцию уже в созданном Inno Setup приложении, то исполняется весь код успешно, кроме чтения реестра

Батник делает простое
Смотрит в реестре путь к игре и если есть потом пишет его в файл.
Писать в файл он может всё что угодно через Inno Setup (это проверено и работает)

Короче вот 2 варианта кода чтения ресстра (которые, повторюсь, рабочие и работают если их запускать вручную, но не хотят если запускать из Inno Setup в любом виде)
rem Получаем путь к установке Brawlhalla из реестра
for /f "tokens=2*" %%a in ('reg query "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Steam App 291550" /v "InstallLocation"') do (
set "registry=%%b"
)

powershell -Command "& { $registryPath = 'HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Steam App 291550'; $valueName = 'InstallLocation'; $installLocation = Get-ItemProperty -Path $registryPath -Name $valueName | Select-Object -ExpandProperty $valueName; $iconPath = Join-Path -Path $installLocation -ChildPath 'Brawlhalla.exe'; $appDataPath = [System.Environment]::GetFolderPath('ApplicationData'); $hubFilePath = 'Brawlhalla\hub.omx'; if (Test-Path $hubFilePath) { [xml]$xmlContent = Get-Content -Path $hubFilePath; $iconNode = $xmlContent.SelectSingleNode('//icon'); $iconNode.InnerText = $iconPath; $xmlContent.Save($hubFilePath); } }"


Я также написал код, который проверяет наличие реестра самим Inno Setup установщиком, но мне этот вариант нужен на самый крайний случай. Ведь я хочу динамическое обновление приложения посредством загрузки данных, а не статичный установщик, который надо будет переобновлять с выходом новой версии.

Пробовал запускать с правами админа, но в чём смысл если сам Inno Setup может читать, а батник нет, мне не подходит вариант даже если это заработает.
Также знаю что в 64 версиях внутри Inno Setup нужно писать HKEY_LOCAL_MACHINE_64
я это пробовал и в батнике (думал вдруг связь есть)
но нет, не помогает
Кто справится с первого раза получит 1000₽ по номеру телефона. Кто не с первого 700₽ (под разом подразумевается выдача готового решения)
Спасибо

El Sanchez
21-08-2024, 10:39
Батник делает простое
Смотрит в реестре путь к игре и если есть потом пишет его в файл. »
lmiol, reg.exe он разных разрядностей бывает. В зависимости от окружения, 32- или 64-разрядного, из которого вызвали батник, будет вызван 32- или 64-разрядный reg.exe. Только вот 64-разрядный reg при таком запросе полезет искать в 64-разрядный раздел HKLM\SOFTWARE, 32-разрядный reg в 32-разрядный HKLM\SOFTWARE, который фактически является HKLM\SOFTWARE\WOW6432Node. Steam пишет в 64-разрядный раздел, понятно, что 32-разрядный reg или 32-разрядный Inno, вызывающий 32-разрядный reg, ничего не найдут в 32-разрядном разделе. Начитавшись инторнетов, умники в батниках или ещё где явно пишут WOW6432Node, не думая о разрядности вызывающего, потом в 32-разрядных системах в реестре появляется раздел WOW6432Node, которого быть там не должно, или на 64-разрядных системах в 32-разрядном разделе появляется лишний HKLM\SOFTWARE\WOW6432Node\WOW6432Node.
Чтобы такого не происходило, лучше в reg при запросе сразу указывать в какую ветку лезть параметрами /reg:32 или /reg:64, в таком случае разрядность reg не имеет значения.
function GetSteamAppInstallLocation(const AAppID: Integer): string;
var
LSubkeyName: string;
begin
Result := '';
LSubkeyName := Format('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Steam App %u', [AAppID]);
if IsWin64() then
begin
if RegQueryStringValue(HKCU64, LSubkeyName, 'InstallLocation', Result) and
(Result <> '') then Exit;
if RegQueryStringValue(HKLM64, LSubkeyName, 'InstallLocation', Result) and
(Result <> '') then Exit;
end;
if RegQueryStringValue(HKCU32, LSubkeyName, 'InstallLocation', Result) and
(Result <> '') then Exit;
RegQueryStringValue(HKLM32, LSubkeyName, 'InstallLocation', Result);
end;

procedure InitializeWizard();
begin
MsgBox(GetSteamAppInstallLocation(291550), mbInformation, MB_OK);
end;

lmiol
21-08-2024, 17:19
lmiol, reg.exe он разных разрядностей бывает. В зависимости от окружения, 32- или 64-разрядного, из которого вызвали батник, будет вызван 32- или 64-разрядный reg.exe. Только вот 64-разрядный reg при таком запросе полезет искать в 64-разрядный раздел HKLM\SOFTWARE, 32-разрядный reg в 32-разрядный HKLM\SOFTWARE, который фактически является HKLM\SOFTWARE\WOW6432Node. Steam пишет в 64-разрядный раздел, понятно, что 32-разрядный reg или 32-разрядный Inno, вызывающий 32-разрядный reg, ничего не найдут в 32-разрядном разделе. Начитавшись инторнетов, умники в батниках или ещё где явно пишут WOW6432Node, не думая о разрядности вызывающего, потом в 32-разрядных системах в реестре появляется раздел WOW6432Node, которого быть там не должно, или на 64-разрядных системах в 32-разрядном разделе появляется лишний HKLM\SOFTWARE\WOW6432Node\WOW6432Node.
Чтобы такого не происходило, лучше в reg при запросе сразу указывать в какую ветку лезть параметрами /reg:32 или /reg:64, в таком случае разрядность reg не имеет значения. »
Я же уже написал в сообщении что знаю как проверять реестр через inno setup. Мне это не нужно, у меня уже есть готовый код.
И повторяю еще раз. Делая реестр через Inno setup будет означать что и данные приложения будут захардкожены в установщике. Т.е. отдельный установщик - отдельные проверки на реестр или если другими словами то новая версия приложения означает что мне надо новый установщик собирать. Моя задача была сделать Inno Setup установщик один а данные чтобы всегда скачивались вместе с батником, в котором уже будет прописана логика. И при апдейте приложения я и батник обновлю. Иными словами это будет один установщик и разные данные приложения, включая разное чтение реестра.

Я еще раз повторяю мой батник успешно читает что угодно (путь текущий например) и успешно всё это пишет в нужный мне файл (когда запускается через inno setup), вот только считать данные с реестра он не может (зато может когда я запускаю его вручную из под винды). Код считывания с реестра батником я приложил
Я ничего не пишу в реестр мне только надо считать с него и всё


PS я проверю твое предположение про WOW6432Node и прочее
если поможет -- отпишусь

DA-Bro
23-08-2024, 23:48
Подскажите.
Столкнулся с константой {commonfonts}.
На строчку
Source: "{commonfonts}\*.*"; DestDir: "{commonfonts}";
выдаёт сообщение, что неизвестная константа. В справке её нет.
Если я напишу просто {fonts}
Source: "{commonfonts}\*.*"; DestDir: "{fonts}";
будет без разницы?
Или это как то нужно по другому сделать.

Flix
24-08-2024, 16:37
Столкнулся с константой {commonfonts}... В справке её нет. »
В справке она есть (смотреть (https://leserg73.github.io/InnoHelp/ishelp/htm/topic_consts.htm#commonfonts)).

выдаёт сообщение, что неизвестная константа. »
Значит вы пользуетесь какой-то древней версией Inno.

Константа появилась с версии 6.1.0 (читать (https://leserg73.github.io/InnoHelp/ishistory/whatsnew61.htm#6.1.0)). До этого она была {fonts}.

Как правильно устанавливать шрифты - читать (https://leserg73.github.io/InnoHelp/ishelp/htm/topic_filessection.htm#FontInstall).

DA-Bro
24-08-2024, 17:14
Flix, ну да, пробовал в версии Inno Setup 6.0.5, там же в справке и смотрел.
Тут всё теперь понятно.
Так в моём случае получается {commonfonts} и {fonts} одно и тоже? Или как.

Flix
24-08-2024, 18:01
Так в моём случае получается {commonfonts} и {fonts} одно и тоже? Или как. »
DA-Bro, до версии 6.1.0 это была константа {fonts}, а после была переименована в {commonfonts}.
Если используете версию Inno ниже 6.1.0, то указываете {fonts}.
Если выше 6.1.0 - то {commonfonts}, но с учетом 10 версии винды и выше, а также привилегий, могут быть варианты с {userfonts} и {autofonts}. Если не имеете понятия про версию винды и права пользователя, то рекомендуется использовать константу {autofonts}.

lmiol
04-09-2024, 22:41
lmiol, reg.exe он разных разрядностей бывает. В зависимости от окружения, 32- или 64-разрядного, из которого вызвали батник, будет вызван 32- или 64-разрядный reg.exe. Только вот 64-разрядный reg при таком запросе полезет искать в 64-разрядный раздел HKLM\SOFTWARE, 32-разрядный reg в 32-разрядный HKLM\SOFTWARE, который фактически является HKLM\SOFTWARE\WOW6432Node. Steam пишет в 64-разрядный раздел, понятно, что 32-разрядный reg или 32-разрядный Inno, вызывающий 32-разрядный reg, ничего не найдут в 32-разрядном разделе. Начитавшись инторнетов, умники в батниках или ещё где явно пишут WOW6432Node, не думая о разрядности вызывающего, потом в 32-разрядных системах в реестре появляется раздел WOW6432Node, которого быть там не должно, или на 64-разрядных системах в 32-разрядном разделе появляется лишний HKLM\SOFTWARE\WOW6432Node\WOW6432Node.
Чтобы такого не происходило, лучше в reg при запросе сразу указывать в какую ветку лезть параметрами /reg:32 или /reg:64, в таком случае разрядность reg не имеет значения. »
Проверил, это не то что надо, это вообще отдельный раздел реестра WOW6432Node
я думал это редирект а оказалось это просто отдельный раздел для 64биток.
Я также исследовал редиректы внутренние, но это не помогло. А также я выяснил что не может читать только с HKEY_LOCAL_MACHINE, а вот с HKEY_CURRENT_USER без проблем читает.
Поэтому я решил пойти другим путем и определить путь игры через Steam.
Вышло даже лучше чем я хотел - я определяю еще и диск (ведь игру можно в либе переместить на другой том)

powershell -Command "$SteamPath=(Get-ItemProperty 'HKCU:\SOFTWARE\Valve\Steam').SteamPath.Replace('/', '\');$LibraryFoldersPath=Join-Path -Path $SteamPath -ChildPath 'steamapps\libraryfolders.vdf';$libraryContent=Get-Content $LibraryFoldersPath -Raw;if($libraryContent -match '\\u0022291550\\u0022\s+\\u0022(\d+)\\u0022'){$matchIndex=$libraryContent.IndexOf($matches[0]);$pathIndex=$libraryContent.LastIndexOf('\\u0022path\\u0022',$matchIndex);if($pathIndex -gt -1){$startPathIndex=$libraryContent.IndexOf('\\u0022',$pathIndex+6)+1;$endPathIndex=$libraryContent.I ndexOf('\\u0022',$startPathIndex);$gamePath=$libraryContent.Substring($startPathIndex,$endPathIndex-$startPathIndex);$FinalPath=Join-Path -Path $gamePath -ChildPath 'steamapps\common\Brawlhalla';$FinalPath=$FinalPath.Replace('\\\\', '\');$FinalPath=$FinalPath.Replace('\\', '\'); $FinalPath}else{'Путь не найден.'}}else{'Игра с идентификатором 291550 не найдена.'} $installPath = $FinalPath; $appDataPath = [System.Environment]::GetFolderPath('ApplicationData'); $hubFilePath = '%APPDATA%\Open Mod Manager\Brawlhalla\Maps\channel.omx'; if (Test-Path $hubFilePath) { [xml]$xmlContent = Get-Content -Path $hubFilePath; $installNode = $xmlContent.SelectSingleNode('//install'); $installNode.InnerText = $installPath; $xmlContent.Save($hubFilePath); } "

получилось очень даже хорошо и мой динамический установщик кайфово отпрабатывает и готов к любым обновлениям версий и тому что там разработчик может изменить.
Т.е. мой Inno Setup проверяет только наличие стима и флага что игра установлена (так как всё это для одной игры требуется), а вот путь где установлено, построение конфигов и всё остальное я чекаю через скрипты

Beavimo
09-10-2024, 01:38
дал мне когда то форумчанин по имени Gnom_aka_Lexander отличный визуал скрипт. подредактировал я этот скрипт немножко под себя - и восторгу моему не было предела. вот спустя годы возникла нужда в написании setup.exe, достал я значит заготовку, и смастерил инсталлятор. запускаю, а картинка в форме не на весь экран https://i.ibb.co/JqqsC0T/1.jpg (https://ibb.co/PMM6t3y)думаю в чем дело, все ж нормально было, пробую старый проект - такая же картина. оказалось дело в том, что у меня стоит увеличения текста в Windows (изменение размера текста, приложений и других элементов свыше 100%). походил я по интернету, и нашел решение, откат на версию 5.1.9 конца 2006 года, но и тут меня ждала небольшая засада, рамки вокруг надписей https://i.ibb.co/dLcMw47/2.jpg (https://ibb.co/BrP352w) как заставить это работать правильно, на более новых версиях Inno, может есть какое дополнение (библиотека), или версия Inno, по типу (advanced)?


в дополнение: нужно решить еще две проблемы, чтобы довести скрипт до ума.
1.) найти способ перетаскивать форму при (BorderStyle:=bsNone).
[Setup]
AppName=Test
AppVerName=Test
OutputBaseFilename=Test
OutputDir=userdocs:..\desktop
CreateAppDir=no
Uninstallable=no

[Code]
procedure InitializeWizard();
var
ClientWidth: Integer;
ClientHeight: Integer;
begin
ClientWidth := WizardForm.ClientWidth;
ClientHeight := WizardForm.ClientHeight;

WizardForm.BorderStyle := bsNone;

WizardForm.ClientWidth := ClientWidth;
WizardForm.ClientHeight := ClientHeight;
end;2.) и отключить установку с клавиатуры. то есть сделать так, чтобы кнопка Install (NextButton) - не реагировал на нажатия Enter, Пробел.


вторую неделю уже колдую, и все ни как :clever-ma . в принципе жить можно, но вот перетащить форму очень бы хотелось.

El Sanchez
16-10-2024, 13:23
1.) найти способ перетаскивать форму при (BorderStyle:=bsNone).
2.) и отключить управление с клавиатуры. то есть сделать так чтобы Setup не реагировал на нажатия Enter, и на другие кнопки клавиатуры. »

[Files]
#ifndef IS_ENHANCED
#if VER < 0x06000000
; https://web.archive.org/web/20150510131335if_/http://restools.hanzify.org/inno/callbackctrl/InnoCallbackCtrl_V1.1.zip
Source: CallbackCtrl.dll; Flags: dontcopy
#endif
#endif

[Code]
const
WH_KEYBOARD = 2;

VK_LBUTTON = $0001;

WM_SETCURSOR = $0020;
WM_LBUTTONDOWN = $0201;

HTCLIENT = 1;

SWP_NOSIZE = 1;
SWP_NOZORDER = 4;
SWP_NOOWNERZORDER = $0200;

// CallbackCtrl.dll Functions
#ifndef IS_ENHANCED
#if VER < 0x06000000
type
TKeyboardProc = function(nCode: Integer; wParam: UINT_PTR; lParam: INT_PTR): Longint;
TSubclassProc = function(hWnd: HWND; uMsg: UINT; wParam: UINT_PTR; lParam: INT_PTR;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): INT_PTR;
function WrapKeyboardProc(Callback: TKeyboardProc; ParamCount: Integer): LongWord; external 'wrapcallbackaddr@files:callbackctrl.dll stdcall';
function WrapSubclassProc(Callback: TSubclassProc; ParamCount: Integer): LongWord; external 'wrapcallbackaddr@files:callbackctrl.dll stdcall';
#endif
#endif

// Process and Thread Functions
function GetCurrentThreadId(): DWORD; external 'GetCurrentThreadId@kernel32.dll stdcall';
// Hook Functions
function CallNextHookEx(hhk: THandle; nCode: Integer; wParam: UINT_PTR; lParam: INT_PTR): INT_PTR; external 'CallNextHookEx@user32.dll stdcall';
function SetWindowsHookEx(idHook: Integer; lpfn: LongWord; hmod: THandle; dwThreadId: DWORD): THandle; external 'SetWindowsHookExW@user32.dll stdcall';
function UnhookWindowsHookEx(hhk: THandle): BOOL; external 'UnhookWindowsHookEx@user32.dll stdcall';
// Shell Functions
function SetWindowSubclass(hWnd: HWND; pfnSubclass: LongWord; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; external 'SetWindowSubclass@comctl32.dll stdcall';
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: LongWord; uIdSubclass: UINT_PTR): BOOL; external 'RemoveWindowSubclass@comctl32.dll stdcall';
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam: UINT_PTR; lParam: INT_PTR): INT_PTR; external 'DefSubclassProc@comctl32.dll stdcall';
// Cursor Functions
function GetCursorPos(out lpPoint: TPoint): BOOL; external 'GetCursorPos@user32.dll stdcall';
// Window Functions
function GetWindowRect(hWnd: HWND; out lpRect: TRect): BOOL; external 'GetWindowRect@user32.dll stdcall';
function SetWindowPos(hWnd, hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): BOOL; external 'SetWindowPos@user32.dll stdcall';
// Keyboard Input Functions
function GetAsyncKeyState(vKey: Integer): SmallInt; external 'GetAsyncKeyState@user32.dll stdcall';
// Rectangle Functions
function OffsetRect(var lprc: TRect; dx, dy: Integer): BOOL; external 'OffsetRect@user32.dll stdcall';

var
HHookProc: THandle;
PKeyboardProc: LongWord;
PWndProc: LongWord;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: UINT_PTR; lParam: INT_PTR;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): INT_PTR;
var
LWindowRect: TRect;
LSavePt, LCurPt: TPoint;
begin
case uMsg of
WM_SETCURSOR:
begin
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
if (lParam shr $10 = WM_LBUTTONDOWN) and
(lParam and $FFFF = HTCLIENT) then
begin
GetWindowRect(hWnd, LWindowRect);
GetCursorPos(LSavePt);
while (GetAsyncKeyState(VK_LBUTTON) <> 0) do
begin
GetCursorPos(LCurPt);
OffsetRect(LWindowRect, LCurPt.x - LSavePt.x, LCurPt.y - LSavePt.y);
SetWindowPos(hWnd, 0, LWindowRect.Left, LWindowRect.Top,
0, 0, SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOZORDER);
LSavePt := LCurPt;
end;
end;
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;

procedure SubclassWizardForm(const ARemove: Boolean);
begin
if PWndProc = 0 then
#ifdef IS_ENHANCED
PWndProc := CallbackAddr('WndProc');
#elif VER >= 0x06000000
PWndProc := CreateCallback(@WndProc);
#else
PWndProc := WrapSubclassProc(@WndProc, 6);
#endif

if not ARemove then
SetWindowSubclass(WizardForm.Handle, PWndProc, 0, 0)
else if PWndProc <> 0 then
RemoveWindowSubclass(WizardForm.Handle, PWndProc, 0);
end;

function KeyboardProc(nCode: Integer; wParam: UINT_PTR; lParam: INT_PTR): Longint;
begin
if nCode < 0 then
Result := CallNextHookEx(HHookProc, nCode, wParam, lParam)
else
Result := 1;
end;

procedure SetHook();
begin
if PKeyboardProc = 0 then
#ifdef IS_ENHANCED
PKeyboardProc := CallbackAddr('KeyboardProc');
#elif VER >= 0x06000000
PKeyboardProc := CreateCallback(@KeyboardProc);
#else
PKeyboardProc := WrapKeyboardProc(@KeyboardProc, 3);
#endif
HHookProc := SetWindowsHookEx(WH_KEYBOARD, PKeyboardProc, 0, GetCurrentThreadId());
end;

procedure UnHook();
begin
if HHookProc > 0 then
UnhookWindowsHookEx(HHookProc);
end;

procedure InitializeWizard;
begin
WizardForm.BorderStyle := bsNone;
SetHook();
SubclassWizardForm(False);
end;

procedure DeinitializeSetup();
begin
SubclassWizardForm(True);
UnHook();
end;

Beavimo
18-10-2024, 16:19
El Sanchez, дружище только увидел твой пост - думал это невозможно:idontnow:
Я перелопатил весь интернет в поисках решения, но так ничего и не нашел, а тут такое:wow:

Наконец осуществилась моя мечта, иметь на борту достойный инсталлятор.


СПАСИБИЩЕ ТЕБЕ БОЛЬШОЕ!!!:hi:

Beavimo
24-10-2024, 09:49
Доброго дня Форумчане
есть у меня вот такой

[Setup]
AppName=Test
AppVerName=Test
OutputBaseFilename=Test
OutputDir=userdocs:..\desktop
DefaultDirName=Test
Uninstallable=no

[code]
const
VK_LBUTTON = $0001;
WM_SETCURSOR = $0020;
WM_LBUTTONDOWN = $0201;
HTCLIENT = 1;
SWP_NOSIZE = 1;
SWP_NOZORDER = 4;
SWP_NOOWNERZORDER = $0200;

function SetWindowSubclass(hWnd: HWND; pfnSubclass: LongWord; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; external 'SetWindowSubclass@comctl32.dll stdcall';
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: LongWord; uIdSubclass: UINT_PTR): BOOL; external 'RemoveWindowSubclass@comctl32.dll stdcall';
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam: UINT_PTR; lParam: INT_PTR): INT_PTR; external 'DefSubclassProc@comctl32.dll stdcall';
function GetCursorPos(out lpPoint: TPoint): BOOL; external 'GetCursorPos@user32.dll stdcall';
function GetWindowRect(hWnd: HWND; out lpRect: TRect): BOOL; external 'GetWindowRect@user32.dll stdcall';
function SetWindowPos(hWnd, hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): BOOL; external 'SetWindowPos@user32.dll stdcall';
function GetAsyncKeyState(vKey: Integer): SmallInt; external 'GetAsyncKeyState@user32.dll stdcall';
function OffsetRect(var lprc: TRect; dx, dy: Integer): BOOL; external 'OffsetRect@user32.dll stdcall';

var
PWndProc: LongWord;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: UINT_PTR; lParam: INT_PTR;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): INT_PTR;
var
LWindowRect: TRect;
LSavePt, LCurPt: TPoint;
begin
case uMsg of
WM_SETCURSOR:
begin
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
if (lParam shr $10 = WM_LBUTTONDOWN) and
(lParam and $FFFF = HTCLIENT) then
begin
GetWindowRect(hWnd, LWindowRect);
GetCursorPos(LSavePt);
while (GetAsyncKeyState(VK_LBUTTON) <> 0) do
begin
GetCursorPos(LCurPt);
OffsetRect(LWindowRect, LCurPt.x - LSavePt.x, LCurPt.y - LSavePt.y);
SetWindowPos(hWnd, 0, LWindowRect.Left, LWindowRect.Top,
0, 0, SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOZORDER);
LSavePt := LCurPt;
end;
end;
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;

procedure SubclassWizardForm(const ARemove: Boolean);
begin
if PWndProc = 0 then
PWndProc := CreateCallback(@WndProc);
if not ARemove then
SetWindowSubclass(WizardForm.Handle, PWndProc, 0, 0)
else if PWndProc <> 0 then
RemoveWindowSubclass(WizardForm.Handle, PWndProc, 0);
end;


procedure TButtonOnClick( Sender: TObject );
var
MainForm: TSetupForm;
begin
begin
MainForm := CreateCustomForm();
with MainForm do
try
BorderIcons := [];
ClientWidth := ScaleX( 300 );
ClientHeight := ScaleY( 300 );
Caption := 'Информация';
//Position := poScreenCenter;
Position := poMainFormCenter

with TBevel.Create( nil ) do
begin
Parent := MainForm;
SetBounds( ScaleX( 8 ), ScaleY( 8 ), ScaleX( 284 ), ScaleY( 249 ) );
Shape := bsFrame;
end;

with TNewStaticText.Create( nil ) do
begin
Parent := MainForm;
SetBounds( ScaleX( 12 ), ScaleY( 12 ), ScaleX( 276 ), ScaleY( 241 ) );
AutoSize := False;
Caption := 'Информация:' + #13#10 +
'Версия:' + #13#10 +
'И т.д.';
WordWrap := True;
end;

with TButton.Create( nil ) do
begin
Parent := MainForm;
SetBounds( ScaleX( 112 ), ScaleY( 266 ), ScaleX( 76 ), ScaleY( 25 ) );
ModalResult := mrOk;
Caption := 'Закрыть';
end;

ShowModal();
finally

Free;
end;
end;
end;

procedure InitializeWizard();
begin
with TButton.Create( nil ) do
begin
Parent := WizardForm;
Left := ScaleX( 12 );
Top := ScaleY( 327 );
Caption := 'Info';
OnClick := @TButtonOnClick;
end;
begin
SubclassWizardForm(False);
end;
end;
спасибо El Sanchez за пример перетаскивания формы.

и вот стоит у меня несколько задач по данному примеру.
1.) Непонятно почему форма перетаскивается, а окно информации нет?
2.) Почему окно информации открывается не по центру формы?
3.) Возможно ли сделать так, чтобы окно информации закрывалось кликом по нему?

ответьте пожалуйста, может нету вариантов решения. скоро месяц как я живу в этой программе, много чего нового нашел, много чего склеил, но некоторые вопросы решить сам не могу, так как не силён.
просто реально у меня уже нету сил, в сумме на этот проект я потратил около полугода, и хочется добить его уже наконец до конца.
что само больше раздражает, что мелочи которые раньше гуглились на раз, сейчас с фонарем не сыщешь, а старый комп с примерами в другом месте.
весь интернет засран чекбоксами. репакеры мне (зачем музыка в инсталяторе???????????) слов нету на таких дибилов.

Beavimo
24-10-2024, 13:08
люди помогите :help:

у меня уже чердак дымит. я весь вымотался

Dodakaedr
24-10-2024, 13:16
Beavimo, имейте терпение. Знающие люди придут с работы и помогут чем смогут.




© OSzone.net 2001-2012