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

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

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

Ветеран


Contributor


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

Профиль | Отправить PM | Цитировать


Цитата Naomi:
реализовать прилипание мастер формы к краям экрана »
Naomi, пример:
Скрытый текст

Код: Выделить весь код
[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
  SPI_GETWORKAREA = $0030;
  WM_WINDOWPOSCHANGING = $0046;
  
type
  TWindowPos = record
    hwnd: HWND;
    hwndInsertAfter: HWND;
    x: Integer;
    y: Integer;
    cx: Integer;
    cy: Integer;
    flags: UINT;
  end;

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';
function SystemParametersInfo(uiAction, uiParam: UINT; var pvParam: TRect; fWinIni: UINT): BOOL; external 'SystemParametersInfo{#A}@user32.dll stdcall';
function ReadProcessMemory(hProcess: THandle; lpBaseAddress: Longint; out lpBuffer: TWindowPos; nSize: DWORD; out lpNumberOfBytesRead: DWORD): BOOL; external 'ReadProcessMemory@kernel32.dll stdcall';
function WriteProcessMemory(hProcess: THandle; lpBaseAddress: Longint; var lpBuffer: TWindowPos; nSize: DWORD; out lpNumberOfBytesWritten: DWORD): BOOL; external 'WriteProcessMemory@kernel32.dll stdcall';
function GetCurrentProcess: THandle; external 'GetCurrentProcess@kernel32.dll stdcall';

var
  GWndProc: Longint;
  GSnapBuffer: Integer;

///////////////////////////////////////////////////////////////////////////
procedure HandleEdge(var Edge: Integer; SnapToEdge, SnapDistance: Integer);
begin
  if (Abs(Edge + SnapDistance - SnapToEdge) < GSnapBuffer) then
    Edge := SnapToEdge - SnapDistance;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function WndProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): Longint;
var
  LRect: TRect;
  WindowPos: TWindowPos;
  NumberOfBytesRead, NumberOfBytesWritten: DWORD;
begin
  case uMsg of
    WM_WINDOWPOSCHANGING:
      begin
        SystemParametersInfo(SPI_GETWORKAREA, 0, LRect, 0);
        ReadProcessMemory(GetCurrentProcess, lParam, WindowPos, SizeOf(WindowPos), NumberOfBytesRead);
        HandleEdge(WindowPos.x, LRect.Left, 0);
        HandleEdge(WindowPos.y, LRect.Top, 0);
        HandleEdge(WindowPos.x, LRect.Right, WizardForm.Width);
        HandleEdge(WindowPos.y, LRect.Bottom, WizardForm.Height);
        WriteProcessMemory(GetCurrentProcess, lParam, WindowPos, SizeOf(WindowPos), NumberOfBytesWritten);
        Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
      end;
  else
    Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
  end;
end;

///////////////////////////
procedure InitializeWizard;
begin
  GSnapBuffer := 50;
  if GWndProc = 0 then
    GWndProc := CallbackAddr('WndProc');
  SetWindowSubclass(WizardForm.Handle, GWndProc, 0, 0);
end;

////////////////////////////
procedure DeinitializeSetup;
begin
  if ExpandConstant('{wizardhwnd}') = '0' then Exit;
  RemoveWindowSubclass(WizardForm.Handle, GWndProc, 0);
end;
Это сообщение посчитали полезным следующие участники:

Отправлено: 11:39, 27-03-2016 | #1456