FixInsight vs VCL

Я конечно не мог пройти мимо и не проанализировать помощью FixInsight родной код Delphi. Все написанное будет касаться Delphi XE7 (точный номер версии 21.0.17017.3725). Я попытаюсь выделить что-нибудь интересное и проигнорирую мелкие проблемы вроде слишком длинных методов или вложенных операторов with (Вы когда-нибудь задумывались, сколько раз в коде VCL встречаются вложенные with? Вот лучше и не думайте никогда).

[FixInsight Warning] Vcl.RibbonStyleActnCtrls.pas(809): W512 Odd ELSE-IF condition (review lines 809 and 811)

    if Element = sbGroupStartInactive then
      LSrcRect := System.Types.Rect(0, 110, 22 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(22, 110, 46 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(47, 110, 70 - 2, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95 - 2, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);

Обратите внимание на строки 809 и 811. Условия в if одинаковые. Здесь явно что-то не так. Попробуем исправить?

Возьмем кусочек побольше, посмотрим как выглядит код вокруг.

  else if Element in [sbGroupStartInactive, sbGroupMiddleInactive,
    sbGroupEndInactive, sbGroupSingleInactive] then
  begin
    if Element = sbGroupStartInactive then
      LSrcRect := System.Types.Rect(0, 110, 22, 132)
    else if Element = sbGroupMiddleInactive then
      LSrcRect := System.Types.Rect(22, 110, 46, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(47, 110, 70, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);
  end
  else if Element in [sbGroupStartSplitInactive, sbGroupMiddleSplitInactive,
    sbGroupEndSplitInactive, sbGroupSingleSplitInactive] then
  begin
    if Element = sbGroupStartInactive then
      LSrcRect := System.Types.Rect(0, 110, 22 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(22, 110, 46 - 2, 132)
    else if Element = sbGroupEndInactive then
      LSrcRect := System.Types.Rect(47, 110, 70 - 2, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95 - 2, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);
  end
  else if Element in [sbSmallSplitHoverSplit, sbSmallSplitPressedSplit,
    sbSmallSplitInactiveSplit] then

Все еще интереснее. Вместе с условием «Element in [sbGroupStartSplitInactive, sbGroupMiddleSplitInactive, sbGroupEndSplitInactive, sbGroupSingleSplitInactive]» (строка 804), тот код, который мы нашли, совсем странно выглядит. Предположу, что это результат не очень внимательного копипаста фрагмента, который находится чуть выше (строки 794 — 802). Вероятно, на самом деле он должен был выглядеть примерно так:

  else if Element in [sbGroupStartSplitInactive, sbGroupMiddleSplitInactive,
    sbGroupEndSplitInactive, sbGroupSingleSplitInactive] then
  begin
    if Element = sbGroupStartSplitInactive then
      LSrcRect := System.Types.Rect(0, 110, 22 - 2, 132)
    else if Element = sbGroupMiddleSplitInactive then
      LSrcRect := System.Types.Rect(22, 110, 46 - 2, 132)
    else if Element = sbGroupEndSplitInactive then
      LSrcRect := System.Types.Rect(47, 110, 70 - 2, 132)
    else
      LSrcRect := System.Types.Rect(71, 110, 95 - 2, 132);
    DrawButton(RibbonSkin.Bitmap, LSrcRect, Canvas, Rect, 2, 2, 255);
  end

У меня не большой опыт работы с Ribbon-контролами, так что исправление предлагаю исключительно исходя из здравого смысла. Возможно, кому-то это удастся лучше.

Идем дальше.

[FixInsight Warning] Vcl.RibbonActnCtrls.pas(2642): W507 THEN statement is equal to ELSE statement

Опять Ribbon :)

procedure TRibbonDropDownButton.DrawBackground(var PaintRect: TRect);
var
  LPt: TPoint;
begin
  inherited;
  LPt := GetArrowPosition(PaintRect);
  if not Enabled then
    DrawArrow(LPt, clNone, clNone, -1)
  else
    DrawArrow(LPt, clNone, clNone, -1);
end;

Тут без комментариев. Очевидно, что код в then и else один и тот же. Что здесь подразумевалось, не понятно.

Аналогичный фрагмент в другом файле:

      if Assigned(Clients[I].ActionBar) then
      begin
        if Assigned(ActionProc) then
          ActionProc(Clients[I])
        else
          Clients[I].Refresh;
        UpdateActionBar(Clients[I]);
      end
      else
      begin
        if Assigned(ActionProc) then
          ActionProc(Clients[I])
        else
          Clients[I].Refresh;
        UpdateActionBar(Clients[I]);
      end;

И еще один:

        if Style <> csSimple then
          if DroppedDown then
            DrawFrameControl(C.Handle, R, DFC_SCROLL, DFCS_FLAT or DFCS_SCROLLCOMBOBOX)
          else
            DrawFrameControl(C.Handle, R, DFC_SCROLL, DFCS_FLAT or DFCS_SCROLLCOMBOBOX);

[FixInsight Warning] Vcl.Touch.Gestures.pas(1267): W503 Assignment right hand side is equal to its left hand side

function CheckPoint(const Point, Source: TPoint; Deviation,
  ErrorMargin: Integer): Double;
var
  Distance: Double;
  ErrorMarginDistance: Double;
  M, B: Double;
begin
  Deviation := Deviation;
  Distance := Sqrt(Sqr(Point.X - Source.X) + Sqr(Point.Y - Source.Y));
  ErrorMarginDistance := MulDiv(Deviation, ErrorMargin, 100);

То ли это присваивание на самом деле должно было выглядеть иначе, то ли это просто ненужный мусор.

Еще один аналогичный фрагмент:

procedure TScreenTipsWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_POPUP;
    WindowClass.Style := WindowClass.Style;
    if NewStyleControls then
      ExStyle := WS_EX_TOOLWINDOW;
    if CheckWin32Version(5, 1) then
      WindowClass.Style := WindowClass.Style or CS_DROPSHADOW;
    if NewStyleControls then
      ExStyle := WS_EX_TOOLWINDOW;
    AddBiDiModeExStyle(ExStyle);
  end;
end;

[FixInsight Warning] Vcl.AxCtrls.pas(3070): W504 Missing INHERITED call in destructor

Подобных сообщений очень много, поэтому я не буду цитировать все.

destructor TActiveXPropertyPage.Destroy;
begin
  FPropertyPageImpl.FPropertyPage.Free;
  FPropertyPageImpl.Free;
end;

Нет inherited, деструктор предка не вызывается.

Ну вот, пожалуй, на этом закончим. Как я в начале сказал, не хочется придираться к мелочам. Пишу только про то, за что зацепился взгляд. В следующей серии, возможно, расскажу про FMX или RTL :)

11 комментариев

1. Игорь Шевченко

27 Мар 2015 10:27 дп

Надо смотреть VCL от ранних версий Delphi, которую еще сам Фрэнк Борланд писал, а все новомодности до добра не доведут, что мы и видим :)

2. ildvild

27 Мар 2015 11:27 дп

Спасибо, очень интересно.
По поводу присваивания самого себя, чисто теоретический вопрос: может быть в присваивании используется сетер, который дополнительно что нибудь делает, и потому это код сделан специально?

3. Роман Янковский

27 Мар 2015 11:35 дп

Чисто теоретически да, но это не тот случай. Я проверял. В первом примере вообще параметр функции присваивается сам себе, там даже теоретически сеттера быть не может.

4. stanilar

27 Мар 2015 11:22 пп

Первый два примера показывают, как в корпоративе избегают вложенных циклов и всегда прописывают код для всех условий if (then + else).

Не смогу сейчас дать ссылку на статью, или «на пальцах» обосновать всю нужность таких требований, но в моем code rules для больших проектов, с большим количеством разработчиков, такие правила были-бы обязательными.

Рискну предположить, что код был либо портирован из С библиотеки или создан кодогенератором. Последнее весьма актуально для обертки над контролами.

Думаю что в VCL примеров такого кода будет не меньше.

З.Ы. Кстати, первый пример повторяющихся then..else не так уж и лишен смысла, если вспомнить про ассемблерный листинг. Помнится, begin+end дает дополнительную нагрузку на asm.

5. Роман Янковский

28 Мар 2015 1:35 дп

Я, честно говоря, затрудняюсь объяснить код вроде

if A in [2, 3] then
begin
  if A = 1 then
    B()
  else if A = 1 then
    C();
end;

или

if A = 1 then B() else B();

требованиями, кодогенерацией или «нагрузкой на asm». По-моему, вы просто невнимательно посмотрели на код :)

6. rx_ua

28 Мар 2015 4:10 пп

Предположительно, мотивацией к такому уг служит вознаграждение за объем, но не за качество кода. Чем больше строк, тем больше центов :).

7. Николай Зверев

29 Мар 2015 12:06 дп

Это больше похоже на черновой код и/или код, из которого вырезаны комментарии

(При написании кода в первый раз условие, или выражение составное, потом после прогона часть выражения комментируется, а затем комментарии вырезаются автоматически и получается два идентичных выражения)

8. FixInsight vs RTL

30 Мар 2015 6:02 пп

[…] посте я продолжу анализ библиотек поставляемых с Delphi. В прошлый раз мы заглянули внутрь Delphi VCL, а в этот раз будем […]

9. FixInsight vs FMX

11 Апр 2015 2:36 пп

[…] с Delphi. В предыдущих сериях я рассмотрел Delphi VCL и RTL. Как обычно я постараюсь найти все самое […]

10. q1w2e

27 мая 2015 12:38 пп

Роман, и в первых приведенных Вами примерах, и в сообщении 5, до тех пор, пока не видно что прячется за идентификатором Elements (или за идентификатором A), все еще можно допускать наличие здравого смысла у авторов кода :)

11. q1w2e

27 мая 2015 2:25 пп

if PrintNextPage in [pt_LocalPrinter, pt_NetworkPrinter] then
begin
if PrintNextPage = pt_Error then
ErrorPrintSecondPage()
else if PrintNextPage = pt_NoPaper then
ErrorPrintLastPage();
end;

Оставьте комментарий

Роман.Янковский.me

Tuo tibi iudicio est utendum

FixInsight vs VCL