Хак №1: запись в свойство только для чтения

Это перевод Hack #1: Write access to a read-only property. Автор: Hallvard Vassbotn.

Днём ранее у меня возникла задача сделать поведение нашего главного приложения лучше на различных системах с разным экранным разрешением (вернее, плотностью пикселей - пикселей на дюйм/pixels per inch). Это классическая "проблема больших шрифтов" и правильного масштабирования форм и диалогов для показа читабельного текста на любых конфигурациях. Вам нужно иметь ввиду несколько вещей, некоторые из которых описаны тут, но их гораздо больше, например, MDI-окна, наследование форм и т.п.

Чтобы упростить тестирование (и, возможно, дать конечному пользователю возможность поменять умалчиваемое поведение масштабирования) я решил позволить текущей плотности экрана (определяется Screen.PixelsPerInch) контролироваться из реестра. Встроенное в Delphi масштабирование форм работает достаточно хорошо и основывается на факте, что значение PixelsPerInch формы в режиме проектирования отлично от значения Screen.PixelsPerInch во время работы программы. Но свойство PixelsPerInch является свойством только для чтения, публичным свойством синглтона класса TScreen. Оно инициализируется в конструкторе TScreen числом пикселей на дюйм по вертикали:

DC := GetDC(0); 
FPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);

Поэтому, для моих целей тестирования я хотел бы устанавливать значение свойства PixelsPerInch без замут с настройками системы, но чтобы это сделать, мне нужно как-то изменить значение свойства только для чтения. Невозможно, да?

Ну, когда вы имеете дело с программами, нет почти ничего действительно невозможного. Программы "мягки" (software is soft), так что мы можем менять их :-) Изменение объявления в TScreen для добавления записи к полю будет работать, но как указал Allen, внесение изменений в интерфейсные секции модулей RTL и VCL может иметь каскадные эффекты, которые часто не являются желаемыми. Кроме того, это не будет действительно хаком - это слишком просто. Нет, давайте сделаем что-то более интересное ;P PixelsPerInch - это только public-свойство, так что у нас нет RTTI-информации для него. Давайте объявим дочерний класс, который делает свойство published:

type 
  TScreenEx = class(TScreen) 
  published 
    property PixelsPerInch; 
  end;

Теперь, поскольку TScreen - дальний потомок TPersistent, а TPersistent был скомпилирован в режиме $M+, то published-свойства в нашем классе TScreenEx будут иметь RTTI-информацию. Но PixelsPerInch всё ещё является свойством только для чтения, и нет никакого способа сделать его записываемым в нашем TScreenEx, потому что поле данных FPixelsPerInch является private, а не protected, поэтому оно вне доступа для нас.

Но хитрость заключается в сгенерированной RTTI информации для свойства TScreenEx.PixelsPerInch - она включает в себя достаточно, чтобы найти поле данных в экземпляре объекта. Откройте модуль TypInfo.pas и найдите запись TPropInfo, которая описывает RTTI для каждого свойства. Одним из включаемых данных является указатель GetProc. Для свойств, которые читаются напрямую из поля данных, этот параметр содержит смещение поля в экземпляре объекта (без некоторых флаговых битов). После расшифровки этого смещения и добавления его к базовому адресу экземпляра, мы сможем получить указатель на поле данных и, таки образом, модифицировать его через указатель! Вот краткая версия этого подхода:

procedure SetPixelsPerInch(Value: integer); 
begin 
  PInteger(Integer(Screen) + (Integer(GetPropInfo(TScreenEx, 'PixelsPerInch').GetProc) and $00FFFFFF))^ := Value; 
end;

Декодирование левой части оператора присваивания я оставляю в качестве упражнения для читателя.

Примечание переводчика: на самом деле, это слишком сложный подход. Дело в том, что в Delphi есть такая "багофича": вы можете получить адрес у свойства, если это свойство читает из поля напрямую, минуя геттер. Например, как свойство PixelsPerInch у TScreen. Поэтому вам достаточно сделать так: PInteger(@(Screen.PixelsPerInch))^ := Value; Здесь @(Screen.PixelsPerInch) на самом деле даёт вам @(Screen.FPixelsPerInch) - благодаря тому, что у вас нет get-тера. Но пост всё равно достаточно интересный.