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

http://mikesoft.ws/samples/color-browser

http://mikesoft.ws/products/text-converter

Другие программы тоже на подходе Следите за изменениями на сайте.

Ответ был найден на MSDN форуме, но применительно к MFC. Но в Delphi эта проблема также встречается и решается аналогично. Вот исходный код, который поможет исправить проблему. Его нужно добавить к дочернему окну (FormStyle = fsMDIChild).

type
  TMDIChild = class(TForm)
  private
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  ...
  end;
...
(*
Оригинальный комментарий к решению:
--------------------------------------------------------------------------------
Заплатка на MFC версий ниже 8.0
 
В MFC версиях 8.0 на Vista есть проблема, когда
окно дочернего MDI фрейма максимизируется при максимизированном
родительском MDI фрейме. В этом случаи максимальный размер окна ограничивается
данными структуры MINMAXINFO, которые были вычесленны ранее
системой при заданных стилях окна.
 
Однако сам MFC в процессе ресайза этого окна любит менять ему
стили на ходу в результате система путается и MINMAXINFO содержит неправильные
данные.
 
Это было не критично на XP и более старых системах, т.к. ошибка
была в 1 пиксель, теперь же на Vista, когда бордюр имеет занчительную ширину (4
пикселя), эта ошибка стала заметна (как раз на эту ширину - 4 пикселя).
 
Чтобы исправить ошибу я вручную правлю структуру MINMAXINFO под
максимально возможный размер окна.
--------------------------------------------------------------------------------
 
Smike: Похоже этот баг перенесли и в Delphi :)
*)
 
procedure TMDIChild.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  if WindowState <> wsMaximized then
    inherited
  else
    with Message.MinMaxInfo^ do
    begin
      if ptMaxTrackSize.X < ptMaxSize.X then ptMaxTrackSize.X := ptMaxSize.X;
      if ptMaxTrackSize.Y < ptMaxSize.Y then ptMaxTrackSize.Y := ptMaxSize.Y;
    end;
{ // Если не жалко пару десятков килобайт
  // в исполняемом файле - можно использовать функции модуля Math
  if WindowState <> wsMaximized then
    inherited
  else
    with Message.MinMaxInfo^ do
    begin
      ptMaxTrackSize.X := Max(ptMaxTrackSize.X, ptMaxSize.X);
      ptMaxTrackSize.Y := Max(ptMaxTrackSize.Y, ptMaxSize.Y);
    end;}
end;

Поэтому пришлось написать свою программу, которой удалось проверить контрольные суммы всего этого архива. И решил выложить ее вместе с исходными кодами, в качестве примера и в память о Виталие Невзорове (Vit-е). Код MD5 был взят из его Delphi Russian Knowledge Base.

http://mikesoft.ws/samples/md5-crc-calculator/

http://mikesoft.ws/components/fileenum/

Долгое время сайт http://mikesoft.ws указывал на http://smike.drkb.ru. Все старые материалы лежат там до сих пор. Затем было решено сделать отдельный сайт на базе CMS Drupal. Но все оказалось не так просто: сложная заумная структура, отсутствие нормальных тем для последней версии CMS, сложность установки модулей долгое время убивало желание наконец-то взяться за контент.

Но стоило только попробовать WordPress как ситуация коренным образом изменилась. Все просто, все логично, все работает и работает быстро. Нету такого количества малопонятных пунктов меню. Особо стоит сказать об установке плагинов — это делается одним кликом! Тем более я удивился, потому что последнее время приходится немало возиться с недешевым поделием под названием Invision Power Board, которому ничего подобного и не снилось (приходится пилить, пилить и еще раз пилить). Так же, автоматически, одним кликом можно обновить WordPress до последней версии.

С такой системой управления сайтом легко работать и легко его поддерживать сайт. Остается только работать над контентом В ближайшее время я собираюсь перенести материал со своих бывших блогов http://mikeonsoftware.spaces.live.com/blog/ и http://smikeblog.blogspot.com/, сайта http://smike.drkb.ru, а также выложить новые и обновленные версии своих продуктов.

Существовала когда-то библиотека компонентов для Delphi под названием RX Library. Для своего времени это была отличная библиотека, содержала множество полезных компонентов и функций. Со временем библиотека перестала разиваться, теперь она только адаптируется к новым версиям Delphi, для поддержания обратной совместимости (http://rx.delphiplus.org/, http://sourceforge.net/projects/rxlib/). Код этой библиотеки без существенных изменений (кроме названий компонентов) был перенесен в JEDI VCL.

Вместе с множеством полезных RTL-функций была унаследована и функция перевода чисел из десятичной системы счисления в римскую. История этой функции мне неизвестна, но её главной особенностью является наличие оператора безусловного перехода goto (модули rxStrUtils, JvJCLUtils):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

function IntToRoman(Value: Longint): string;
Label
  A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
begin
  Result := '';
  while Value >= 1000 do begin
    Dec(Value, 1000); Result := Result + 'M';
  end;
  if Value < 900 then goto A500
  else begin
    Dec(Value, 900); Result := Result + 'CM';
  end;
  goto A90;
A400:
  if Value < 400 then goto A100
  else begin
    Dec(Value, 400); Result := Result + 'CD';
  end;
  goto A90;
A500:
  if Value < 500 then goto A400
  else begin
    Dec(Value, 500); Result := Result + 'D';
  end;
A100:
  while Value >= 100 do begin
    Dec(Value, 100); Result := Result + 'C';
  end;
A90:
  if Value < 90 then goto A50
  else begin
    Dec(Value, 90); Result := Result + 'XC';
  end;
  goto A9;
A40:
  if Value < 40 then goto A10
  else begin
    Dec(Value, 40); Result := Result + 'XL';
  end;
  goto A9;
A50:
  if Value < 50 then goto A40
  else begin
    Dec(Value, 50); Result := Result + 'L';
  end;
A10:
  while Value >= 10 do begin
    Dec(Value, 10); Result := Result + 'X';
  end;
A9:
  if Value < 9 then goto A5
  else begin
    Result := Result + 'IX';
  end;
  Exit;
A4:
  if Value < 4 then goto A1
  else begin
    Result := Result + 'IV';
  end;
  Exit;
A5:
  if Value < 5 then goto A4
  else begin
    Dec(Value, 5); Result := Result + 'V';
  end;
  goto A1;
A1:
  while Value >= 1 do begin
    Dec(Value); Result := Result + 'I';
  end;
end;

Была ли эта функция переведена дословно с языка BASIC или написана с нуля — теперь это не так уж важно. Главное, что в современном программировании GOTO нет места. И эта моя публикация нацелена на то, чтобы в очередной раз это подтвердить. Несмотря на отдельные доводы в пользу оператора GOTO: например, что он обеспечивают лучшую производительность по сравнению со стандартными методами структурного программирования.

Если не смотреть на вышеприведенный код (так как в нем с трудом можно что-то понять, только сбить себя с толку), а задаться целью написать функцию перевода в римскую систему счисления с нуля, то она будет выглядеть примерно так:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

function IntToRoman(Value: Longint): string;
type
  TRomanRec = record
    Str: string;
    Amount: Integer
  end;
const
  Roman: array [1..13] of TRomanRec = (
    (Str:  'M'; Amount: 1000),
    (Str: 'CM'; Amount:  900),
    (Str:  'D'; Amount:  500),
    (Str: 'CD'; Amount:  400),
    (Str:  'C'; Amount:  100),
    (Str: 'XC'; Amount:   90),
    (Str:  'L'; Amount:   50),
    (Str: 'XL'; Amount:   40),
    (Str:  'X'; Amount:   10),
    (Str: 'IX'; Amount:    9),
    (Str:  'V'; Amount:    5),
    (Str: 'IV'; Amount:    4),
    (Str:  'I'; Amount:    1)
  );
var
  R: TRomanRec;
begin
  Result := '';
 
  for R in Roman do
    while Value >= R.Amount do
    begin
      Result := Result + R.Str;
      Dec(Value, R.Amount);
    end;
end;

Здесь реализован простейший алгоритм перевода. Последовательно вычитая из исходного числа значения римских чисел или их сочетаний, мы получаем строковое представление данного числа. Что касается производительности, то эта функция действительно несколько медленнее варианта с GOTO. От 8% до 30% в зависимости от диапазона чисел (чем больше — тем меньше разница, 8% на переводе чисел от единицы до миллиона). Сторонники GOTO радостно возликовали бы на этом месте и успокоились, продолжая использовать функцию с GOTO. Но я как сторонник структурного программирования решил на этом не останавливаться, а проанализировать внимательно алгоритм.

Первое узкое место, которое бросается в глаза — формирование строки в цикле. Мало того, что такая операция является ресурсоемкой, приводя к лишним операциям выделения памяти, она гораздо медленнее, чем простая функция div, которую было бы достаточно выполнить всего один раз для одной римской цифры. Она возвратила бы количество римских чисел, а сформировать строку можно было бы функцией StringOfChar (модуль SysUtils), которая написана на ассемблере и имеет отличную производительность.

Но здесь всплывает иная сложность: как формировать строку из нескольких символов (таких как промежуточные значения CM=900, CD=400 и т.д.). Здесь два варианта: либо писать универсальную функцию, которая будет формировать строку не из символов, а из одинаковых строковых фрагментов, либо отказаться от промежуточных значений. Первый вариант существенно снизит производительность, поэтому возьмемся за другой вариант. В нем не все так сложно, как могло бы показаться на первый взгляд. Если внимательно посмотреть на ряд римских чисел

I, V, X, L, C, D, M

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

function IntToRomanOptimized(Value: Longint): string;
type
  TRomanRec = record
    Symbol: Char;
    Amount: Word;
  end;
const
  // Отмеченные "+" элементы используются для уменьшения предыдущих значений,
  // все они на нечетных местах 
  Roman: array [1..7] of TRomanRec = (
    (Symbol: 'M'; Amount: 1000),  // 1
    (Symbol: 'D'; Amount:  500),  // 2
    (Symbol: 'C'; Amount:  100),  // 3 +
    (Symbol: 'L'; Amount:   50),  // 4
    (Symbol: 'X'; Amount:   10),  // 5 +
    (Symbol: 'V'; Amount:    5),  // 6
    (Symbol: 'I'; Amount:    1)   // 7 +
  );
var
  I: Integer;
  R: TRomanRec;  
begin
  Result := '';
 
  for I := Low(Roman) to High(Roman) do
  begin
    R := Roman[I];
    if Value >= R.Amount then
    begin
      Result := Result + StringOfChar(R.Symbol, Value div R.Amount);
      Dec(Value, Value div R.Amount * R.Amount);
    end;
 
    if R.Amount > 1 then
      with Roman[I + Ord(Odd(I)) + 1] do
        if Value >= R.Amount - Amount then
        begin
          Result := Result + Symbol + R.Symbol;
          Dec(Value, R.Amount - Amount);
        end;
  end;
end;

Новый вариант функции готов, теперь перейдем к тестированию производительности. И она не может не радовать! На переводе чисел от 1 до 100 000 оптимизированный вариант работает в 2 раза быстрее, чем с GOTO. На 200 000 — в 3 раза быстрее, на 300 000 — в 4 раза, а на числах до миллиона — более чем в 13 (!) раз быстрее. И это еще раз подтверждает, что GOTO пора на пенсию, время грамотного программирования!

В первую очередь, я нашел в нем ту функциональность, которая как раз была мне нужна. В приложении необходимо создавать и выбирать файлы в определенной папке и её подпапках. В TOpenDialog нельзя запретить смену каталога. В TFileOpenDialog — можно! Появилось событие OnFolderChanging, где вот таким вот простым кодом мы можем запретить, например, переходить в папки нижнего уровня по сравнению с начальной:

procedure TForm1.FolderChangingEvent(Sender: TObject;
  var CanChange: Boolean);
begin
  CanChange := AnsiStartsText(FileOpenDialog1.DefaultFolder,
                              FileOpenDialog1.FileName);
end;

Это как раз реализует нужную мне функциональность. Это одна из тех «мелочей», которыми наполнена Windows Vista, но которые так приятно облегчают работу и программистов, и пользователей.

Какие же еще возможности приподносит нам TFileOpenDialog? Это события OnFileOkClick, которое позволяет запретить закрывать диалог в случае неудовлетворительного выбора, и OnShareViolation, позволяющее задавать реакцию на выбор файлов, используемых другими приложениями.

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

TFileDialogOption = (
 fdoOverWritePrompt,
 fdoStrictFileTypes,
 fdoNoChangeDir,
 fdoPickFolders,
 fdoForceFileSystem,
 fdoAllNonStorageItems,
 fdoNoValidate,
 fdoAllowMultiSelect,
 fdoPathMustExist,
 fdoFileMustExist,
 fdoCreatePrompt,
 fdoShareAware,
 fdoNoReadOnlyReturn,
 fdoNoTestFileCreate,
 fdoHideMRUPlaces,
 fdoHidePinnedPlaces,
 fdoNoDereferenceLinks,
 fdoDontAddToRecent,
 fdoForceShowHidden,
 fdoDefaultNoMiniMode,
 fdoForcePreviewPaneOn
);

Остановимся на значениях, не имеющих аналогов. Часть из них настраивает вид самого диалога:

• fdoForcePreviewPaneOn отображает панель предварительного просмотра;
• fdoDefaultNoMiniMode запрещает открытие диалога в сжатом виде (только строка ввода имени файла) — только для диалогов сохранения;
• fdoHidePinnedPlaces убирает стандартные избранные ссылки, собственные мы по прежнему можем задавать (!);
• fdoHideMRUPlaces описывается как «Hide places of recently opened or saved items», но реально мне не удалось пока понять, о чем идет речь.

Значение fdoPickFolders позволяет использовать диалог открытия файлов как диалог выбора папок, а fdoStrictFileTypes позволяет указать, что нужно сохранять файл только с одним из предопределенных расширений.

А вот свойство fdoNoChangeDir хоть и есть среди возможных значений, но как уверяет справочная система, это значение не используется. Это и не удивительно, ведь есть более гибкое событие OnFolderChanging.

В новом диалоге есть и другие полезные свойства и методы. С помощью коллекции FavoriteLinks можно добавлять собственные избранные ссылки. Свойства FileNameLabel, OKButtonLabel, Title позволяют изменить названия отдельных элементов интерфейса диалога (текст перед полем ввода файла, текст кнопки OK и заголовок диалога). Старый TOpenDialog позволял изменять только собственный заголовок. Коллекция FileTypes более наглядно, чем свойство Filter из TOpenDialog позволяет задавать фильтры для диалога. Особенно удобно, что это индексированный список, таким образом легко можно проверить, какому расширению соответствует тот или иной тип, используя свойство FileTypeIndex.

Скачать модифицированный вариант можно здесь:
http://mikesoft.ws/components/mousepan/

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

В Delphi VCL сделать такую возможность совсем не сложно. За отображение главного меню приложения отвечает компонент TMainMenu и свойство TForm.Menu. В компоненте хранятся элементы меню, а в свойстве указывается ссылка на этот компонент. Соотвественно, если указано свойство TForm.Menu, то меню отображается и наоборот.

Решение данной задачи можно разбить на следующие пункты:

• обеспечение простого способа скрытия и отображения меню;
• отображение и скрытие меню по нажатию клавиши Alt;
• скрытие меню при клике мышью в окне приложения.

Чтобы обеспечить удобную возможность скрытия меню, можно написать свойство MenuVisible для формы. Код получения значения данного свойства будет проверять, задано ли свойство TForm.Menu:

type
  TMyForm = class(TForm)
    MainMenu: TMainMenu;
...
  private
    function GetMenuVisible: Boolean;
    procedure SetMenuVisible(const Value: Boolean);
  public
    property MenuVisible: Boolean read GetMenuVisible
                                 write SetMenuVisible;
  end;
 
implementation
 
{$R *.dfm}
 
function TMyForm.GetMenuVisible: Boolean;
begin
  Result := Assigned(Menu);
end;

Код установки значения свойства MenuVisible будет изменять свойство TForm.Menu, чтобы отобразить или скрыть главное меню. Вдобавок, если приложение не развернуто на весь экран, было бы удобно увеличивать высоту окна при появлении меню и уменьшать его при скрытии. Таким образом установленный пользователем размер рабочей области окна приложения не будет изменяться. Чтобы во время данных операций не наблюдалось мерцание, вышеописанный код следует обрамить блоком DisableAlign-EnableAlign.

procedure TMyForm.SetMenuVisible(const Value: Boolean);
begin
  if Value = MenuVisible then Exit;
 
  DisableAlign;
  try
    if Value then
      Menu := MainMenu
    else
      Menu := nil;
 
    if WindowState <> wsMaximized then
      Height := Height + GetSystemMetrics(SM_CYMENU) *
                (Ord(Value) or Ord(not Value) * -1);
  finally
    EnableAlign;
  end;
end;

Решение следующего пункта состоит в обработке нажатия клавиши Alt в событии OnKeyUp формы. Это решается простым кодом:

procedure TMyForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_MENU: MenuVisible := not MenuVisible;
    VK_ESCAPE: MenuVisible := False;
  end;
end;

В этом коде также добавлена обработка клавиши Esc, после нажатия которой меню скрывается. Почему именно OnKeyUp? Дело в том что обе клавиши, Alt и Esc, используются в самом меню, поэтому обработка OnKeyDown будет работать неправильно, а точнее через раз.

Следует обратить внимание, что в коде для обработки нажатия Alt используется не состояние служебных клавиш, передаваемое в параметре Shift типа TShiftState, а значение нажатой клавиши, передаваемое в параметре Key. Чтобы это событие работало не зависимо от того, какие и сколько компонентов на форуме, следует установить свойство TForm.KeyPreview в True.

Ну и последний вопрос — как обработать клик мыши в окне приложения, чтобы скрывать при этом меню. В этом нет ничего сложного и возможностей VCL здесь вполне достаточно. Нужно обработать свойство TForm.OnMouseActivate.

procedure TMyForm.FormMouseActivate(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y, HitTest: Integer;
  var MouseActivate: TMouseActivate);
begin
  if MenuVisible then
    MenuVisible := False;
end;