Delphi в Интернет, блог Delphi программистов

Тема "доработки" стандартных компонентов, поднята мною не случайно. Зачастую приходится сталкиваться с разнообразными недостатками стандартных компонентов. Как правило эти недостатки связаны не столько с кривостью компонента, сколько с недостаточной функциональностью. Вот и я в очередной раз столкнулся с этим вопросом.

Писать лишние строки кода в программу для предания "псевдофункционала", занятие не благодарное. Самым распространенным примером, таких самоистязаний, пожалуй служит совмещение нескольких контролов в один. Так скажем поверх TaskBar "накладывают" всевозможные TrackBar-ы, ProgresBar-ы, и прочие радости жизни; скрытые Edit-ы также лепят поверх Label-ов, что-бы реализовать возможность "удобного" редактирования; ComboBox-ы совмещают со всем чем только не лень.

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

Что и как делалось

Компонент писался под конкретные нужды, и как говорилось выше по причине недостатка функциональности стандартного контрола. Для реализации используется редекларация некоторых событий, для обработки поведения, и модуль Themes для использования стиля оформления Windows.

Для обработки событий, без потери их функциональнасти в дальнейшей работе с компонентом, подменяем события предка на свои, с теми-же именами.
Объявляем свои события:

{..............................}
private
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseDown: TMouseEvent;
    FOnDrawCell: TDrawCellEvent;
{..............................}
published
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
{..............................}

и обработчики событий предка:

{..............................}
private
    procedure CheckDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure CheckMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure CheckMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CheckMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
{..............................}

Вконце каждого обработчика вызываем соответствующее ему событие:

{..............................}
procedure TStringGridCheck.CheckMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
{..............................}
  if Assigned(FOnMouseMove) then // вызываем событие
    FOnMouseMove(Sender, Shift, X, Y);
end;
{..............................}

Привязываем наши обработчики к событиям предка в конструкторе:

{..............................}
public
  constructor Create(AOwner: TComponent); override;
{..............................}
constructor TStringGridCheck.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited OnMouseMove := CheckMouseMove; //"перехватываем" на обработку
  inherited OnMouseUp := CheckMouseUp;     //необходимые событие предка
  inherited OnMouseDown := CheckMouseDown;
  inherited OnDrawCell := CheckDrawCell;
end;
{..............................}

Для отображения check-элементов, используем методы ThemeServices из модуля Themes:

• ThemeServices.GetElementDetails возвращает нужный элемент,
• ThemeServices.DrawElement рисует его на канве.

Отрисовываем check-элементы по разному в зависимости от их состояния:

{..............................}
procedure TStringGridCheck.CheckDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Hot: Boolean;
{..............................}
begin
{..............................}
      if Checked[ARow] then // стоит галочка
      begin
        if Hot then // мышь над ячейкой
          ThemeServices.DrawElement(Canvas.Handle, // рисуем подсвеченную галку
            ThemeServices.GetElementDetails(tbCheckBoxCheckedHot), Rect)
        else
          ThemeServices.DrawElement(Canvas.Handle, // рисуем обычную галку
            ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal), Rect)
      end
      else // иначе рисуем пустой чек по аналогии
        if Hot then
        ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails
            (tbCheckBoxUncheckedHot), Rect)
      else
        ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails
            (tbCheckBoxUncheckedNormal), Rect);
{..............................}

Добавляем в компонент свойство Checked для работы с состоянием полученных элементов:

{..............................}
private
    function GetChecked(Index: Integer): Boolean;
    procedure PutChecked(Index: Integer; const B: Boolean);
{..............................}
  public
    property Checked[Index: Integer]: Boolean read GetChecked write PutChecked;
{..............................}
function TStringGridCheck.GetChecked(Index: Integer): Boolean;
begin
  Result := (RowCount > Index) and (Index >= FixedRows) and
    (ColCount - FixedCols > CheckCollIndex) and        //возвращаем chek-статус строки
    (Cells[CheckCollIndex + FixedCols, Index] = '-1');
end;
procedure TStringGridCheck.PutChecked(Index: Integer; const B: Boolean);
begin
  if (RowCount > Index) and (Index >= FixedRows) and
    (ColCount - FixedCols > CheckCollIndex) and (CheckCollIndex > -1) then
  begin  //устанавливаем новое значение ячейке
    Cells[CheckCollIndex + FixedCols, Index] := BoolToStr(B, False);
    if Assigned(fOnCheked) then
      fOnCheked(Self, Index, B);
  end;
end;
{..............................}

И объявляем OnChecked событие:

{..............................}
 type
TChekedGridEvent = procedure(Sender: TObject; const ARow: Integer;
    const RowChecked: Boolean) of object;
{..............................}
private
    fOnCheked: TChekedGridEvent;
{..............................}
published
    property OnCheked: TChekedGridEvent read fOnCheked write fOnCheked;
{..............................}

Регестрируем компонент в Delphi, и пользуемся простым и удобным в использовании TStringGridCheck. На всю работу по "доработке" уходит от 20 минут до пары часов, в зависимости от сложности требуемого результата и возможностей самого разработчика. Результат говорит сам за себя, работа с новым компонентом ничуть не сложнее чем с его предком, плюс его функциональность теперь действительно соответствует нашим нуждам. Готовый пример применения вы сможете посмотреть в программе Хронометр 2.

Текущая версия TStringGridCheck v.2.1

В версии 2.0 добавлена возможность управлять check-статусом с клавиатуры, устранено несколько багов при включении различных опций. Добавлена возможность выбирать в качестве CheckColumn колонку из FixedColumn. Исправлено отображение выделенных ячеек.
В версии 2.1 было исправлено поведение при выключенном стиле XP, а также цвет выделенного текста.
Компонент Delphi TStringGridCheck v.2.1(444.7 KB)

 
Компонент Delphi TStringGridCheck для Delphi 7 v.2.1(15.55 KB)

Мой блог находят по следующим фразам

• Работа с XML-RPC в Delphi
• RPC Components for Delphi
• "Delphi 2010" +ini +компонент
• Ribbon Controls
• работа с xml в lazarus
• word иконка объекта
• Delphi в Internet

Делись!	Загружай!	Плюсуй!
	Отправить PDF на

Комментарии (10)

• Роман пишет:
  08 Окт 2009 в 8:22 пп

  Пытаюсь установить на Delphi 7:
  [Error] StringGridChecker.pas (106): Incompatible types:  ‘Integer’ and ‘String’
  [Error] StringGridChecker.pas (106): Incompatible types:  ‘Integer’ and ‘Set’
  Вот эта строка:  Canvas.TextRect(Rect, s, [tfEndEllipsis]);
  Неужели не попользоваться?((

• Andrey пишет:
  08 Окт 2009 в 8:23 пп

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

• SeregaAltmer пишет:
  08 Окт 2009 в 9:54 пп

  Нужно заменить строку
  Canvas.TextRect(Rect, s, [tfEndEllipsis]);
  на
  Canvas.TextRect(Rect, 0, 0, s);
  кроме того для D7 лучше удалить из Create строку
  Options := Options — [goFixedHorzLine, goFixedVertLine, goHorzLine,
  goVertLine];
  и в Uses добавить модуль XPMan
  или скачать свежевыложенный исходник для D7))).
  Если будут идеи, или предложения обращайтесь, с удовольствием помогу.

• Евгений пишет:
  09 Окт 2009 в 9:34 дп

  Ругается на модуль Themes.  Где его взять?

• SeregaAltmer пишет:
  09 Окт 2009 в 12:02 пп

  А какая операционная система стоит, и версия делфи?
  Мною тестировался пока только на XP. На версиях до XP работать точно не будет, а на последующих не могу сказать на верняка, нужно проверять и возможно что-либо переделывать.

• SeregaAltmer пишет:
  09 Окт 2009 в 12:35 пп

  Компонент был обновлен! Список изменений читайте выше.

• Роман пишет:
  09 Окт 2009 в 1:54 пп

  Спасибо за компонент для D7, всё отлично работает) И за демо огромное спасибо

• SeregaAltmer пишет:
  09 Окт 2009 в 3:38 пп

  Не за что). Если будут какие-то идеи или предложения по этой теме, обращайтесь.

• SeregaAltmer пишет:
  11 Окт 2009 в 3:09 дп

  Выложена версия 2.1!

• Photo пишет:
  12 Окт 2009 в 7:00 пп

  Спасибо большое  за демку, поковырялся)

Ваш ответ