Главная » Delphi » TddgTabbedListBox — расширение компонентаTListBox

0

Компонент TListBox библиотеки VCL в Object Pascal  является оболочкой стан дартного элемента управления Win32 LISTBOX. Совершенству нет  предела, поэтому, хотя  компонент TListBox инкапсулирует большую часть  функций элемента Win32, все же попытаемся его расширить. В настоящем разделе проанализируем шаг за ша гом  процесс создания пользовательского компонента  на  базе  стандартного компо нента  TListBox.

Идея

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

План  создания такого  компонента прост:  создается потомок класса  TListBox с

корректными свойствами полей, переопределенными методами и новыми методами,

предназначенными для получения желаемого поведения компонента.

Код

Первым шагом  в создании прокручиваемого списка  с позициями табуляции явля ется  включение  соответствующих оконных  стилей  в  стиль  компонента TddgTab- Listbox при создании окна списка. К необходимым оконным стилям  относятся стиль lbs_UseTabStops для  табуляции и стиль  ws_HScroll для  горизонтальной полосы прокрутки. Для добавления оконных стилей к потомку  класса  TWinControl необхо димо переопределить метод CreateParams(), как показано в следующем коде:

procedure TddgTabListbox.CreateParams(var Params: TCreateParams);

begininherited CreateParams(Params);

Params.Style := Params.Style or lbs_UseTabStops or ws_HScroll;

end;

Для  установки позиций табуляции компонент TddgTabListbox создает  сообще ние lb_SetTabStops, передавая ему количество позиций табуляции и указатель на их массив  в параметрах wParam и  lParam соответственно. Эти  две  переменные будут храниться в классе —  в полях  FNumTabStops и FTabStops. Единственная сложность состоит в том, что позиции табуляции в окне списка  обрабатываются с использовани ем единиц измерения диалоговых окон (dialog box units). Delphi не поддерживает никаких других единиц измерения, кроме  пикселей, поэтому  придется приводить позиции та буляции  к пикселям. С помощью модуля PixDlg.pas, код которого приведен в лис тинге  11.11, можно преобразовывать единицы измерения диалоговых окон для осей X и Y в экранные пиксели и обратно.Метод CreateParams()

Если необходимо изменить один из параметров (таких как стиль или класс окна), переда- ваемых функции API CreateWindowEx(), то следует воспользоваться методом Create- Params(). Функция CreateWindowEx() используется для создания дескриптора окна, свя- занного с потомком класса TWinControl. Переопределение метода CreateParams() по- зволит управлять созданием окна на уровне интерфейса API.

Методу CreateParams() передается один параметр типа TCreateParams:

TCreateParams = record Caption: PChar; Style: Longint; ExStyle: Longint;

X, Y: Integer;

Width, Height: Integer;

WndParent: HWnd;

Param: Pointer;

WindowClass: TWndClass;

WinClassName: array[0..63] of Char;

end;

Разработчики компонентов осуществляют переопределение метода CreateParams() всякий раз, когда возникает необходимость управлять созданием компонента на уров- не API. При этом нельзя забывать, что вначале обязательно нужно вызвать унаследо- ванный метод CreateParams() для заполнения записи Params.

Листинг 11.11. Исходный код модуля PixDlg.pas

unit Pixdlg;

interface

function DialogUnitsToPixelsX(DlgUnits: word): word; function DialogUnitsToPixelsY(DlgUnits: word): word; function PixelsToDialogUnitsX(PixUnits: word): word; function PixelsToDialogUnitsY(PixUnits: word): word;implementation uses WinProcs;

function DialogUnitsToPixelsX(DlgUnits: word): word;

begin

Result := (DlgUnits * LoWord(GetDialogBaseUnits)) div 4;

end;

function DialogUnitsToPixelsY(DlgUnits: word): word;

begin

Result := (DlgUnits * HiWord(GetDialogBaseUnits)) div 8;

end;

function PixelsToDialogUnitsX(PixUnits: word): word;

begin

Result := PixUnits * 4 div LoWord(GetDialogBaseUnits);

end;

function PixelsToDialogUnitsY(PixUnits: word): word;

begin

Result := PixUnits * 8 div HiWord(GetDialogBaseUnits);

end;

end.Зная позиции табуляции, можно  вычислить протяженность горизонтальной полосы прокрутки. Она должна быть больше  самой длинной строки списка.  К счастью, в интер фейсе API Win32 есть  функция GetTabbedTextExtent(), возвращающая именно эту информацию. Если известен размер самой длинной строки, то можно установить диапа зон прокрутки, создав сообщение lb_SetHorizontalExtent, передающее требуемый размер в качестве параметра wParam.

Кроме  того,  следует написать обработчики для некоторых специальных сообщений

Win32.  В частности, необходимо обеспечить обработку сообщений, управляющих вставкой и удалением, для того чтобы  иметь  возможность измерить длину любой новой строки или определить, не удалена ли самая длинная строка. В этом смысле особый ин терес  будут представлять такие  сообщения, как  lb_AddString, lb_InsertString и lb_DeleteString.

В   листинге 11.12   содержится   исходный  код   модуля   LbTab.pas компонента

TddgTabListbox.

Листинг 11.12. LbTab.pas — исходный  код компонента TddgTabListBox

unit Lbtab;

interface

uses

SysUtils, Windows, Messages, Classes, Controls, StdCtrls;type

EddgTabListboxError = class(Exception); TddgTabListBox = class(TListBox)

private

FLongestString: Word;

FNumTabStops: Word;

FTabStops: PWord;

FSizeAfterDel: Boolean;

function GetLBStringLength(S: String): word;

procedure FindLongestString;

procedure SetScrollLength(S: String);

procedure LBAddString(var Msg: TMessage);

message lb_AddString;

procedure LBInsertString(var Msg: TMessage);

message lb_InsertString;

procedure LBDeleteString(var Msg: TMessage);

message lb_DeleteString;

protected

procedure CreateParams(var Params: TCreateParams); override;

public

constructor Create(AOwner: TComponent); override;

procedure SetTabStops(A: array of word);

published

property SizeAfterDel: Boolean read FSizeAfterDel

write FSizeAfterDel default True;

end; implementation uses PixDlg;

constructor TddgTabListBox.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FSizeAfterDel := True;

{ Установить позиции табуляции по умолчанию. }

FNumTabStops := 1;

GetMem(FTabStops, SizeOf(Word) * FNumTabStops);

FTabStops^ := DialogUnitsToPixelsX(32);

end;

procedure TddgTabListBox.SetTabStops(A: array of word);

{ Эта процедура устанавливает позиции табуляции списка равными

значениям, заданным в открытом массиве слов A. Новые позиции

табуляции указаны в пикселях и отсортированы в порядке возрастания.

При невозможности установить новую позицию табуляции передается

исключение. }

var

i: word;

TempTab: word;

TempBuf: PWord;begin

{ Сохранить новые значения во временных переменных на случай

возникновения исключения при установке позиций табуляции. }

TempTab := High(A) + 1;          // Количество позиций табуляции

GetMem(TempBuf, SizeOf(A));      // Выделение памяти

Move(A, TempBuf^, SizeOf(A));// Копирование новых позиций таб.

{ Перевод пикселей в единицы диалогового окна и… }

for i := 0 to TempTab – 1 do

A[i] := PixelsToDialogUnitsX(A[i]);

{ передача новых позиций табуляции в список. Обратите внимание:

использовать следует только единицы диалогового окна. }

if Perform(lb_SetTabStops, TempTab, Longint(@A)) = 0 then begin

{ Если значение выражения равно нулю, то новые позиции

табуляции установить невозможно, временный буфер табуляции

очищается и передается исключение. }

FreeMem(TempBuf, SizeOf(Word) * TempTab);

raise EddgTabListboxError.Create(‘Failed to set tabs.’)

end else begin

{ Если выражение не равно нулю, то это означает, что

установлены новые позиции табуляции и можно освободить

предыдущие. }

FreeMem(FTabStops, SizeOf(Word) * FNumTabStops);

{ Копирование значений из временных переменных … }

FNumTabStops := TempTab;        // Установка количества позиций таб.

FTabStops := TempBuf;           // Установка табуляции из буфера

FindLongestString;              // Переустановка полосы прокрутки

Invalidate;                     // Перерисовка

end;

end;

procedure TddgTabListBox.CreateParams(var Params: TCreateParams);

{ Необходимо добавить стили для табуляции и горизонтальной

прокрутки. Эти стили будут использованы

функцией API CreateWindowEx(). }

begin

inherited CreateParams(Params);

{ Стиль lbs_UseTabStops позволяет использовать в списке

табуляцию; стиль ws_HScroll позволяет выполнять горизонтальную

прокрутку списка. }

Params.Style := Params.Style or lbs_UseTabStops or ws_HScroll;

end;

function TddgTabListBox.GetLBStringLength(S: String): word;

{ Эта функция возвращает длину строки S в пикселях. }

var

Size: Integer;

begin

// Получить длину строки текста

Canvas.Font := Font;

Result := LoWord(GetTabbedTextExtent(Canvas.Handle, PChar(S),

StrLen(PChar(S)), FNumTabStops, FTabStops^));

{ Добавляет немного пространства в конец полосы прокрутки для

улучшения ее внешнего вида. }Size := Canvas.TextWidth(‘X’); Inc(Result, Size);

end;

procedure TddgTabListBox.SetScrollLength(S: String);

{ Эта процедура изменяет длину полосы прокрутки, если строка S

длиннее самой длинной предыдущей строки. }

var

Extent: Word;

begin

Extent := GetLBStringLength(S);

// Если эта строка оказалась самой длинной…

if Extent > FLongestString then begin

// установить самую длинную строку

FLongestString := Extent;

// установить размер полосы прокрутки

Perform(lb_SetHorizontalExtent, Extent, 0);

end;

end;

procedure TddgTabListBox.LBInsertString(var Msg: TMessage);

{ Эта процедура вызывается в ответ на сообщение lb_InsertString,

которое посылается списку каждый раз, когда вставляется новая

строка. Поле Msg.lParam содержит указатель на вставляемую строку.

Если новая строка длиннее любой имеющейся, настраивается размер

полосы прокрутки. }

begin

inherited;

SetScrollLength(PChar(Msg.lParam));

end;

procedure TddgTabListBox.LBAddString(var Msg: TMessage);

{ Эта процедура вызывается в ответ на сообщение lb_AddString,

которое передается списку каждый раз, когда добавляется новая

строка. Поле Msg.lParam содержит указатель на добавляемую строку с

завершающим нулевым символом. Если новая строка длиннее любой

строки списка, то настраивается размер полосы прокрутки. }

begin

inherited;

SetScrollLength(PChar(Msg.lParam));

end;

procedure TddgTabListBox.FindLongestString;

var

i: word;

Strg: String;

begin

FLongestString := 0;

{ Цикл поиска самой длинной строки }

for i := 0 to Items.Count – 1 do begin

Strg := Items[i];

SetScrollLength(Strg);

end;end;

procedure TddgTabListBox.LBDeleteString(var Msg: TMessage);

{ Эта процедура вызывается в ответ на сообщение lb_DeleteString,

которое передается в список при каждом удалении строки. Msg.wParam

содержит индекс удаляемой строки. Присвоение свойству SizeAfterDel

значения False запрещает обновление полосы прокрутки. Это

увеличивает производительность при частом удалении строк. }

var

Str: String;

begin

if FSizeAfterDel then begin

Str := Items[Msg.wParam]; // Получить удаляемую строку

inherited;                      // Удалить строку

{ Является ли удаленная строка самой длинной? }

if GetLBStringLength(Str) = FLongestString then

FindLongestString;

end else

inherited;

end;

end.В этом  компоненте особый интерес представляет метод  SetTabStops(), исполь зующий  в качестве параметра открытый массив  типа  word. Это разрешает пользова телям  устанавливать такое  количество позиций табуляции, какое  им потребуется, на пример:

ddgTabListboxInstance.SetTabStops([50, 75, 150, 300]);

Если текст в списке выходит за видимую часть окна, автоматически появляется го

ризонтальная полоса прокрутки.

Источник: Тейксейра, Стив, Пачеко, Ксавье.   Borland Delphi 6. Руководство разработчика. : Пер.  с англ. — М. : Издательский дом “Вильямс”, 2002. —  1120 с. : ил. — Парал. тит. англ.

По теме:

  • Комментарии