Ветеран
Сообщения: 1269
Благодарности: 1027
|
Профиль
|
Отправить PM
| Цитировать
Цитата Sotonisto:
скрипт для ComponentsList работает, но название колонок скрывает первый компонент. »
|
Sotonisto, точно, еще и стирается при нажатии на первый компонент. Вот вариант на расширенной версии, где заголовок рисуется на неклиентской части ComponentsList:
Скрытый текст
Код:
[Code]
#define A = (Defined UNICODE) ? "W" : "A"
type
TNCCalcSizeParams = record
rgrc0: TRect;
rgrc1: TRect;
rgrc2: TRect;
end;
// Shell Functions
function SetWindowSubclass(hWnd: HWND; pfnSubclass: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; external 'SetWindowSubclass@comctl32.dll stdcall';
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: Longint; uIdSubclass: UINT_PTR): BOOL; external 'RemoveWindowSubclass@comctl32.dll stdcall';
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint): Longint; external 'DefSubclassProc@comctl32.dll stdcall';
// Run-Time Library (RTL) Routines
function ReadNCCalcSizeParams(out Destination: TNCCalcSizeParams; const Source: LongWord; len: Integer): Integer; external 'RtlMoveMemory@kernel32.dll stdcall';
// Debugging Functions
function WriteNCCalcSizeParams(hProcess: THandle; lpBaseAddress: Longint; var lpBuffer: TNCCalcSizeParams; nSize: DWORD; out lpNumberOfBytesWritten: DWORD): BOOL; external 'WriteProcessMemory@kernel32.dll stdcall';
// Process and Thread Functions
function GetCurrentProcess: THandle; external 'GetCurrentProcess@kernel32.dll stdcall';
// Device Context Functions
function GetDCEx(hWnd: HWND; hrgnClip: THandle; flags: DWORD): THandle; external 'GetDCEx@user32.dll stdcall';
function ReleaseDC(hWnd: HWND; hDC: THandle): Integer; external 'ReleaseDC@user32.dll stdcall';
// Painting and Drawing Functions
function GetWindowDC(hWnd: HWND): THandle; external 'GetWindowDC@user32.dll stdcall';
// Window Functions
function GetWindowRect(hWnd: HWND; var 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';
const
WM_NCCALCSIZE = $0083;
WM_NCPAINT = $0085;
SWP_NOSIZE = 1;
SWP_NOMOVE = 2;
SWP_NOZORDER = 4;
SWP_FRAMECHANGED = $20;
SWP_NOOWNERZORDER = $200;
DCX_WINDOW = 1;
DCX_CACHE = 2;
DCX_INTERSECTRGN = $80;
DCX_USESTYLE = $10000;
DCX_KEEPCLIPRGN = $40000;
var
PCheckListBoxWndProc: LongWord;
HeaderControl: THeaderControl;
function CheckListBoxWndProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LongWord;
var
DC: THandle;
NCCalcSizeParams: TNCCalcSizeParams;
NumberOfBytesWritten: DWORD;
P: TPoint;
R: TRect;
begin
case uMsg of
WM_NCCALCSIZE:
begin
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
ReadNCCalcSizeParams(NCCalcSizeParams, lParam, SizeOf(NCCalcSizeParams));
NCCalcSizeParams.rgrc0.Top := NCCalcSizeParams.rgrc0.Top + HeaderControl.Height;
WriteNCCalcSizeParams(GetCurrentProcess, lParam, NCCalcSizeParams, SizeOf(NCCalcSizeParams), NumberOfBytesWritten);
end;
WM_NCPAINT:
begin
if (wParam <> 0) and (wParam <> 1) then
DC := GetDCEx(hWnd, wParam, DCX_WINDOW or DCX_CACHE or DCX_INTERSECTRGN or DCX_KEEPCLIPRGN or DCX_USESTYLE)
else
DC := GetWindowDC(hWnd);
try
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
GetWindowRect(hWnd, R);
P.x := 0;
P.y := -HeaderControl.Height;
P := HeaderControl.ClientToScreen(P);
HeaderControl.PaintTo(DC, P.x - R.Left, P.y - R.Top);
finally
ReleaseDC(hWnd, DC);
end;
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;
procedure CreateHeader;
var
HeaderSection: THeaderSection;
begin
with WizardForm.ComponentsList do
begin
HeaderControl := THeaderControl.Create(WizardForm);
HeaderControl.Parent := WizardForm.ComponentsList;
HeaderControl.Enabled := False;
HeaderSection := HeaderControl.Sections.Add;
HeaderSection.Width := ClientWidth div 3;
HeaderSection.Alignment := taCenter;
HeaderSection.Text := '';
HeaderSection := HeaderControl.Sections.Add;
HeaderSection.Width := ClientWidth div 3;
HeaderSection.Alignment := taCenter;
HeaderSection.Text := 'Компоненты';
HeaderSection := HeaderControl.Sections.Add;
HeaderSection.Width := ClientWidth div 3;
HeaderSection.Alignment := taCenter;
HeaderSection.Text := 'Размер компонента';
// sublass
PCheckListBoxWndProc := CallbackAddr('CheckListBoxWndProc');
SetWindowSubclass(Handle, PCheckListBoxWndProc, 0, 0);
// send WM_NCCALCSIZE
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOZORDER);
HeaderControl.Visible := False;
end;
end;
procedure InitializeWizard;
begin
CreateHeader;
end;
procedure DeinitializeSetup;
begin
if PCheckListBoxWndProc <> 0 then
RemoveWindowSubclass(WizardForm.ComponentsList.Handle, PCheckListBoxWndProc, 0);
end;
|
Последний раз редактировалось El Sanchez, 16-06-2018 в 12:15.
Причина: fix
Отправлено: 14:37, 15-06-2018
| #47
|