Показать полную графическую версию : Скрипты Inno Setup. Помощь и советы [часть 5]
kodzoyev
06-02-2013, 09:16
Johny777, спасибо! ;) "Тихую" установку реализовали в NSIS пока-что, но за код благодарю отдельно.
Добрый день. Мне нужно установить приложение, которое меняет настройки IE. Сейчас параметры прописываются в реестре для HKCU, но мне нужно, чтобы они применялись и для остальных пользователей. Пробовал добавлять в HKLM и HKU/.DEFAULT, но параметры не подхватываются. Кто-нибудь сталкивался?
Johny777
07-02-2013, 15:11
Пацаны помогите пожалуйста вместо скрытия подсказок ( http://forum.oszone.net/post-2080773-1638.html ) добавить кнопку "свернуть" в
заголовок формы ( BorderStyle := bsDialog )
а именно через функцию DrawFrameControl(..., DFCS_CAPTIONMIN, ...)
вот мой потр (не рабочий):
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
GWL_WNDPROC = -4;
SM_CXSIZE = 30;
SM_CYSIZE = 31;
SM_CXFRAME = $20;
SM_CYFRAME = 33;
DFC_BUTTON = 4;
DFCS_BUTTONPUSH = $10;
DFCS_PUSHED = $200;
WM_NCACTIVATE = $0086;
DFCS_CAPTIONMIN = 1;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
HDC = LongWord;
PRect = TRect;
var
OldWindowProc: Longint;
R: TRect;
Press: Boolean;
function GetWindowDC(hWnd: HWND): HDC; external 'GetWindowDC@user32.dll stdcall';
function GetSystemMetrics(nIndex: Integer): Integer; external 'GetSystemMetrics@user32.dll stdcall';
function DrawFrameControl(DC: HDC; Rect: PRect; uType, uState: UINT): BOOL; external 'DrawFrameControl@user32.dll stdcall';
function ReleaseDC(hWnd: HWND; hDC: HDC): Integer; external 'ReleaseDC@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
begin
Result.Left := ALeft;
Result.Top := ATop;
Result.Right := AWidth;
Result.Bottom := AHeight;
end;
procedure DrawBtn(Ctrl: TWinControl);
var
WDc: HDC;
Cx, Cy: Integer;
XFrame, Yframe: Integer;
iHandle: HWND;
begin
iHandle := Ctrl.Handle;
WDc := GetWindowDc(iHandle);
Cx := GetSystemMetrics(SM_CXSIZE);
Cy := GetSystemMetrics(SM_CYSIZE);
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);
R := Bounds(Ctrl.Width - xFrame - 4*Cx + 2, yFrame + 2, Cx - 2, Cy - 4);
if Press then
DrawFrameControl(WDc, R ,DFC_BUTTON, DFCS_CAPTIONMIN or DFCS_PUSHED)
else
DrawFrameControl(WDc,R, DFC_BUTTON, DFCS_CAPTIONMIN);
ReleaseDc(iHandle,WDC);
end;
function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
if Msg = WM_NCACTIVATE then DrawBtn(WizardForm);
Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;
procedure InitializeWizard();
begin
WizardForm.BorderStyle := bsDialog;
OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
//
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.Handle, GWL_WNDPROC or -21, OldWindowProc);
end;
очень хочу 2 нормальные кнопки в заголовке!
Буду очень признателен! :)
вот исходник на дельфи
sergey3695
07-02-2013, 18:21
вместо скрытия подсказок »
лучше скрыть иначе тогда еще геморойнее.
Вообщем досех пор думаю над твоим вопросом, вот функция скрытия системных хинтов на делфи
unit Unit1;
interface
uses
Windows,Messages,SysUtils,Forms;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
SysTooltip: HWND;
procedure WMNCMouseMove(var Msg: TMessage); message WM_NCMOUSEMOVE;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function HideSystemTooltip(Wnd: HWND; lPrm: LPARAM): BOOL; stdcall;
var
WndCl: PChar;
begin
Result := True;
if not IsWindowVisible(Wnd) then Exit;
GetMem(WndCl, 256 * SizeOf(Char));
try
GetClassName(Wnd, WndCl, 255);
Result := (StrPas(WndCl) <> '#32774');
if not Result then
ShowWindow(Wnd, SW_HIDE);
finally
FreeMem(WndCl, 256 * SizeOf(Char));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SysTooltip := 0;
EnumWindows(@HideSystemTooltip, 0);
end;
procedure TForm1.WMNCMouseMove(var Msg: TMessage);
begin
if not IsWindow(SysTooltip) then
EnumWindows(@HideSystemTooltip, 0);
if not IsWindowVisible(SysTooltip) then Exit;
end;
end.
Опыта в делфи у меня мало (в написании библиотек), можно сказать что ноль, полный ноль. Начил изучать пока с основ. Но вопрос хотелось бы уже решить. Может кто-нибудь по-умнее может написать библеотеку для инно. Johny777, , без библы тут необойтись все-равно. (по крайней мере я так думаю)
El Sanchez
07-02-2013, 18:39
добавить кнопку "свернуть" в
заголовок формы ( BorderStyle := bsDialog ) »
Johny777, так пойдет?
const
GWL_STYLE = (-16);
WS_MINIMIZEBOX = $20000;
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';
procedure InitializeWizard();
begin
WizardForm.BorderStyle := bsDialog;
SetWindowLong(WizardForm.Handle, GWL_STYLE, GetWindowLong(WizardForm.Handle, GWL_STYLE) or WS_MINIMIZEBOX);
end;
Mailchik
07-02-2013, 20:54
Johny777, так пойдет? »Вряд ли. Johny777 хочет только кнопку минимизации и закрытия. То есть полностью удалить кнопку максимизации.
P.S. Интересная идея, но я не видел еще таких приложений, только с кнопкой минимизации и закрытия. Если имеются таковые, можно ссылочку.
P.S.S. Чтобы именно Windows'овские системные кнопки были.
Johny777
08-02-2013, 03:28
так пойдет? »
El Sanchez, Не, не то :(
нужно скрыть неактивную сис. кнопку "развернуть" на форме и оставит только "свернуть" и "закрыть", причём чтоб они лежали рядом друг с другом без пробела
тк юзаю скин придумал извартский, но на удивление рабочий способ ( описание-( http://forum.oszone.net/post-2080773-1638.html ), реализация-( http://forum.oszone.net/post-2081356-1640.html ) ), но обломился (описание почему по первой ссылке).
Откровено говоря не знаю что пихать в библиотеку, чтоб скрыть тултипы, тк кода на 10 строк, но кажись мой порт не работает из-за замены функций GetMem(...), FreeMem(...)
И вот недавно нарвался на функцию DrawFrameControl которая может многое, включая добавление своих кнопок в заголовок формы и (внимание) стандартных - системных.
Тут же нашёлся пример по добавлении своей кнопки (исходник прикреплен в пред. сообщении), но с флагом-константой DFCS_CAPTIONMIN = 1; можно добавить по координатам
прямоугольника (TRect) стандртную кнопку "свернуть" аккурат слева от единственной кнопки "закрыть" (она одна при BorderStyle := bsDialog), но как известно из 10 раз я облaмываюсь на таких попытках 9,5 раз и это как раз тот случай.
sergey3695,
то же самое лежит здесь http://forum.vingrad.ru/forum/topic-300335/kw-hint-buttom-system/0.html
видел уже! проблема в другом. Даже если скрыть или заменить тултип, то остаётся ст. сис. меню, вызываемое кликом правой кнопкой мыши по заголовку и левым кликом по иконке (по той, что в левом верхнем углу). А там айтем развернуть который сворчивает окно (те ещё хуже тултипа). Да его можно удалить, но тогда окну не будут посылаться сообщения "развернуть", которые мы меняем на "свернуть". Кажись фиг бы с ним, ведь у нас есть WM_NCLBUTTONDOWN с wParam = HTMAXBUTTON - нажатие на кнопку развернуть, но нажатие <> клик! Можно отловить правый клик по заголовку и обнулить сообщение WM_NCRBUTTONDOWN, но остаётся левый клик по иконке и появится снова сис. контекстное меню. Тут думаю нужно определять положение мыши (TPoint) и сравнивать с TRect-ом формы (х, у) и выполнять что-то вроде ( http://forum.oszone.net/post-2081583-1646.html )
В общем пока-что самый привлекательный способ - добавить свою кнопку :)
Mailchik
08-02-2013, 18:13
Johny777, я думаю, ты понимаешь, что используя DrawFrameControl, форма будет иметь до XP'шный стиль. http://bestrepack.net/forum/images/smiles/skype05.gif
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[Code]
#ifdef UNICODE
#define A "W"
type
PChar = PAnsiChar;
#else
#define A "A"
#endif
const
GWL_WNDPROC = -4;
DFC_CAPTION = 1;
DFCS_CAPTIONMIN = 1;
DFCS_PUSHED = $200;
WM_SETFOCUS = $0007;
WM_NCLBUTTONDOWN = $00A1;
WM_NCLBUTTONUP = $00A2;
WM_NCACTIVATE = $0086;
WM_NCCALCSIZE = $0083;
WM_NCPAINT = $0085;
WM_ACTIVATE = $0006;
WM_WINDOWPOSCHANGING = $0046;
WA_INACTIVE = 0;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
HDC = LongWord;
SHORT = Longint;
var
OldWindowProc: Longint;
myPoint: TPoint;
myRect: TRect;
myDC: HDC;
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint;
external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
external 'CallWindowProc{#A}@user32.dll stdcall';
function GetCursorPos(var lpPoint: TPoint): BOOL;
external 'GetCursorPos@user32.dll stdcall';
function GetWindowDC(hWnd: HWND): HDC;
external 'GetWindowDC@user32.dll stdcall';
function ReleaseDC(hWnd: HWND; hDC: HDC): Integer;
external 'ReleaseDC@user32.dll stdcall';
function DrawFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL;
external 'DrawFrameControl@user32.dll stdcall';
procedure DrawButton(State: Cardinal);
begin
myRect.Left := WizardForm.Width - ScaleX(46);
myRect.Right := WizardForm.Width - ScaleX(27);
myRect.Top := ScaleY(5);
myRect.Bottom := ScaleY(22);
myDC := GetWindowDC(WizardForm.Handle);
try
DrawFrameControl(myDC, myRect, DFC_CAPTION , DFCS_CAPTIONMIN or State);
finally
ReleaseDC(WizardForm.Handle, myDC);
end;
end;
function PointIntoRect: boolean;
var
myPoint: TPoint;
begin
GetCursorPos(myPoint);
Result :=
(myPoint.X - WizardForm.Left >= WizardForm.Width - ScaleX(46)) and
(myPoint.X - WizardForm.Left <= WizardForm.Width - ScaleX(27)) and
(myPoint.Y - WizardForm.Top >= ScaleY(5)) and
(myPoint.Y - WizardForm.Top <= ScaleY(22));
end;
function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
case Msg of
WM_NCACTIVATE, WM_NCCALCSIZE, WM_ACTIVATE, WM_NCPAINT, WM_WINDOWPOSCHANGING, WM_SETFOCUS: DrawButton(0);
//WM_NCLBUTTONDOWN: if PointIntoRect then DrawButton(DFCS_Pushed); //состояние нажатия кнопки;
WM_NCLBUTTONDOWN: if PointIntoRect then Application.Minimize;
end;
if wParam = WA_INACTIVE then DrawButton(0);
Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;
procedure InitializeWizard();
begin
with WizardForm do begin
BorderIcons := [biSystemMenu];
end;
OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldWindowProc);
end;
sergey3695
09-02-2013, 14:26
Johny777, вот решение твой проблемы (http://rghost.ru/43662623)
Спасибо большое Mailchik, за помощь. Я так и думал что где-то чето накасячил но не мог понять что. Вообщем то Johny777, он тоже тем самым что помог мне, помог и тебе. Хотя этот вопрос меня тоже заинтересовал так что мне тоже захотелось две кнопочки )
к сожалению библеотеку меньше весом не сделать. (ну я на килобайт поменьше сделал (127 кб) но это пустяк)
Johny777
09-02-2013, 15:12
sergey3695, спасибо, но только-что смог таки скрыть тултипы (ведь знал же что библиотека в этом случае - перебор)
пихать в библиотеку это явно нет смысла: :)
function HideSystemTooltip(Wnd: HWND; lPrm: LPARAM): BOOL;
begin
Result := ShowWindow(FindWindowByClassName('#32774'), SW_HIDE);
end;
полный пример:
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[Files]
Source: {fonts}\*; DestDir: {app}; Flags: external
Source: steam.cjstyles; Flags: dontcopy
Source: isskin.dll; Flags: dontcopy
[ code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
GWL_WNDPROC = -4;
WM_NCMOUSEMOVE = $00A0;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
SHORT = Longint;
var
OldWindowProc: Longint;
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function EnumWindows(lpEnumFunc, lParam: Longint): BOOL; external 'EnumWindows@user32.dll stdcall';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; external 'ShowWindow@user32.dll stdcall';
function HideSystemTooltip(Wnd: HWND; lPrm: LPARAM): BOOL;
begin
Result := ShowWindow(FindWindowByClassName('#32774'), SW_HIDE);
end;
function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
if Msg = WM_NCMOUSEMOVE then EnumWindows(CallbackAddr('HideSystemTooltip'), 0);
Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;
procedure InitializeWizard();
begin
OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldWindowProc);
end;
касательно сокрытия кнопки развернуть:
Mailchik, Спасибо большое за код. Знаю что стиль "Аэро" слетает, но не важно тк хотел использовать только со скином, но кнопка не текстурируется :( , поэтому
Mailchik, sergey3695, предлагаю доработанный метод подмены сообщений:
сис меню больше не вызывается при клике по иконке и за неё теперь можно таскать, + в том что сворачивание происходит при клике а не нажатии на кнопку:
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[Files]
Source: {fonts}\*; DestDir: {app}; Flags: external
[ code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
GWL_WNDPROC = -4;
WM_SYSCOMMAND = $0112;
SC_MINIMIZE = 61472;
SC_MAXIMIZE = 61488;
SC_SIZE = 61440;
SC_MOVE = 61456;
WM_NCLBUTTONDBLCLK = $00A3;
MF_BYCOMMAND = 0;
WM_NCLBUTTONDOWN = $00A1;
WM_NCRBUTTONDOWN = $00A4;
WM_NCMOUSEMOVE = $00A0;
SC_CLOSE = 61536;
VK_LBUTTON = 1;
SC_DRAGMOVE = $F012;
WM_JOHNY = 7777;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
SHORT = Longint;
var
OldWindowProc: Longint;
SysPopupMenu: TPopupMenu;
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function GetCursorPos(var lpPoint: TPoint): BOOL; external 'GetCursorPos@user32.dll stdcall';
function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'GetWindowRect@user32.dll stdcall';
function GetKeyState(nVirtKey: Integer): SHORT; external 'GetKeyState@user32.dll stdcall';
function ReleaseCapture: BOOL; external 'ReleaseCapture@user32.dll stdcall';
function EnumWindows(lpEnumFunc, lParam: Longint): BOOL; external 'EnumWindows@user32.dll stdcall';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; external 'ShowWindow@user32.dll stdcall';
function HideSystemTooltip(Wnd: HWND; lPrm: LPARAM): BOOL;
begin
Result := ShowWindow(FindWindowByClassName('#32774'), SW_HIDE);
end;
function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
pt: TPoint;
rt: TRect;
begin
case Msg of
WM_SYSCOMMAND:
case wParam of
SC_MAXIMIZE:
begin
wParam := 0;
SendMessage(hWnd, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
end;
WM_NCMOUSEMOVE: EnumWindows(CallbackAddr('HideSystemTooltip'), 0);
WM_NCLBUTTONDBLCLK: Msg := 0; // двойной клик по заголовку окна
WM_NCRBUTTONDOWN:
begin
Msg := 0;
if GetCursorPos(pt) then SysPopupMenu.Popup(pt.x, pt.y);
end;
WM_NCLBUTTONDOWN: if GetCursorPos(pt) and GetWindowRect(hWnd, rt) then
if (pt.x > rt.Left) and (pt.x < rt.Right-WizardForm.Width+27) and (pt.y > rt.Top) and (pt.y < rt.Bottom-WizardForm.Height+27) then
begin
ReleaseCapture;
SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
// WM_JOHNY: MsgBox('демо подмены кнопок от Johny777 :)', mbInformation, MB_OK);
end;
Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;
procedure SysMenuOnClick(Sender: TObject);
begin
case TMenuItem(Sender).Caption of
'MINIMIZE': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
'CLOSE': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
'MOVE': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_MOVE, 0);
end;
end;
procedure InitializeWizard();
var
hSYSMENU: HWND;
mMinimize, mClose, mMove: TMenuItem;
begin
WizardForm.BorderIcons := [biSystemMenu, biMaximize];
OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
SysPopupMenu := TPopupMenu.Create(WizardForm);
with SysPopupMenu do
begin
mMinimize := TMenuItem.Create(WizardForm);
with mMinimize do
begin
Caption := 'MINIMIZE';
SysPopupMenu.Items.Add(mMinimize);
OnClick := @SysMenuOnClick;
end;
mClose := TMenuItem.Create(WizardForm);
with mClose do
begin
Caption := 'CLOSE';
SysPopupMenu.Items.Add(mClose);
OnClick := @SysMenuOnClick;
end;
mMove := TMenuItem.Create(WizardForm);
with mMove do
begin
Caption := 'MOVE';
SysPopupMenu.Items.Add(mMove);
OnClick := @SysMenuOnClick;
end;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = wpWelcome then SendMessage(WizardForm.Handle, WM_JOHNY, 0, 0);
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldWindowProc);
end;
в сообщении sergey3695 есть перерисованный скин. Пробуйте. :) Есть рекомендации по улучшению - говорите! По возможности исправлю/добавлю
Мне осталось только доработать подменённое сис меню и добавить свои хинты (можно и через ISHint.dll)
============================================= UPDATE =========================================================
изучаю потихоньку вин апи, вот вам подарок: :)
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[ code]
const
FLASHW_STOP = $0;
FLASHW_CAPTION = $1;
FLASHW_TRAY = $2;
FLASHW_ALL = FLASHW_CAPTION or FLASHW_TRAY;
FLASHW_TIMER = $4;
FLASHW_TIMERNOFG = $C;
type
FLASHWINFO = record
cbSize: UINT;
hwnd: HWND;
dwFlags: DWORD;
uCount: UINT; // Число миганий
dwTimeout: DWORD; // промежуток между миганиями
end;
function FlashWindowEx(var pfwi: FLASHWINFO): BOOL; external 'FlashWindowEx@user32.dll stdcall';
procedure CurPageChanged(CurPageID: Integer);
var
fl: FLASHWINFO;
begin
fl.cbSize := SizeOf(fl);
fl.dwTimeout := 777;
fl.hwnd := Application.Handle;
fl.uCount := 3;
fl.dwFlags := FLASHW_TRAY;
FlashWindowEx(fl);
end;
http://img404.imageshack.us/img404/9884/14846550.png (http://imageshack.us/photo/my-images/404/14846550.png/)
sergey3695
09-02-2013, 15:42
пихать в библиотеку это явно нет смысла »
теперь останется только поржать ))) нет слов.
сис меню больше не вызывается при клике по иконке »
вызывается. (по крайней мере у меня)
Johny777
10-02-2013, 17:12
Ну все! Добил код:
1. Хинтов нет. Через ISHint.dll работает как-то стрёмно (вырезал), Сам хинт создаётся через функцию CreateWindowEx(...) как здесь ( http://forum.vingrad.ru/forum/topic-300335/kw-hint-buttom-system/0.html ), но в какой-то момент нужно отправить через SendMessage(... , LPARAM(PTOOLINFO(@g_toolItem))); адрес переменной, а вот это в инно не реализовать: LPARAM(PTOOLINFO(@g_toolItem)), а функции типа CallbackAddr(), только для переменных я не нашел. Короче забил. Думаю хинтами можно пренебречь. Лично мне они нафиг не нужны (и так понятно что крестик закрывает окно...)
2. Зато классно получилось подменённое сис. меню (var SysPopupMenu: TPopupMenu;). Принцип такой:
создаём TPopupMenu функцией NewPopupMenu(), во входном параметре которой массив из TMenuItem. Их мы создаём функцией NewItem(), во входном параметре которой строка-текст айтема, а тут
(внимание) работает ещё одна функция (изменённая и упрощённая мной под собственные нужды) от South (оригинал тут http://forum.ru-board.com/topic.cgi?forum=5&topic=33457&start=3283&limit=1&m=1 )
function GetMenuItemText(const hMenu: HMENU; const uIDItem: UINT; const Default: String): String;
hMenu - хэндл меню
uIDItem - индекс айтема
Default - если функция не отработает, то вернёт это имя для айтема
короче говоря мы перекидываем имена айтемов ('Закрыть', в английской винде 'Close', в китайской иероглифы) в своё меню из системного, чтоб не писать константы сообщений!
далее: Добавил сис. картинки (закрыть, свернуть) в меню функцией SetMenuItemBitmaps()
кто хочет свои картинки, то делается это так:
BitmapResource=Close:Close.bmp|Min:Min.bmp
...
var
CloseBmp, MinBmp: TBitmap;
procedure InitializeWizard();
begin
...
CloseBmp := TBitmap.Create;
CloseBmp.LoadFromResourceName(HInstance, '_IS_CLOSE');
MinBmp := TBitmap.Create;
MinBmp.LoadFromResourceName(HInstance, '_IS_MIN');
SetMenuItemBitmaps(SysPopupMenu.Handle, 0, MF_BYPOSITION, MinBmp.Handle, MinBmp.Handle);
SetMenuItemBitmaps(SysPopupMenu.Handle, 1, MF_BYPOSITION, CloseBmp.Handle, CloseBmp.Handle);
end;
финальный код подмены сообщений:
[Setup]
AppName=777
AppVerName=777
DefaultDirname={pf}\777
[code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
GWL_WNDPROC = -4;
WM_SYSCOMMAND = $0112;
SC_MINIMIZE = 61472;
SC_MAXIMIZE = 61488;
SC_MOVE = 61456;
WM_NCLBUTTONDBLCLK = $00A3;
WM_NCLBUTTONDOWN = $00A1;
WM_NCRBUTTONDOWN = $00A4;
WM_NCMOUSEMOVE = $00A0;
SC_CLOSE = 61536;
SC_DRAGMOVE = $F012;
WM_JOHNY = 7777;
MF_BYPOSITION = $400;
SC_SEPARATOR = 61455;
MAX_PATH = 260;
HBMMENU_CALLBACK = -1;
HBMMENU_SYSTEM = 1;
HBMMENU_MBAR_RESTORE = 2;
HBMMENU_MBAR_MINIMIZE = 3;
HBMMENU_MBAR_CLOSE = 5;
HBMMENU_MBAR_CLOSE_D = 6;
HBMMENU_MBAR_MINIMIZE_D = 7;
HBMMENU_POPUP_CLOSE = 8;
HBMMENU_POPUP_RESTORE = 9;
HBMMENU_POPUP_MAXIMIZE = 10;
HBMMENU_POPUP_MINIMIZE = 11;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
SHORT = Longint;
HINST = THandle;
var
OldWindowProc: Longint;
SysPopupMenu: TPopupMenu;
function GetSystemMenu(hWnd: HWND; bRevert: BOOL): HMENU; external 'GetSystemMenu@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function GetCursorPos(var lpPoint: TPoint): BOOL; external 'GetCursorPos@user32.dll stdcall';
function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'GetWindowRect@user32.dll stdcall';
function ReleaseCapture: BOOL; external 'ReleaseCapture@user32.dll stdcall';
function EnumWindows(lpEnumFunc, lParam: Longint): BOOL; external 'EnumWindows@user32.dll stdcall';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; external 'ShowWindow@user32.dll stdcall';
function SetMenuItemBitmaps(hMenu: HMENU; uPosition, uFlags: UINT; hBitmapUnchecked: HBITMAP; hBitmapChecked: HBITMAP): BOOL; external 'SetMenuItemBitmaps@user32.dll stdcall';
function GetMenuString(hMenu: HMENU; uIDItem: UINT; lpString: PChar; nMaxCount: Integer; uFlag: UINT): Integer; external 'GetMenuString{#A}@user32.dll stdcall';
function GetMenuItemText(const hMenu: HMENU; const uIDItem: UINT; const Default: String): String; // South
var
Buff: String;
begin
Result := Default;
SetLength(Buff, MAX_PATH);
if GetMenuString(hMenu, uIDItem, PChar(Buff), MAX_PATH, MF_BYPOSITION) > 0 then Result:= String(Buff);
end;
function HideSystemTooltip(Wnd: HWND; lPrm: LPARAM): BOOL;
begin
Result := ShowWindow(FindWindowByClassName('#32774'), SW_HIDE);
end;
function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
pt: TPoint;
rt: TRect;
begin
case Msg of
WM_SYSCOMMAND: if wParam = SC_MAXIMIZE then
begin
wParam := 0;
SendMessage(hWnd, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
WM_NCMOUSEMOVE: EnumWindows(CallbackAddr('HideSystemTooltip'), 0);
WM_NCLBUTTONDBLCLK: Msg := 0;
WM_NCRBUTTONDOWN:
begin
Msg := 0;
if GetCursorPos(pt) then SysPopupMenu.Popup(pt.x, pt.y);
end;
WM_NCLBUTTONDOWN:
if GetCursorPos(pt) and GetWindowRect(hWnd, rt) then
if (pt.x > rt.Left) and (pt.x < rt.Right-WizardForm.Width+27) and (pt.y > rt.Top) and (pt.y < rt.Bottom-WizardForm.Height+27) then
begin
Msg := 0;
ReleaseCapture;
SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
WM_JOHNY: MsgBox('демо подмены кнопок от Johny777 :)', mbInformation, MB_OK);
end;
Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;
procedure SysMenuOnClick(Sender: TObject);
begin
case TMenuItem(Sender).Name of
'_': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
'X': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
'M': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_MOVE, 0);
'Help', 'About': MsgBox(TMenuItem(Sender).Caption, mbError, MB_OK);
end;
end;
procedure InitializeWizard();
var
hSYSMENU: HWND;
begin
WizardForm.BorderIcons := [biSystemMenu, biMaximize];
OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
hSYSMENU := GetSystemMenu(WizardForm.Handle, False);
SysPopupMenu := NewPopupMenu(WizardForm, 'MyPopupMenu', paLeft, True, [
NewItem(GetMenuItemText(hSYSMENU, 3, '&MINIMIZE'), 0, False, True, @SysMenuOnClick, 1, '_'),
NewItem(GetMenuItemText(hSYSMENU, 6, '&CLOSE'), 0, False, True, @SysMenuOnClick, 2, 'X'),
NewItem(GetMenuItemText(hSYSMENU, 1, '&MOVE'), 0, False, True, @SysMenuOnClick, 3, 'M'),
NewLine,
NewSubMenu('&Help', 0, 'mHelp', [
NewItem('&Inno Setup Help', 0, False, True, @SysMenuOnClick, 4, 'Help'),
NewItem('&About Inno Setup', 0, False, True, @SysMenuOnClick, 5, 'About')
], True)
]);
SetMenuItemBitmaps(SysPopupMenu.Handle, 0, MF_BYPOSITION, HBMMENU_MBAR_MINIMIZE, HBMMENU_MBAR_MINIMIZE);
SetMenuItemBitmaps(SysPopupMenu.Handle, 1, MF_BYPOSITION, HBMMENU_MBAR_CLOSE, HBMMENU_MBAR_CLOSE);
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = wpWelcome then SendMessage(WizardForm.Handle, WM_JOHNY, 0, 0);
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldWindowProc);
end;
Дальнейшие улучшения кода с моей стороны не планируются. Пользуйтесь кто хочет, буду рад, только скин не забудьте перерисовать! :grin:
==================================================================================================== ==============
sergey3695,
вызывается. (по крайней мере у меня) »
Я забыл установить Msg := 0; И если что, то нужно настраивать строку:
if (pt.x > rt.Left) and (pt.x < rt.Right-WizardForm.Width+27) and (pt.y > rt.Top) and (pt.y < rt.Bottom-WizardForm.Height+27) then
в ней должны быть точные координаты прямоугольника, в котором лежит иконка (они могут сбиться например из-за большего размера формы чем у меня ну или типа того)
Mailchik
10-02-2013, 19:49
Короче забил »всё верно сделал. http://bestrepack.net/forum/images/smiles/skype42.gif
один совет: в коде, используя такие строки:
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif добавляй еще PChar = PAnsiChar, т.к. Unicode компилятор инно не знает просто PChar'а. то есть должно быть так:
#ifdef UNICODE
#define A "W"
type
PChar = PAnsiChar;
#else
#define A "A"
#endif
TERMINAL
13-02-2013, 14:41
Подскажите плз, как и в какой секции нужно прописать условие чтобы при отсутствии ключа в реестре (HKEY_CURRENT_USER\Software\Test, "AppData", "REG_SZ", "7890" ) установщик (ехе) вообще не стартовал или если присутствует папка С:\{E99DDD46-1221-4DB4-81F0-F24D210EB41C} тогда разрешена установка?
Нашёл командную строку как компилировать скрипт Compil32.exe /cc "С:\Proekt\тест.iss", но мне нужно каждый раз создавать новый GUID-возможно сделать автоматическую генерацию нового GUID? Лучше вопрос, для чего нужен этот GUID-я думал для регистрации в реестре, но оказалось не так. Если мне нужно скомпилировать и получить 10 разных файлов ехе, для этого нужно генерировать GUID?
insombia
13-02-2013, 23:12
Gnom_aka_Lexander у тебя есть ещё IsPictures?
Gnom_aka_Lexander
14-02-2013, 09:55
insombia, есть (http://krinkels.org/downloads.php?do=file&id=86).
insombia
14-02-2013, 13:53
Gnom_aka_Lexander я бы скачал от тудого но ты меня там забанил за мультиакк
El Sanchez
14-02-2013, 17:38
Подскажите плз, как и в какой секции нужно прописать условие чтобы при отсутствии ключа в реестре (HKEY_CURRENT_USER\Software\Test, "AppData", "REG_SZ", "7890" ) установщик (ехе) вообще не стартовал или если присутствует папка С:\{E99DDD46-1221-4DB4-81F0-F24D210EB41C} тогда разрешена установка? »
TERMINAL,
function InitializeSetup(): Boolean;
begin
Result := RegKeyExists(HKCU, 'SOFTWARE\Test') or DirExists(ExpandConstant('{sd}\{{E99DDD46-1221-4DB4-81F0-F24D210EB41C}'));
end;
для чего нужен этот GUID-я думал для регистрации в реестре, но оказалось не так. »
TERMINAL, почему не так? Все так.
Если мне нужно скомпилировать и получить 10 разных файлов ехе, для этого нужно генерировать GUID? »
TERMINAL, можно и самому придумать 10 уникальных AppID.
Нашёл командную строку как компилировать скрипт Compil32.exe /cc "С:\Proekt\тест.iss", но мне нужно каждый раз создавать новый GUID-возможно сделать автоматическую генерацию нового GUID? »
TERMINAL, используйте препроцессор iscc.exe для компиляции. У него есть ключ /d, который позволяет декларировать препроцессорные константы и директивы. Допустим в секции Setup директива AppId объявлена через препроцессорную константу {#AppID}:
[Setup]
AppID={#AppID}
Тогда из командной строки указать {#AppID} и скомпилировать скрипт можно так:
iscc "/dAppID=тут уникальный Application ID" "С:\Proekt\тест.iss"
Декларацию константы {#AppID} в скрипте нужно закомментировать, так как парсится позже, чем указанная через комстроку. Консольных генераторов GUID полно, осталось оформить в виде батника, например.
insombia
14-02-2013, 20:01
как добавить создание новой папки сюда (http://i52.fastpic.ru/big/2013/0214/54/368bd94c709629f3035e988366a9c354.png) ?
Mailchik
14-02-2013, 20:36
insombia, [Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application
[Code]
procedure DirClick(Sender : TObject);
var
s: string;
begin
if BrowseForFolder(WizardDirValue, s, True) then
WizardForm.DirEdit.Text := s;
end;
procedure InitializeWizard;
begin
WizardForm.DirBrowseButton.OnClick := @DirClick;
end;
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.