Продолжение о тестах

Первая серия была тут - http://18delphi.blogspot.com/2013/04/blog-post_5863.html

Пишет мой коллега:

Как справедливо замечено, есть действительно 2 основных направления автоматизированного тестирования: проверять фиксированные сценарии (в интерфейсе) или просто следить за тоннами активизируемого контролами функционала. Каждое имеет свои преимущества и недостатки. Но на данном этапе было принято решение проверять только сценарии уже найденных и написанных ошибок. И это, на мой взгляд, разумно, т.к. ошибки эти  находились в разных прецедентах системы. Каждый новый написанный тест охватывает небольшую толику функционала. Но этих тестов становится все больше. И чем их больше, тем выше вероятность, что ошибка будет не пропущена. Для поиска ошибок с сильно ограниченными трудовыми ресурсами – это оптимальный вариант.

Таким образом, избегая зацикливания на одном объекте системы, тесты охватывают всю систему паутиной. И стоит “задеть” одну нить – вся паутина задрожит и даст знать, что что-то случилось. С одной стороны, это замечательно, что тесты перестали проходить. Значит, они работают и нужно проверить изменения в системе. С другой, это ужасно неудобно с точки зрения локализации проблемы. Очень редко, ну очень, возвращается старая ошибка. Тест специально заточен под то, чтобы аккуратно зафиксировать ошибку и уведомить об этом тестировщика. Но, как правило, ломается что-то другое, “по-соседству”. Тест это честно находит, но часто не может четко показать причину ошибки. На эти случаи вставляются ASSERT ы, но всех возможных ошибок нельзя учесть (тогда написание одного теста будет занимать очень долгое время).

Сами тесты я разделяю на следующие группы:

- Уникальные тесты (которые никогда не пересекаются с другими тестами и проверяют область, которую не проверяют другие тесты);

- Тесты, на которые могут повлиять другие тесты (и это тоже проблема, которая решается “качественным” кодом). Например, любые тесты с поиском (от другого теста может остаться фильтр, который изменит результат).

- Тесты – близнецы (разница в которых может составлять и одну строку, и один символ).

Значит, тесты можно делать либо максимально универсальными, либо максимально уникальными. Но в сложных программах путь универсализации – ошибочен. Первое время я старался писать тесты и слова для них с запасом для будущих тестов. Специально “опускал” некоторые части кода. Например:

: “Выделить весь текст в документе”

“Зайти в документ”

“Выделить весь текст”

“Сравнить выделенный текст с эталоном”

; \\ “Выделить весь текст в документе”

То есть, я знаю, что при входе в документ фокус стоит в тексте. И опускаю код “Установить фокус в текст”. Значит, в этом тесте проверяется не только результат выделения, но и то, что фокус оказывается в документе (косвенно). Но знаю также, что есть другой тест, который проверяет именно то, где находится фокус:

: “Проверить, что фокус после открытия документа находится в тексте”

“Зайти в документ”

“Проверить, в каком контроле стоит фокус”

; \\“Проверить, что фокус после открытия документа находится в тексте”

Такие тесты приводят к тому, что при ситуации, когда фокус будет оказываться на другом контроле, найдутся две ошибки. В одной будет честно написано, что фокус не попал в нужный контрол. А во второй не сойдется эталон. Ничего страшного в этом нет, но придется смотреть обе ошибки. И хорошо, если одновременно не сломалось и выделение текста (тогда эта ошибка будет найдена после исправления фокуса и нового прогона тестов). По-этому, нужно писать полный вариант:

: “Выделить весь текст в документе”

“Зайти в документ”

“Установить фокус в текст”

“Выделить весь текст”

“Сравнить выделенный текст с эталоном”

; \\ “Выделить весь текст в документе”

  Такой подход, в будущем, упростит разбор ошибок. Т.е. стараться сделать каждый тест уникальным, проверяющим только описанную ошибку – правильно. К этому нужно стремиться, но без фанатизма.

Теоретически, если все тесты будут работать по такому принципу, не нужен будет специальный человек, который обучен работать с тестами. Потому что в каждом непрошедшем тесте будет подробно описана ошибка. Другие тесты пройдут успешно. Любой пользователь сможет написать ошибку, приведя номер теста и сообщение найденной ошибки. Но это – идеальная система. Добиться, такого результата, думаю, невозможно. Хотя идти к нему стоит.

Если рассматривать мою работу, с точки зрения результативности, то я бы оценил её как среднюю. Ошибки исправно находятся, но есть несколько причин, по которым её нельзя назвать хорошей.

Во-первых, это малое количество тестов, из-за чего вероятность пропустить ошибку очень высока. Чтобы убрать эту причину, нужно лишь время (очень много времени).

Во-вторых, авторство всех тестов принадлежит трем людям. Иногда (в последнее время всё реже) приходится разбираться, почему же тест написан так, когда проще было сделать по-другому. Это частично связано с тем, что ранний функционал не обеспечивал простоту и понятность кода. А также, есть свои “секреты” в работе системы (и тестового приложения). Конечно, очень полезно расставлять комментарии в коде именно ради таких моментов. Но каюсь, добавляю комментарии редко, держу особенности работы в голове. Иногда они забываются, но если с проблемой уже сталкивался, вспоминается она очень быстро. Т.е. коду не хватает формализации.

В-третьих, человеческий фактор. У нас налажена тройная проверка готового теста: первый раз его проверяет автор при отладке, далее тест смотрит разработчик и, если все работает корректно и проверяет, что нужно, тест попадает опять к автору на последнюю проверку и закрытие. При такой проверке маловероятна возможность пропустить ошибку в самом тесте, но есть возможность самим кодом проверять не совсем верный сценарий (не повторяющий ошибку, т.к. тесты пишутся и для уже исправленных ошибок). Бороться с этой причиной проще остальных. Нужно лишь прилагать максимум внимания и стараться выбросить мысли о других ошибках из головы. Полезно также посмотреть точный сценарий ошибки на сборке, на которой она воспроизводилась.

В-четвертых, можно ли утверждать, что когда-то написанный и отлаженный тест будет корректно проверять именно то, что нужно, через 2-3 года. Нельзя. Нужно иногда проводить ревизию тестов (хотя бы выборочно).

Есть еще несколько малозначимых причин. Их, думаю, можно не указывать.

Теперь рассмотрим, какой же человек может справиться с работой с автоматическими тестами.

1) Он должен знать термины и аббревиатуры, принятые в системе.

2) Нужны базовые знания любого языка программирования (не обязательно Delphi или FORTH).

3) Нужна аккуратность, вдумчивость и усидчивость.

То есть, критериев для кандидата не так уж и много. Но их можно сделать еще меньше, упростив работу по написанию тестов. Сделать это очень просто.

Приведу пример из жизни. Однажды мне пришлось поработать в Тверьстате (Территориальный Орган Федеральной Службы государственной статистики). Первая половина работы не имеет к данному рассказу никакого отношения (контроль и правка результатов сканирования). Зато вторая стала очень поучительной. Её суть заключалась в правке Excel – документов (оптимизировать размер полей под печать на минимальном количестве листов). Задача очень простая. Но однотипных документов были тысячи, и выполнять все действия вручную было несерьезно. Была нужна автоматизация. И она была создана одним очень талантливым студентом.

Процесс нашей работы имел вид:

1 день) Ознакомились с заданием, вручную сделали несколько документов.

2 день) Кто-то вспомнил, что в Excel есть макросы. Создав один макрос, его можно указывать из любого документа. Исправили несколько сотен документов.

3 день) В. Е. написал программу, для работы которой нужно: указать папку с документами, указать путь к документу с макросом и его имя, и нажать кнопку Пуск. Программа открывает по порядку документы из папки, применяет макрос, сохраняет документ и закрывает его. Вся работа свелась созданию одного макроса в начале рабочего дня. Не понимаю, почему штатный состав программистов не создал для Тверьстата подобную программу много лет назад (мы были практиканты).

Но речь сейчас не об этом, а о макросах.  Пользователь понятия не имеет какой код используется, когда он записывает сценарий. Он лишь выполняет конечную последовательность действий, которую ему необходимо неоднократно выполнить. Для этого не нужны сверхзнания или специальная подготовка, достаточно будет лишь терминов системы.

То есть, на мой взгляд, написание основной группы тестов должно рано или поздно свестись к работе, схожей с написанием макросов: выполняем действия, система их запоминает и в конце сравнивает результат по каким-либо критериям. Это сделает написание тестов более простым и гораздо более быстрым. Если потребуется написать тест под каждое требование из ТЗ или автоматизировать проверку уже созданных тесткейсов – данный подход поможет это сделать. Ручное написание подобного количества тестов заняло бы годы.

Задачей разработчиков здесь бы стало максимально формализовать код (который записывает алгоритм действий) и результат работы тестов, а также подготовить специалиста, который бы разбирал результаты прогона тестов. Также, этот человек должен будет заниматься написанием более сложных тестов, в которых не получается работать с четким алгоритмом.

Не уверен, что на данном этапе такую систему можно реализовать. Также не уверен, что она окажется идеальной по поиску ошибок и гибкой (при ее использовании). Но данную идею можно додумать. И тогда она может оказаться весьма эффективной.

Трофимов Андрей

А вот тут - реальная проблема

TA = class(TInterfacedObject)
 procedure Subscribe(aList : TList);
end;
 
TB = class(TB, IUnknown)
 procedure UnSubscribe(aList : TList);
end;
 
procedure TA.Subscribe(aList : TList);
begin
 aList.Add(Pointer(IUnknown(Self))); // - кладём один указатель
end;
 
procedure TB.UnSubscribe(aList : TList);
begin
 aList.Remove(Pointer(IUnknown(Self))); // - пытаемся удалить - другой указатель, в итоге - не удаляем и получаем провисшую ссылку, а позже - огребаем AV
end;

-- понятно, что рафинированный пример крив и надуман. Но я встречался с подобным в жизни. Коллеги не дадут соврать. А пример лишь призван проиллюстрировать это.

Имейте эту проблему - в виду. Особенно когда у вас IUnknown "где-то в листах "залип"".

Хочется только спросить - зачем?

http://habrahabr.ru/post/178257/

Фреймворки к существующим платформам - я более менее понимаю зачем. А вот принципиально новые платформы... По-моему - существующих более чем достаточно.

Или я чего-то не понимаю?

По-моему - куда полезнее (да интереснее) сделать нормальный MDA/MDP для существующих платформ. Проблема ведь по-моему - далеко не в целевом языке. Проблема в том, что НИКАКОЙ язык до конца не показывает архитектуру ВСЕЙ системы. И чем больше система, тем больше хаос. И только графическая нотация (не обязательно сразу себе представлять UML) позволяет этот хаос увидеть, осознать и начинать думать - как же его рефакторить. Повторюсь - для СЛОЖНЫХ систем. А простые - можно и на ассемблере наверное писать. Сам правда давно не пробовал.

А восторги о "ручной подсветкой" синтаксиса - конечно хороши (давно сам об этом думал, да и академические круги - по-моему давно толкуют). Только опять же непонятно зачем. Ну сделай редактор+препроцессор. Но зачем новая платформа? Чисто из интереса? Завидую :-)

Так "микросхемы" для UML - куда интереснее и технологичнее для развития :-) И чисто теоретически - это по-моему более продаваемо.

А если о мета-программировании говорить, то C++ 11 - по-моему уже не оставляет почвы для воображения, а говорят C++ 14 - на подходе.

А посыл автора - "Построенное на здравых решениях, ядро языка Паскаль легко поддалось усовершенствованию и умощнению и пригодно для широчайшего класса практических задач. В России Delphi особенно популярен и всё ещё широко используется. Однако развитие языка идёт по принципу наращивания возможностей, и постепенно Delphi становится всё более громоздким, догоняя по сложности таких монстров как PL/1, C++ и Ada. С большой вероятностью мы можем предположить, что проще язык становиться не будет, ибо нужно поддерживать совместимость с накопившейся базой исходников и т.д. В конце концов такая стратегия развития неизбежно приведёт к трудностям, когда сложность уже невозможно будет контролировать." - по-моему несколько не соответствует действительности. Опять же если верить тому же Delphi Language fo Mobile.

Умилило опять же - "Кроме ZXDev также разрабатываются подсистемы WinDev, LinDev, DosDev и JmeDev (в байт-код Java microedition), а, в принципе, нету никаких препятствий сделать подсистему и для целевой разработки под Android/iOS, MSX, ColecoVision, NES/SEGA, Atari, Amiga, Palm OS, да даже под УК-НЦ с ДВК/БК-0011 и под Микрошу с Апогеем/Кристой/РК-86. И у вас есть возможность сделать для XDev поддержку любой интересующей вас платформы, как современной, так и ретро. Вот то моё хобби, к которому в итоге привёло меня многолетнее увлечение программированием. А начиналось всё с Pascal/Fast на УК-НЦ. :)". Я сам конечно большой любитель БК-010.01, так и ту - уж давно выкинул.

Вообще конечно интересно - пишешь, про UML. Про РАБОЧУЮ реализацию (пусть и закрытую). Реакции - НОЛЬ. Пишешь про тесты. Про РАБОЧЕЕ применение - реакции - ноль :-) А тут оказывается народ развлекается "новой системой, которая может быть будет завтра" :-) И оказывается, что это - интересно. Не понимаю. То есть - интересно - да. Но непонятно - зачем. Когда есть гораздо более насущные проблемы, требующие доводки и шлифовки.

P.S. Про LISP/FORTH - так вообще - почти промолчал :-)

P.P.S. Очередной раз позавидовал тому - сколько у людей свободного времени :-)

P.P.P.S Умилил опять же тот факт, что www.delphifeeds.ru - это транслирует :-) Наверное потому что там " рассылка по Delphi и RAD Studio XE4" упоминается :-)

P.P.P.P.S. Я к чему это всё? Да просто размышляю - о том - на какую тему в первую очередь писать. Про тесты? Про UML? Или "тупо забить" - всё равно никто не читает. И продолжить писать "то что хочется" в режиме твиттера. Без оглядки на читающих.

Сокращение времени жизни интерфейса

Gunsmoker про это тоже писал, но опять же хочется поставить акцент:

procedure Process;
begin
 DoSomething(TFactory.MakeInterface);
 DoSomething1;
 DoSomething2;
 // - интерфейс доживёт до сюда, это может быть проблемой
end;

Лучше сделать так:

procedure Process;
 
 procedure ProcessInterface;
 begin
  DoSomething(TFactory.MakeInterface);
  // - интерфейс доживёт лишь до сюда
 end;
 
begin
 ProcessInterface;
 DoSomething1;
 DoSomething2;
end;

Понятно, что тут есть проблема? (3)

Gunsmoker про это уже писал. Обстоятельно.

Но я просто хочу поставить акцент и проиллюстрировать проблему простым примером:

destructor TA.Destroy;
var
 l_Intf : ISomeInterface;
begin
 l_Intf := Self;
 DoSomething(l_Intf);
 inherited;
end;

- можем получить бесконечный вызов Destroy.

Подумайте об этом.

Один из способов избежать этого описан тут - http://18delphi.blogspot.com/2013/04/beforerelease.html

Понятно, что тут есть проблема? (2)

Код:

destructor TA.Destroy;
begin
 FreeAndNil(fA);
 FreeAndNil(fB);
 FreeAndNil(fC);
 inherited;
end;

- вообще говоря потенциально содержит проблему.

Корректнее было бы конечно написать так:

destructor TA.Destroy;
begin
 try
  FreeAndNil(fA);
 finally
  try
   FreeAndNil(fB);
  finally
   try
    FreeAndNil(fC);
   finally
    inherited;
   end; 
  end;
 end;
end;

Хотя конечно же - во всём надо знать меру.

Но! Если скажем внутри Free освобождается какой-нибудь ресурс - например закрывается файл или освобождается критическая секция, то может быть стоит подумать и о перфекционизме.

Один мой знакомый придумал другую технику - он складывает все ресурсы в "массив" (список etc) и освобождает в цикле, позволив выполнится каждой итерации. А вот Exception он поднимает на выходе.

В общем - поле для размышлений - тут есть.

Блог Rouse_: Нужны ли недокументированные API?

Блог Rouse_: Нужны ли недокументированные API?: В чем прелесть высокоуровневых языков программирования? Программист перестает задумываться о том "как оно на самом деле фунциклирует...

Не перестаю удивляться крутости. Просто - снимаю шляпу.

Про фреймворки у меня всё таки - "своё особое мнение".

Delphi Language для мобильной разработки

Изначальная ссылка тут - http://feedproxy.google.com/~r/Delphi2010ru/~3/b0xK9-SfJZ8/

http://embt.co/DelphiWP или вот - https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/Doc/delphilanguagemobiledevelopmentwhitepaper170413.pdf

Говорят "будет один строковый тип, с подсчётом ссылок и immutable". Ну в общем - знакомо. И в общем - правильно. Для сравнения - NSString и Il3CString. immutable! Ещё раз - это правильно. Атомарные объекты не должны менять своё состояние.

Только вот стратегию перехода ещё бы они более/менее правильную избрали бы. А не как с String/AnsiString/WideString. ShortSring vs. String - по-моему - помягче было. Или я забыл уж?

И zero-based. Т.е. индекс - с нуля, а не с единицы. Наконец-то! Я уж давно свой комплект функций написал.
Плавная замена API и RTL на helper'ы. Правильно в общем-то.

(+) - ARC - Automatic Reference Counting.

"In summary, reference counting is triggered as you assign an object to a variable and when a variable goes out of scope, regardless of the fact it is a local stack-based variable, a temporary one added by the compiler, or a field of another object. The same holds for parameters: When you pass an object as parameter to a function, the object’s reference count is incremented and when the function terminates and returns, it is decremented.
Note: Optimizing Parameters Passing: Exactly as it happens for strings, you can optimize parameters passing by using the const modifier. An object passed as a constant, doesn’t incur in the reference counting overhead. Given the same modifier can be used also on Windows, where it is useless, it is a good suggestion to update your code to use const object parameters, and const string parameters. Don’t expect a very significant speed improvement, though, as the reference counting overhead is very limited."

Слабые ссылки! Ну наконец то:

"A weak reference is a reference to an object that doesn’t increase its reference count. Given the previous scenario, if the reference from the second object back to the first one is weak, as the external variable goes out of scope, both objects will be destroyed.
Let’s look at this simple situation in code:
type
TMyComplexClass = class;
TMySimpleClass = class
private
[Weak] FOwnedBy: TMyComplexClass;
public
constructor Create();
destructor Destroy (); override;
procedure DoSomething(bRaise: Boolean = False);
end;
TMyComplexClass = class"

Интересно мне до кучи - додумались сделать СЛАБЫЕ ссылки на интерфейсы - или нет? Или надо продолжать "хоккей" с Pointer и приведением к нужному типу?

Ну и "синтаксический сахар". Перегрузка операторов для классов. Понятное дело, что она напрямую связана с подсчётом ссылок:
"3.8: BONUS FEATURE: OPERATOR OVERLOADING FOR CLASSES
There is a very interesting side effect of using ARC for memory management: the compiler can handle the lifetime of temporary objects returned by functions. One specific case is that of temporary objects returned by operators. In fact, a brand new feature of the new Delphi compiler is the ability to define operators for classes, with the same syntax and model that has been available for records since Delphi 2006."

"Смешение" интерфейсов и объектов (давно я об этом говорил):
"3.9: MIXING INTERFACES AND CLASSES
In the past, given that interface variable and standard object variables used different memory management models, it was generally suggested to avoid mixing the two approaches (like using an interface and an object variable or parameter to refer to the same object in memory).
With the new ARM compilers with ARC, the reference counting between object and interface variables is unified, so you can mix the two easily. This makes using interfaces more powerful and flexible on Delphi ARC platforms than it is on Delphi non-ARC platforms."

А вот это кстати ПРАВИЛЬНО:
"Sooner or later, the with statement is going to be deprecated and removed from the Delphi language. You can easily start removing it now from your code, and most Delphi developer will agree this is a good idea anyway, given some of the hidden pitfalls of this keyword."

with - давно напрашивается к убиению. Его бы на "переменные блока" заменить. Иначе с отрицательной устойчивостью - беда. Тот же Caption все наверное уже по сто раз не тому объекту присвоили.
------

Не удержусь. В целом всё это напоминает нашу библиотеку L3 - подсчёт ссылок, контейнеры, мапы, "юникодные"-строки. Файлеры те же кстати.

Ну и - "чем более кросс-платформенную вещь" вы хотите сделать, тем более сильно придётся "давать по рукам" собственным разработчикам.

-----
Update. Обзор от Gunsmoker'а - http://www.gunsmoker.ru/2013/05/modern-delphi.html

Приехал кстати ключ от Delphi XE4

Приехал кстати ключ от Delphi XE4. Быстро.

После отпуска буду глядеть.

В итоге UML-моделлер на Delphi - WhiteStarUML

В итоге UML-моделлер на Delphi - WhiteStarUML:
https://sourceforge.net/projects/whitestaruml/

Из комментариев - "Works and fast."

Что-то я fast - пока не заметил...

Импортировать реальные модели - не получилось...

В общем - что-то не айс :-(

Блог Rouse_: Итоги семинара Embarcadero посвященному выпуску De...

Блог Rouse_: Итоги семинара Embarcadero посвященному выпуску De...: Сразу оговорюсь, я работаю в Delphi 2010, поэтому я шел на семинар с достаточным интересом,  ожидая увидеть значительные нововведения в ХЕ...

Очередная ссылка на очень умного человека

http://alexander-bagel.blogspot.ru/2013/04/blog-post.html

А ещё есть модуль с DockTree в котором поправлены утечки и проезды по памяти

Живёт тут - https://www.box.com/s/p97j0zo8y3zw8puruo2k
Или тут - https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/l3DockTree.pas

Если у кого-то не скомпилируется, но заинтересует - буду рад ответить на вопросы.

Почему я вдруг говорю о правках в VCL?

Сразу скажу, что далеко не все правки мои лично. И более того - многие люди, которые их делали - работают уже в иных организациях, нежели чем я.

Понятное дело, что МЫ свои проблемы - решили. И будем решать - дальше. И максимально возможное число правок перенесём в Delphi XE3 и XE4. И заодним напишем тесты - там где они не написаны.

Я не верю, что Embarcadero вдруг послушает нас и внесёт эти правки в очередной релиз. Я бы сам бы не стал слушать "какого-то Шуру Люлина со стороны". Более того - может быть найдёт контр-аргументы. Очень их интересно было бы послушать.

И уж точно я не хочу учить программировать "этих чудаков" из Borland'а. У меня - не тот уровень, чтобы кого-то учить.

Но! Пока мы считали, что Delphi - умирает. А Borland - уже умер - мы вносили эти правки по-тихому сами. И были счастливы. И мы думали, что наши правки так и останутся с нами на всю жизнь. И мы не думали, что они кому-то интересны.

Но тут нам показалось, что Delphi обретает вторую жизнь.

А посему - нам показалось, что было бы интересно поделиться нашими правками с окружающими.

Вдруг кому что пригодится. И вдруг люди осознают, что мы правы. Ну или укажут - где мы неправы. Что тоже было бы интересно. Может быть у нас просто - "руки кривые". А если - не кривые - может быть - пригодится. (Жаль кстати, что в блоге так мало критических комментариев - создаётся впечатление, что либо всё понятно, либо совсем всё не понятно, либо - пишу я полную чушь)

И вот тогда - если наберётся критическая масса - может быть и Borland (тьфу Embarcadero) прислушается к нам.

А пока - я пойду писать тесты. На то, что смогу.

Ни в коем случае этими правками - не хочу задеть ни Borland, ни Embarcadero. Ошибки делают все. У нас например - их больше. Но мы кстати и Turbo Vision когда-то правили. По делу. Например с STD и CLD. В поиске.

Мы давно выработали себе за правило - в первую очередь искать ошибку у СЕБЯ, а потом только в стандартных библиотеках.

Но и ошибки в стандартных библиотеках - встречаются. Ну или недопонимание.

Надеюсь, что эти посты будут вам полезны.

P.S. Я думаю, что на часть правок - мы сможем найти "тикеты" в нашей базе ошибок. Но думаю, что к сожалению - не на все.

Ещё правки VCL (23)

function TCustomEdit.GetSelStart: Integer; {V} // - не работает на NT 4.0
begin
  //SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
  Result := LongRec(SendMessage(Handle, EM_GETSEL, 0, 0)).Lo;
end;


function TCustomEdit.GetSelLength: Integer; {V} // - не работает на NT 4.0
begin
  with LongRec(SendMessage(Handle, EM_GETSEL, 0, 0)) do
   Result := Hi - Lo;
end;
(*begin
  SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  Result := Selection.EndPos - Selection.StartPos;
end;*)

Ещё правки VCL (22)

procedure TCustomMaskEdit.CMEnter(var Message: TCMEnter);
begin
  if IsMasked and not (csDesigning in ComponentState) then
  begin
    if not (msReEnter in FMaskState) then
    begin
      FOldValue := EditText;
      inherited;
    end;
    Exclude(FMaskState, msReEnter);
    // во избежание проблем с позиционированием курсора при
    // получении фокуса
    // CheckCursor; {V}
  end
  else
    inherited;
end;

Ещё правки VCL (21)

procedure TCustomMaskEdit.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  // во избежание проблем с позиционированием курсора при
  // получении фокуса
  {if (IsMasked) then
    CheckCursor;} {V}
end;

Ещё правки VCL (20)

function TransparentStretchBlt(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
  SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; MaskDC: HDC; MaskX,
  MaskY: Integer; aMode : TCopyMode = cmSrcCopy): Boolean; {V}
const
  ROP_DstCopy = $00AA0029;
var
  MemDC: HDC;
  MemBmp: HBITMAP;
  Save: THandle;
  crText, crBack: TColorRef;
  SavePal: HPALETTE;
begin
  Result := True;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and (SrcW = DstW) and (SrcH = DstH) then
  begin
    MemBmp := GDICheck(CreateCompatibleBitmap(SrcDC, 1, 1));
    MemBmp := SelectObject(MaskDC, MemBmp);
    try
      MaskBlt(DstDC, DstX, DstY, DstW, DstH, SrcDC, SrcX, SrcY, MemBmp, MaskX,
        MaskY, MakeRop4(ROP_DstCopy, aMode)); {V}
    finally
      MemBmp := SelectObject(MaskDC, MemBmp);
      DeleteObject(MemBmp);
    end;
    Exit;
  end;
  SavePal := 0;
  MemDC := GDICheck(CreateCompatibleDC(0));
  try
    MemBmp := GDICheck(CreateCompatibleBitmap(SrcDC, SrcW, SrcH));
    Save := SelectObject(MemDC, MemBmp);
    SavePal := SelectPalette(SrcDC, SystemPalette16, False);
    SelectPalette(SrcDC, SavePal, False);
    if SavePal <> 0 then
      SavePal := SelectPalette(MemDC, SavePal, True)
    else
      SavePal := SelectPalette(MemDC, SystemPalette16, True);
    RealizePalette(MemDC);

(*    if (aMode = SrcCopy) then
    begin*)
     StretchBlt(MemDC, 0, 0, SrcW, SrcH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcCopy);
     StretchBlt(MemDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SrcW, SrcH, SrcErase);
(*    end
    else
    begin
     StretchBlt(MemDC, 0, 0, SrcW, SrcH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcInvert);
     StretchBlt(MemDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SrcW, SrcH, SrcAnd);
    end*);
    if (aMode = SrcCopy) then {V}
    begin
     crText := SetTextColor(DstDC, $0);
     crBack := SetBkColor(DstDC, $FFFFFF);
    end
    else
    begin
     crText := SetTextColor(DstDC, $FFFFFF);
     crBack := SetBkColor(DstDC, $0);
    end;//aMode = SrcCopy
    if (aMode = SrcCopy) then {V}
    begin
     StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcAnd);
     StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0, SrcW, SrcH, SrcInvert);
    end//aMode = SrcCopy
    else
    begin
     StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcErase);
     StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0, SrcW, SrcH, SrcInvert);
//     StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, MaskX, MaskY, SrcW, SrcH, SrcErase);
//     StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0, SrcW, SrcH, SrcCopy);
    end;//aMode = SrcCopy
    SetTextColor(DstDC, crText);
    SetBkColor(DstDC, crBack);

    if Save <> 0 then SelectObject(MemDC, Save);
    DeleteObject(MemBmp);
  finally
    if SavePal <> 0 then SelectPalette(MemDC, SavePal, False);
    DeleteDC(MemDC);
  end;
end;

Ещё правки VCL (19)

function TApplication.IsMDIMsg(var Msg: TMsg): Boolean;
begin
  Result := False;
  if (MainForm <> nil) and (MainForm.FormStyle = fsMDIForm) and
     (Screen.ActiveForm <> nil) {and (Screen.ActiveForm.FormStyle = fsMDIChild)} then {V}
    Result := TranslateMDISysAccel(MainForm.ClientHandle, Msg);
end;

Ещё правки VCL (18)

procedure TApplication.ModalStarted;
begin
  Restore; {V} //поднятие модального при свернутом окне все раскорячивает
  Inc(FModalLevel);
  if (FModalLevel = 1) and Assigned(FOnModalBegin) then
    FOnModalBegin(Self);
end;

Ещё правки VCL (17)

unction GetTopMostWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;

 {V}
 // Винда в некоторых случаях (замечено на переключении приложений Alt+Esc)
 // самостоятельно сносит WS_EX_TOPMOST еще ДО вызова этого метода
 // поэтому дополнительно проверяем TCustomForm.FormStyle
 function lIsTopMostWindow(Handle: HWND) : boolean;
 var
  lControl : TWinControl;
 begin
  Result := (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_TOPMOST <> 0);
  if not Result then
  begin
   lControl := FindControl(Handle);
   Result := (lControl is TCustomForm) and
             (TCustomForm(lControl).FormStyle = fsStayOnTop);
  end;
 end;

begin
  Result := True;
  if GetWindow(Handle, GW_OWNER) = Application.Handle then
    if lIsTopMostWindow(Handle) and
      ((Application.MainForm = nil) or PTopMostEnumInfo(Info)^.IncludeMain or
      (Handle <> Application.MainForm.Handle)) then
      Application.FTopMostList.Add(Pointer(Handle))
    else
    begin
      PTopMostEnumInfo(Info)^.TopWindow := Handle;
      Result := False;
    end;
end;

Ещё правки VCL (16)

procedure TApplication.ControlDestroyed(Control: TControl);
begin
  if FMainForm = Control then FMainForm := nil;
  if FMouseControl = Control then FMouseControl := nil;
  if Screen.FActiveControl = Control then Screen.FActiveControl := nil;
  if Screen.FActiveCustomForm = Control then
  begin
   If (Control Is TCustomForm) and (TCustomForm(Control).FormStyle = fsMDIChild) then {V}
   begin
     Screen.FActiveCustomForm := FMainForm;
     Screen.FActiveForm := FMainForm;
   end
   else
   begin
     Screen.FActiveCustomForm := nil;
     Screen.FActiveForm := nil;
   end
  end;
  if Screen.FFocusedForm = Control then Screen.FFocusedForm := nil;
  if FHintControl = Control then FHintControl := nil;
  Screen.UpdateLastActive;
end;

Ещё правки VCL (15)

function TCustomForm.CloseQuery: Boolean;  {V}
var
  I: Integer;
begin
  Result := True;
  if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Result);
  If Result and
     (FormStyle = fsMDIForm) then
   begin
    for I := 0 to MDIChildCount - 1 do
     begin
      Result := MDIChildren[I].CloseQuery;
      If Not Result then Exit;
     end;
   end;
end;
{function TCustomForm.CloseQuery: Boolean;
var
  I: Integer;
begin
  if FormStyle = fsMDIForm then
  begin
    Result := False;
    for I := 0 to MDIChildCount - 1 do
      if not MDIChildren[I].CloseQuery then Exit;
  end;
  Result := True;
  if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Result);
end;}

Ещё правки VCL (14)

procedure TCustomForm.WMSysCommand(var Message: TWMSysCommand);

 function IsMDIMaximized: Boolean;
  var
    I: Integer;
  begin
   with Application.MainForm do
    for I := 0 to Pred(MDIChildCount) do
     if MDIChildren[I].WindowState = wsMaximized then
     begin
      Result := True;
      Exit;
     end;
   Result := False;
  end;

 procedure RealignMDIChildren;
  var
    I: Integer;
  begin
   with Application.MainForm do
    for I := 0 to Pred(MDIChildCount) do
     if MDIChildren[I] <> Self then
      MDIChildren[I].Realign;
  end;
var
 lMaximizedMDIChild : boolean;
begin
  lMaximizedMDIChild := (FormStyle = fsMDIChild) and IsMDIMaximized;
  with Message do
  begin
    if (CmdType and $FFF0 = SC_MINIMIZE) and (Application.MainForm = Self) then
      Application.WndProc(TMessage(Message))
    else if (CmdType and $FFF0 <> SC_MOVE) or (csDesigning in ComponentState) or
      (Align = alNone) or (WindowState = wsMinimized) then
      inherited;
    if ((CmdType and $FFF0 = SC_MINIMIZE) or (CmdType and $FFF0 = SC_RESTORE)) and
      not (csDesigning in ComponentState) then
    begin
     if (Align <> alNone) then
      RequestAlign;
     if lMaximizedMDIChild then  {V}
      RealignMDIChildren;        {V}
    end;
  end;
end;

Ещё правки VCL (13)

procedure TCustomForm.WMSize(var Message: TWMSize); {V}
 function IsMDIMaximized: Boolean;
  var
    I: Integer;
  begin
   with Application.MainForm do
    for I := 0 to Pred(MDIChildCount) do
     if MDIChildren[I].WindowState = wsMaximized then
     begin
      Result := True;
      Exit;
     end;
   Result := False;
  end;

begin
 // а то взяли моду ресайзить максимизированные MDIChild'ы
 If (FormStyle = fsMDIChild) and
    IsMDIMaximized and
    (fsCreatedMDIChild in FFormState) and
    (Application.MainForm.ActiveMDIChild <> self) then
 else
  inherited;
end;

Ещё правки VCL (12)

procedure TCustomForm.Activate;
var
 ActChild : TCustomForm; {V}
begin
  {V}
  if (FormStyle = fsMDIForm) and (FActiveControl <> nil) and
     (GetParentForm(FActiveControl).FormStyle = fsMDIChild)
   then
    Begin
     ActChild := GetActiveMDIChild;
     If ActChild <> nil then PostMessage(ActChild.Handle, CM_ACTIVATE, 0, 0);
    end;
  {^V}
  DoNestedActivation(CM_ACTIVATE, ActiveControl, Self);
  if Assigned(FOnActivate) then FOnActivate(Self);
end;

Ещё правки VCL (11)

procedure TCustomForm.WndProc(var Message: TMessage);
var
  FocusHandle: HWND;
  SaveIndex: Integer;
  MenuItem: TMenuItem;
  Canvas: TCanvas;
  DC: HDC;
begin
  with Message do
    case Msg of
      WM_ACTIVATE, WM_SETFOCUS, WM_KILLFOCUS:
        begin
          if not FocusMessages then Exit;
          if (Msg = WM_SETFOCUS) and not (csDesigning in ComponentState) then
          begin
            FocusHandle := 0;
            {V}
            // это слишком умное поведение MDI-окон мы подправим.
            // ибо нефиг забирать фокус отовсюду, откуда можно...
            if (FormStyle = fsMDIForm) and (ActiveMDIChild <> nil) and FRefocusMDIChild then
            begin
             FocusHandle := ActiveMDIChild.Handle
            end
            else
            if (FActiveControl <> nil) and (FActiveControl <> Self) then
              FocusHandle := FActiveControl.Handle;
            if FocusHandle <> 0 then
            begin
              Windows.SetFocus(FocusHandle);
              Exit;
            end;
          end
          else
           if (((Msg = WM_ACTIVATE) and (WParam = WA_INACTIVE)) or (Msg = WM_KILLFOCUS)) and not (csDesigning in ComponentState) then
           begin
            FRefocusMDIChild := (ActiveMDIChild <> nil) and IsChild(ActiveMDIChild.Handle, GetFocus);
           end;
          {/V}
        end;
      CM_EXIT:
        if HostDockSite <> nil then DeActivate;

Ещё правки VCL (10)

procedure TCustomFrame.AddActionList(ActionList: TCustomActionList);
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
  begin
    if Form.FActionLists = nil then Form.FActionLists := TList.Create;
    if Form.FActionLists.IndexOf(ActionList) = -1 then {V}
     Form.FActionLists.Add(ActionList);
  end;
end;

Ещё правки в VCL (9)

procedure TScrollingWinControl.WMSize(var Message: TWMSize);
var
  NewState: TWindowState;
////////////////////////////////////////////////////////////////////////////////
//
// Дата изменений:                                                           {V}
//   26/11/2004                                                              {V}
// Причина изменений:                                                        {V}
//                                                                           {V}
// ***************************** ОКРУЖЕНИЕ ********************************* {V}
// Есть форма, на которой находятся два компонента, один с Align = alNone,   {V}
// другой с Align = alClient.                                                {V}
//                                                                           {V}
// ***************************** ПРОБЛЕМА ********************************** {V}
// При восстановлении окна у компонента, у которого Align = alClient не      {V}
// рисовались полосы прокрутки, в случае когда на форме в правом нижнем углу {V}
// находился компонент с Align = alNone.                                     {V}
//                                                                           {V}
// *************************** ЧТО ПРОСХОДИЛО ****************************** {V}
// 1. После восстановления окна компонент с Align = alNone уходил за пределы {V}
//    клиентской области формы, у формы появлялись полосы прокрутки;         {V}
// 2. TControl.AlignControls вызываемая по WM_SIZE, перед размещением        {V}
//    компонентов, вычисляет клиентскую область используя                    {V}
//    TControl.AdjustClientRect (virtual), которая перекрыта у               {V}
//    TScrollingWinControl и учитывает скроллеры окна:                       {V}
//
//    Rect := Bounds(-HorzScrollBar.Position, -VertScrollBar.Position,
//      Max(HorzScrollBar.Range, ClientWidth), Max(ClientHeight,
//      VertScrollBar.Range));
//    inherited AdjustClientRect(Rect);
//
// 3. Учитывая, что до восстановления окна компонент с Align = alNone        {V}
//    находился в правом, нижнем углу получается, что после вычисления       {V}
//    клиентская область до восстановления и после восстановления осталась   {V}
//    такой же и для компонента с Align = alClient размер окна не            {V}
//    изменился (AdjustClientRect до и после одинаковая);                    {V}
// 4. Далее происходит размещение компонента Align = alNone не на основе     {V}
//    AdjustClientRect, а на основе клиентской области windows ClientRect.   {V}
//    Его перемещают, в соответствии с его Anchors, в пределы клиентской     {V}
//    области формы и скроллеры исчезают;                                    {V}
// 5. AdjustClientRect изменилась, но компоненты которые уже разместили об   {V}
//    этом не узнали;                                                        {V}
//                                                                           {V}
// ****************************** РЕЗЮМЕ *********************************** {V}
// Поэтому реакция на изменение размеров происходит в цикле, и если на       {V}
// выходе размер вычисляемой клиентской области изменился то нужно           {V}
// переразместить компоненты;                                                {V}
//
////////////////////////////////////////////////////////////////////////////////
   lBeforeClientRect : TRect;                                                {V}
   lAfterClientRect  : TRect;                                                {V}
   lCycleCount : Integer;
////////////////////////////////////////////////////////////////////////////////
begin
////////////////////////////////////////////////////////////////////////////////
 lCycleCount := 0;
 repeat                                                                      {V}
  Inc(lCycleCount);
  lBeforeClientRect := GetClientRect;                                        {V}
  AdjustClientRect(lBeforeClientRect);                                       {V}
////////////////////////////////////////////////////////////////////////////////
  Inc(FAutoRangeCount);
  try
    inherited;
    NewState := wsNormal;
    case Message.SizeType of
      SIZENORMAL: NewState := wsNormal;
      SIZEICONIC: NewState := wsMinimized;
      SIZEFULLSCREEN: NewState := wsMaximized;
    end;
    Resizing(NewState);
  finally
    Dec(FAutoRangeCount);
  end;
  FUpdatingScrollBars := True;
  try
    CalcAutoRange;
  finally
    FUpdatingScrollBars := False;
  end;
  if FHorzScrollBar.Visible or FVertScrollBar.Visible then
    UpdateScrollBars;
////////////////////////////////////////////////////////////////////////////////
  lAfterClientRect := GetClientRect;                                         {V}
  AdjustClientRect(lAfterClientRect);                                        {V}
 until EqualRect(lBeforeClientRect, lAfterClientRect)                        {V}
       or (lCycleCount > 8); // устраняем зависание - http://mdp.garant.ru/pages/viewpage.action?pageId=300033419&focusedCommentId=333546939#comment-333546939
////////////////////////////////////////////////////////////////////////////////
end;