Ветеран
Сообщения: 1274
Благодарности: 1030
|
Профиль
|
Отправить PM
| Цитировать
Цитата Kashtan007:
|
Как место серых окон (Inner Notebook и Inner Page) на страницах установщика поставить изображение (фон)? »
|
Способов несколько:
1. Самый распространенный способ - скрыть OuterNotebook, влепить фоновую картинку на форму, сверху создать аналоги скрытых статиков (TNewStaticText -> TLabel), менять родителя остальных контролов (TBitmapImage, TEdit, TNewCheckListBox и т.д.) в нужное время для имитации перехода между страницами.
2. Сабклассинг. Переопределить оконные процедуры WizardForm, страниц OuterNotebook (включая вложенные) на свои и отрисовывать фон самому. В TWizardForm и TNewNotebookPage фон рисуется с помощью системной кисти цвета clBtnFace, которую можно представить как узорчастую кисть цвета clBtnFace размером в 1х1 пикселя. Имея картинку, можно создать узорчастую кисть на ее основе, и рисовать фон ею вместо системной в своей оконной процедуре. В примере создается кисть на основе картинки (я не стал создавать кисть на основе картинки с размерами клиентской части формы, взял WizardSmallBitmapImage, чтобы увидеть воочию как система заливает фон кистью), переопределяются оконные процедуры для TWizardForm и TNewNotebookPage, в оконных процедурах фон рисуется созданной кистью при получении сообщения WM_ERASEBKGND.
читать дальше »
Код:  [Setup]
AppName=test
AppVerName=test
DefaultDirName={tmp}
CreateAppDir=no
Uninstallable=no
CreateUninstallRegKey=no
[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl
[code]
#define A = (Defined UNICODE) ? "W" : "A"
const
GWL_USERDATA = (-21);
GWL_WNDPROC = (-4);
WM_ERASEBKGND = $0014;
GA_ROOT = 2;
var
g_hBackgroundBrush: THandle;
g_pWndProc, g_pNotebookPageWndProc: Longint;
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLong{#A}@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam: Longint; lParam: Longint): Longint; external 'CallWindowProc{#A}@user32.dll stdcall';
function CreatePatternBrush(hbmp: HBITMAP): THandle; external 'CreatePatternBrush@gdi32.dll stdcall';
function DeleteObject(hObject: THandle): BOOL; external 'DeleteObject@gdi32.dll stdcall';
function GetUpdateRect(hWnd: HWND; var lpRect: TRect; bErase: BOOL): BOOL; external 'GetUpdateRect@user32.dll stdcall';
function GetAncestor(hwnd: HWND; gaFlags: UINT): HWND; external 'GetAncestor@user32.dll stdcall';
function FillRect(hDC: Longint; const lprc: TRect; hbr: Longint): Integer; external 'FillRect@user32.dll stdcall';
function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints: TPoint; cPoints: UINT): Integer; external 'MapWindowPoints@user32.dll stdcall';
function SetBrushOrgEx(hdc: Longint; nXOrg, nYOrg: Integer; var lppt: TPoint): BOOL; external 'SetBrushOrgEx@gdi32.dll stdcall';
//////////////////////////////////////////////////////////////////////////
function WndProc(hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint;
var
rc: TRect;
begin
case Msg of
WM_ERASEBKGND: begin
GetUpdateRect(hWnd, rc, False);
FillRect(wParam, rc, g_hBackgroundBrush);
Result := 1;
end;
else
Result := CallWindowProc(GetWindowLong(hWnd, GWL_USERDATA), hWnd, Msg, wParam, lParam);
end;
end;
//////////////////////////////////////////////////////////////////////////////////////
function NotebookPageWndProc(hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint;
var
pt: TPoint;
rc: TRect;
begin
case Msg of
WM_ERASEBKGND: begin
MapWindowPoints(hWnd, GetAncestor(hWnd, GA_ROOT), pt, 1);
SetBrushOrgEx(wParam, -pt.x, -pt.y, pt);
GetUpdateRect(hWnd, rc, False);
FillRect(wParam, rc, g_hBackgroundBrush);
Result := 1;
end;
else
Result := CallWindowProc(GetWindowLong(hWnd, GWL_USERDATA), hWnd, Msg, wParam, lParam);
end;
end;
//////////////////////////////////////////////////////////
procedure SubclassControlProc(const Control: TWinControl);
var
i: Integer;
begin
for i := 0 to Control.ControlCount-1 do if Control.Controls[i] is TWinControl then
begin
// subclass notebook page
if Control.Controls[i] is TNewNotebookPage then with TNewNotebookPage(Control.Controls[i]) do
if GetWindowLong(Handle, GWL_USERDATA) = 0 then
SetWindowLong(Handle, GWL_USERDATA, SetWindowLong(Handle, GWL_WNDPROC, g_pNotebookPageWndProc));
if TWinControl(Control.Controls[i]).ControlCount > 0 then
SubclassControlProc(TWinControl(Control.Controls[i]));
end;
end;
///////////////////////////////////
procedure SubclassWizardFormProc();
begin
// callback proc
if g_pWndProc = 0 then g_pWndProc := CallbackAddr('WndProc');
if g_pNotebookPageWndProc = 0 then g_pNotebookPageWndProc := CallbackAddr('NotebookPageWndProc');
// subclass WizardForm
if GetWindowLong(WizardForm.Handle, GWL_USERDATA) = 0 then
SetWindowLong(WizardForm.Handle, GWL_USERDATA, SetWindowLong(WizardForm.Handle, GWL_WNDPROC, g_pWndProc));
// subclass controls
SubclassControlProc(WizardForm);
end;
////////////////////////////////////////////////////////////
procedure UnSubclassControlProc(const Control: TWinControl);
var
i: Integer;
begin
for i := 0 to Control.ControlCount-1 do if Control.Controls[i] is TWinControl then
begin
// unsubclass notebook page
if (Control.Controls[i] is TNewNotebookPage) then with TNewNotebookPage(Control.Controls[i]) do
if GetWindowLong(Handle, GWL_USERDATA) > 0 then
SetWindowLong(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_USERDATA));
if TWinControl(Control.Controls[i]).ControlCount > 0 then
UnSubclassControlProc(TWinControl(Control.Controls[i]));
end;
end;
/////////////////////////////////////
procedure UnSubclassWizardFormProc();
begin
// unsubclass controls
UnSubclassControlProc(WizardForm);
// unsubclass WizardForm
if GetWindowLong(WizardForm.Handle, GWL_USERDATA) > 0 then
SetWindowLong(WizardForm.Handle, GWL_WNDPROC, GetWindowLong(WizardForm.Handle, GWL_USERDATA));
end;
/////////////////////////////
procedure InitializeWizard();
begin
// create pattern brush
g_hBackgroundBrush := CreatePatternBrush(WizardForm.WizardSmallBitmapImage.Bitmap.Handle);
// subclass
SubclassWizardFormProc();
end;
//////////////////////////////
procedure DeinitializeSetup();
begin
// unsubclass
UnSubclassWizardFormProc();
// delete pattern brush
if g_hBackgroundBrush <> 0 then DeleteObject(g_hBackgroundBrush);
end;
Цитата Shkutu:
Когда доходит до строчки, где происходит вызов функции, падает с ошибкой "Could not call proc". Похоже на ошибку инициализации, но если смотреть в дебагере, то на этот момент все длл уже извлечены.
Не подскажете, в чем может быть проблема? »
|
Shkutu, с типами параметров что-то напутали в GetCRMUserGuid. Попробуйте сменить PAnsiChar на String. |
