Евгений Веселов
дата публикации 24-03-2003 14:29

---

Версия для печати

Здравствуйте коллеги! Я хочу поделиться с Вами своим небольшим опытом создания компонент в среде Делфи и хочу показать, как можно создать собственную реализацию комбинированного списка, где в качестве списка будет фигурировать всем известный TTreeView.

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

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

• TEdit подобный компонент, у которого справа есть кнопка со стрелкой.(для простоты назовем его контроллером)
• Собственно список, который будет позиционироваться под контроллером и показываться в случае активизации выпадающего списка.

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

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

TdkTreeBox = class(TCustomControl) private FText: string; FButtonWidth: Integer; FPressed: Boolean; FHasFocus: Boolean; FAlignment: TAlignment; procedure SetAlignment(const Value: TAlignment); procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS; procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS; protected procedure Paint; override; procedure CreateParams(var Params: TCreateParams); override; public property Text: string read FText; constructor Create(AOwner: TComponent); override; published property Alignment: TAlignment read FAlignment write SetAlignment; end;

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

constructor TdkTreeBox.Create(AOwner: TComponent); begin inherited; FButtonWidth := GetSystemMetrics(SM_CXVSCROLL); //Определим размер кнопки, установленный в системе ControlStyle := ControlStyle + [csReplicatable]; if NewStyleControls then ControlStyle := [csOpaque] else ControlStyle := [csOpaque, csFramed]; // Компонент имеет рамку и занимает всю клиентскую область. //Более подробно в справке ParentColor := False; TabStop := True; end; procedure TdkTreeBox.Paint; var W, X, Flags: Integer; Selected: Boolean; R: TRect; begin Canvas.Font := Font; Canvas.Brush.Color := Color; if Enabled then Canvas.Font.Color := Font.Color else Canvas.Font.Color := clGrayText; Selected := FHasFocus; if Selected then begin Canvas.Font.Color := clHighlightText; Canvas.Brush.Color := clHighlight; end; if (csDesigning in ComponentState) then FText := Name; if UseRightToLeftAlignment then ChangeBiDiModeAlignment(FAlignment); W := ClientWidth - FButtonWidth; X := 2; case Alignment of taRightJustify: X := W - Canvas.TextWidth(Text) - 3; taCenter: X := (W - Canvas.TextWidth(Text)) div 2; end; SetRect(R, 1, 1, W - 1, ClientHeight - 1); if (SysLocale.MiddleEast) and (BiDiMode = bdRightToLeft) then begin Inc(X, FButtonWidth); Inc(R.Left, FButtonWidth); R.Right := ClientWidth; end; if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags; Canvas.TextRect(R, X, 2, Text); if Selected then Canvas.DrawFocusRect(R); SetRect(R, W, 0, ClientWidth, ClientHeight); if (SysLocale.MiddleEast) and (BiDiMode = bdRightToLeft) then begin R.Left := 0; R.Right := FButtonWidth; end; if not Enabled then Flags := DFCS_SCROLLCOMBOBOX or DFCS_INACTIVE else if FPressed then Flags := DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED else Flags := DFCS_SCROLLCOMBOBOX; DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags); FPressed:=False; end; procedure TdkTreeBox.WMKillFocus(var Message: TMessage); begin FHasFocus := False; inherited; Invalidate; // сюда еще добавится вызов метода, закрывающего список. end; procedure TdkTreeBox.WMSetFocus(var Message: TMessage); begin FHasFocus := True; inherited; Invalidate; end;

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

procedure TdkTreeBox.KeyDown(var Key: Word; Shift: TShiftState); begin inherited; FPressed:=True; Invalidate; end; procedure TdkTreeBox.KeyUP(var Key: Word; Shift: TShiftState); begin inherited; Invalidate; end; procedure TdkTreeBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; FPressed := True; Invalidate; end; procedure TdkTreeBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; Invalidate; end;

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

TdkListView = class(TCustomTreeView) private procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE; protected procedure CreateParams(var Params: TCreateParams); override; public constructor Create(AOwner: TComponent); override; end; constructor TdkListView.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable]; // Наш контрол не виден в процессе в дизайн-тайме end; procedure TdkListView.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style :=Style or WS_POPUP or WS_VSCROLL or WS_BORDER; ExStyle := WS_EX_TOOLWINDOW; AddBiDiModeExStyle(ExStyle); WindowClass.Style :=CS_SAVEBITS; end; // общий вид окна - всплывающее, с окантовкой и вертикальным скроллингом end;

• Отображал и прятал список, при этом модифицируя значение свойства Text.
• Генерировал события при отображении и сокрытии списка.
• Отображал список заданного размера

    FPopupList: TdkListView;
    FListVisible := False; // содержит статус списка(видимый/невидимый).

  FPopupList := TdkListView.Create(Self);
  FListVisible := False;
  FPopupList.HideSelection:=False;

    property OnDropDown: TNotifyEvent read FOnDropDown write SetOnDropDown;
    property OnCloseUp: TNotifyEvent read FOnCloseUp write SetOnCloseUp;

Если кто не знает, то сразу после такой записи, можно нажать комбинацию клавиш Ctrl+Shift+C и остальной код Делфи сгенерирует сама. Теперь добавим методы показа/сокрытия списка, которые необходимо сделать виртуальными, на случай, если на базе нашего класса будут строиться наследники:

procedure TdkTreeBox.DropDown; var P: TPoint; Y: Integer; begin if Assigned(FOnDropDown) then FOnDropDown(Self); FPopupList.Color := Color; FPopupList.Font := Font; FPopupList.Width := Width; FListVisible:=True; P := Parent.ClientToScreen(Point(Left, Top)); Y := P.Y + Height; if Y + FPopupList.Height > Screen.Height then Y := P.Y - FPopupList.Height; SetWindowPos(FPopupList.Handle, HWND_TOP, P.X, Y, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW); end; procedure TdkTreeBox.CloseUp(Accept: Boolean); begin if Accept and Assigned(FPopupList.Selected) then FText := FPopupList.Selected.Text; SetWindowPos(FPopupList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW); FListVisible := False; if Assigned(FOnCloseUp) then FOnCloseUp(Self); end;

procedure TdkTreeBox.KeyDown(var Key: Word; Shift: TShiftState); begin inherited; FPressed := True; Invalidate; if not FlistVisible then DropDown else CloseUp(False); end; procedure TdkTreeBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; FPressed := True; Invalidate; if not FlistVisible then DropDown else CloseUp(False); end;

Основная часть работы завершена. Наш компонент уже умеет открывать и прятать список, правда пока у нас нет возможности формировать сам список, более того закрывается он только с параметром Accept:=False. (Без фиксации пользовательского выбора).

 Property Items:TTreeNodes read GetItems write SetItems; 

function TdkTreeBox.GetItems: TTreeNodes; begin Result:=FPopupList.Items; end; procedure TdkTreeBox.SetItems(const Value: TTreeNodes); begin FPopupList.Items.Assign(Value); end;

По аналогии можно и, скорее всего, нужно вывести на поверхность и другие полезные свойства и методы TTreeView. (Images,StateImages,Font и т.д.)

1. При выборе ноды закрываем список с принятием пользовательского ввода. Ноду можно выбрать при помощи клавиатуры(навигация клавишами управления курсором, выбор векти - Enter либо пробел, отменить выбор - Escape или при потере фокуса) или при помощи мыши : при нажатии на левую клавишу список закрывается с принятием пользовательского ввода
2. При потере фокуса списком, закрываем список без принятия изменений.
3. При наведении курсором на ветку, она подсвечивается.

Теперь ясно видно, что список и контроллер тесно взаимодействуют друг с другом. В описание списка введем поле, указывающее на контроллер. Для реализации этого придется ввести упреждающее объявление класса. Далее нам нужно контролировать потерю фокуса списком, отслеживать движения и нажатия на левую кнопку мыши. Окончательный вариант класса списка приведен ниже:

TdkTreeBox = class; TdkListView = class(TCustomTreeView) private FEdit: TdkTreeBox; // ссылка на контроллер procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure KeyPress(var Key: Char); override; procedure CreateParams(var Params: TCreateParams); override; public constructor Create(AOwner: TComponent); override; end; constructor TdkListView.Create(AOwner: TComponent); begin inherited Create(AOwner); FEdit := TdkTreeBox(AOwner); // поскольку владелец нам всегда известен, используем опасное приведение типов Parent := FEdit; Visible := False; ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable]; end; procedure TdkListView.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := Style or WS_POPUP or WS_VSCROLL or WS_BORDER; ExStyle := WS_EX_TOOLWINDOW; AddBiDiModeExStyle(ExStyle); WindowClass.Style := CS_SAVEBITS; end; // список в виде всплывающего окна с вертикальной прокруткой end; procedure TdkListView.KeyPress(var Key: Char); begin inherited; if (Key = #13) or (Key = #32) then FEdit.CloseUp(True); if Key = #27 then FEdit.CloseUp(False); // Ентер и Пробел для подтверждения , ESC для отмены end; procedure TdkListView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var VNode: TTreeNode; VCanClose: Boolean; R: Trect; begin inherited; VNode := GetNodeAt(x, y); if Assigned(VNode) then begin R := VNode.DisplayRect(True); VCanClose := (R.TopLeft.X < X) and (R.TopLeft.y < y); // Не закрываем список только тогда, когда пользователь нажимает "+", т.е // раскрывает список нод if VCanClose then FEdit.CloseUp(True); end; end; procedure TdkListView.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; Selected := GetNodeAt(x, y); // Подсвечиваем ноду, над коорой находится указатель мыши end; procedure TdkListView.WMKillFocus(var Message: TMessage); begin inherited; try FEdit.SetFocus; except end; end;

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

Скачать компонент dkTreeBox.zip (3K)

Евгений Веселов
разработчик фирмы Vimas Technologies
март 2003г., Специально для Королевства Delphi