Ветеран
Сообщения: 1274
Благодарности: 1030
Профиль
|
Отправить 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