Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Аватара для El Sanchez

Ветеран


Contributor


Сообщения: 1264
Благодарности: 1024

Профиль | Отправить 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