Главная » Delphi » Компонент TddgSpinner

0

На рис. 13.3 показаны три  экземпляра компонента класса  TddgSpinner, которые могут использоваться в приложениях CLX. В традиционном компоненте SpinEdit кнопки инкремента/декремента  значения располагаются одна  над  другой.  В пред ставленном расширенном компоненте эти  кнопки находятся на  противоположных сторонах.

Рис. 13.3. Компонент CLX TddgSpinner используется для ввода целочисленных значений

В листинге 13.1  представлен полный  исходный код  модуля  QddgSpin.pas, где реализован компонент TddgSpinner. Класс  данного компонента является производ ным от класса  VCL TCustomControl, который реализован также  и в CLX. В связи  с тем что класс TddgSpinner происходит теперь от класса  CLX TCustomControl, его можно применять как в Windows, так и в Linux.

Названия классов  редко  изменяются при  переносе компонентов в CLX,  а вот  к именам  модулей обычно добавляется буква “Q”, что указывает  на их отношение к биб лиотеке Qt.

НА ЗАМЕТКУ

Во всех листингах в комментариях указан код VCL.

Комментарии, которые начинаются с VCL->CLX:, указывают на специфические фрагменты программного кода, имеющие отношение к преобразованию из VCL в CLX.

Листинг 13.1. QddgSpin.pas — исходный  код компонента TddgSpinner

unit QddgSpin;

interface uses

SysUtils, Classes, Types, Qt, QControls, QGraphics;

(*

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

ImgList;

*)

type

TddgButtonType = ( btMinus, btPlus );

TddgSpinnerEvent = procedure (Sender: TObject;

NewValue: Integer;

var AllowChange: Boolean ) of object;TddgSpinner = class( TCustomControl )

private

// Данные экземляра компонента

FValue: Integer;

FIncrement: Integer;

FButtonColor: TColor;

FButtonWidth: Integer;

FMinusBtnDown: Boolean;

FPlusBtnDown: Boolean;

// Указатели на методы обработки пользователских событий

FOnChange: TNotifyEvent;

FOnChanging: TddgSpinnerEvent;

(*

// VCL->CLX:         Эти обработчики сообщений в CLX не используются

// Метод обработки сообщений окна

procedure WMGetDlgCode( var Msg: TWMGetDlgCode );

message wm_GetDlgCode;

// Метод обработки сообщений компонента

procedure CMEnabledChanged( var Msg: TMessage );

message cm_EnabledChanged;

*)

protected

procedure Paint; override;

procedure DrawButton( Button: TddgButtonType; Down: Boolean;

Bounds: TRect ); virtual;

// Вспомогательные методы

procedure DecValue( Amount: Integer ); virtual;

procedure IncValue( Amount: Integer ); virtual;

function CursorPosition: TPoint;

function MouseOverButton( Btn: TddgButtonType ): Boolean;

// VCL->CLX:         EnabledChanged заменяет обработчик сообщения

//                   компонента cm_EnabledChanged

procedure EnabledChanged; override;

// Методы обработки новых событий

procedure Change; dynamic;

function CanChange( NewValue: Integer ): Boolean; dynamic;

// Переопределенные методы обработки событий

procedure DoEnter; override;

procedure DoExit; override;

procedure KeyDown(var Key: Word;

Shift: TShiftState); override;

procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;

(*

// VCL->CLX:         Следующие объявления в CLX были изменены

function DoMouseWheelDown( Shift: TShiftState;

MousePos: TPoint ): Boolean; override;

function DoMouseWheelUp( Shift: TShiftState;

MousePos: TPoint ): Boolean; override;

*)

function DoMouseWheelDown( Shift: TShiftState;

const MousePos: TPoint ): Boolean; override;

function DoMouseWheelUp( Shift: TShiftState;

const MousePos: TPoint ): Boolean; override;

// Методы доступа к свойствам

procedure SetButtonColor( Value: TColor ); virtual;

procedure SetButtonWidth( Value: Integer ); virtual;

procedure SetValue( Value: Integer ); virtual;

public

// Не забудьте указать для конструктора директиву override

constructor Create( AOwner: TComponent ); override;

published

// Объявления новых свойств

property ButtonColor: TColor

read FButtonColor

write SetButtonColor

default clBtnFace;

property ButtonWidth: Integer read FButtonWidth

write SetButtonWidth default 18;

property Increment: Integer read FIncrement

write FIncrement default 1;

property Value: Integer read FValue

write SetValue;

// Объявления новых событий

property OnChange: TNotifyEvent

read FOnChange

write FOnChange;

property OnChanging: TddgSpinnerEventread FOnChanging write FOnChanging;

// Унаследованные свойства и события

property Color;

(*

property DragCursor;           // VCL->CLX: В CLX этого свойства нет

*)

property DragMode;

property Enabled;

property Font;

property Height default 18;

property HelpContext;

property Hint;

property ParentShowHint;

property PopupMenu;

property ShowHint;

property TabOrder;

property TabStop default True;

property Visible;

property Width default 80;

property OnClick;

property OnDragDrop;

property OnDragOver;

property OnEndDrag;

property OnEnter;

property OnExit;

property OnKeyDown;

property OnKeyPress;

property OnKeyUp;

property OnMouseDown;

property OnMouseMove;

property OnMouseUp;

property OnStartDrag;

end;

implementation

{=========================}

{== Методы TddgSpinner    ==}

{=========================}

constructor TddgSpinner.Create( AOwner: TComponent );

begin

inherited Create( AOwner );

// Инициализация данных экземпляра FButtonColor := clBtnFace; FButtonWidth := 18;

FValue := 0; FIncrement := 1; FMinusBtnDown := False; FPlusBtnDown := False;

// Инизиализация унаследованных свойств

Width := 80;

Height := 18;

TabStop := True;

// VCL->CLX:       TWidgetControl устанавливает свойство Color в

//                 состояние clNone

Color := clWindow;

// VCL->CLX:       InputKeys используется вместо обработки

//                 сообщения wm_GetDlgCode

InputKeys := InputKeys + [ ikArrows ];

end;

{== Методы доступа к свойствам ==}

procedure TddgSpinner.SetButtonColor( Value: TColor );

begin

if FButtonColor <> Value then begin

FButtonColor := Value;

Invalidate;

end;

end;

procedure TddgSpinner.SetButtonWidth( Value: Integer );

begin

if FButtonWidth <> Value then begin

FButtonWidth := Value;

Invalidate;

end;

end;procedure TddgSpinner.SetValue( Value: Integer );

begin

if FValue <> Value then begin

if CanChange( Value ) then begin

FValue := Value;

Invalidate;

// Передача события Change

Change;

end;

end;

end;

{== Методы прорисовки ==}

procedure TddgSpinner.Paint;

var

R: TRect;

YOffset: Integer;S: string;

XOffset: Integer;                 // VCL->CLX: Добавлено для CLX

begin

inherited Paint;

with Canvas do begin

Font := Self.Font;

Pen.Color := clBtnShadow;

if Enabled then

Brush.Color := Self.Color

else begin

Brush.Color := clBtnFace;

Font.Color := clBtnShadow;

end;

// Отображение значения

(*

// VCL->CLX: SetTextAlign в CLX не используется

SetTextAlign( Handle, ta_Center or ta_Top );       // функция GDI

*)

R := Rect( FButtonWidth – 1, 0,

Width – FButtonWidth + 1, Height );

Canvas.Rectangle( R.Left, R.Top, R.Right, R.Bottom );

InflateRect( R, -1, -1 );

S := IntToStr( FValue );

YOffset := R.Top + ( R.Bottom – R.Top -

Canvas.TextHeight( S ) ) div 2;

// VCL->CLX: Вместо функции SetTextAlign используется XOffset

XOffset := R.Left + ( R.Right – R.Left -

Canvas.TextWidth( S ) ) div 2;

(*

// VCL->CLX: Процедура TextRect изменена

TextRect( R, Width div 2, YOffset, S );

*)

TextRect( R, XOffset, YOffset, S );

DrawButton( btMinus, FMinusBtnDown,

Rect( 0, 0, FButtonWidth, Height ) );

DrawButton( btPlus, FPlusBtnDown,

Rect( Width – FButtonWidth, 0, Width, Height ) );

if Focused then begin Brush.Color := Self.Color; DrawFocusRect( R );

end;

end;

end; {= TddgSpinner.Paint =}

procedure TddgSpinner.DrawButton( Button: TddgButtonType;

Down: Boolean; Bounds: TRect );begin

with Canvas do begin

if Down then                               // Установка цвета фона

Brush.Color := clBtnShadow

else

Brush.Color := FButtonColor;

Pen.Color := clBtnShadow;

Rectangle( Bounds.Left, Bounds.Top,

Bounds.Right, Bounds.Bottom );

if Enabled then begin

(*

// VCL->CLX: clActiveCaption для CLX заменено на

//                    clActiveHighlightedText

Pen.Color := clActiveCaption;

Brush.Color := clActiveCaption;

*)

Pen.Color := clActiveBorder;

Brush.Color := clActiveBorder;

end

else begin

Pen.Color := clBtnShadow;

Brush.Color := clBtnShadow;

end;

if Button = btMinus then begin            // Прорисовка кнопки "Минус" Rectangle( 4, Height div 2 – 1,

FButtonWidth – 4, Height div 2 + 1 );

end

else begin                             // Прорисовка кнопки "Плюс"

Rectangle( Width – FButtonWidth + 4, Height div 2 – 1,

Width – 4, Height div 2 + 1 );

Rectangle( Width – FButtonWidth div 2 – 1,

( Height div 2 ) – (FButtonWidth div 2 – 4),

Width – FButtonWidth div 2 + 1,

( Height div 2 ) + (FButtonWidth div 2 – 4)                   );

end;

Pen.Color := clWindowText;

Brush.Color := clWindow;

end;

end; {= TddgSpinner.DrawButton =}

procedure TddgSpinner.DoEnter;

begin

inherited DoEnter;

// Элемент управления принимает фокус –

// обновление изображения для прорисовки границы фокуса

Repaint;

end;

procedure TddgSpinner.DoExit;

begininherited DoExit;

// Элемент управления теряет фокус –

// обновление изображения для удаления границы фокуса

Repaint;

end;

// VCL->CLX:     EnabledChanged заменяет обработчик

//               сообщения cm_EnabledChanged

procedure TddgSpinner.EnabledChanged;

begin

inherited;

// Перерисовка компонента для отображения изменения

// его состояния

Repaint;

end;{== Методы обработки событий ==}

{================================================================= TddgSpinner.CanChange

Это – метод обработки события OnChanging. Обратите внимание, это

– функция, а не процедура. В функции переменной Result значение

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

обработчик события.

=================================================================}

function TddgSpinner.CanChange( NewValue: Integer ): Boolean;

var

AllowChange: Boolean;

begin

AllowChange := True;

if Assigned( FOnChanging ) then

FOnChanging( Self, NewValue, AllowChange );

Result := AllowChange;

end;

procedure TddgSpinner.Change;

begin

if Assigned( FOnChange ) then

FOnChange( Self );

end;

// Обратите внимание, методы DecValue и IncValue присваивают

// новое значение свойству Value (а не FValue), что косвенно

// приводит к вызову метода SetValue

procedure TddgSpinner.DecValue( Amount: Integer );

begin

Value := Value – Amount;

end;

procedure TddgSpinner.IncValue( Amount: Integer );

begin

Value := Value + Amount;

end;

{== Методы обработки событий клавиатуры ==} (*

// VCL->CLX: Заменен в конструкторе на использование InputKeys

procedure TddgSpinner.WMGetDlgCode( var Msg: TWMGetDlgCode );

begin

inherited;

Msg.Result := dlgc_WantArrows; // обрабатывает клавиши курсора

end;

*)procedure TddgSpinner.KeyDown( var Key: Word; Shift: TShiftState);

begin

inherited KeyDown( Key, Shift );

// VCL->CLX:       Константы клавиш в CLX изменены.

//                 Вместо префикса vk_ используется Key_

case Key of

Key_Left, Key_Down:

DecValue( FIncrement );

Key_Up, Key_Right: IncValue( FIncrement );

end;

end;{== Методы обработки событий мыши ==}

function TddgSpinner.CursorPosition: TPoint;

begin

GetCursorPos( Result );

Result := ScreenToClient( Result );

end;

function TddgSpinner.MouseOverButton(Btn:

TddgButtonType): Boolean;

var

R: TRect;

begin

// Получить границы соответствующей кнопки

if Btn = btMinus then

R := Rect( 0, 0, FButtonWidth, Height )else

R := Rect( Width – FButtonWidth, 0, Width, Height );

// Находится ли курсор над кнопкой? Result := PtInRect( R, CursorPosition );

end;

procedure TddgSpinner.MouseDown( Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

inherited MouseDown( Button, Shift, X, Y );

if not ( csDesigning in ComponentState ) then

SetFocus;              // Фокус на Spinner переносится только во

// время выполнения программы

if ( Button = mbLeft ) and

( MouseOverButton(btMinus) or

MouseOverButton(btPlus) ) then begin

FMinusBtnDown := MouseOverButton( btMinus );

FPlusBtnDown := MouseOverButton( btPlus );

Repaint;

end;

end;

procedure TddgSpinner.MouseUp( Button: TMouseButton;

Shift: TShiftState; X, Y: Integer );

begin

inherited MouseUp( Button, Shift, X, Y );

if Button = mbLeft then begin

if MouseOverButton( btPlus ) then

IncValue( FIncrement )

else if MouseOverButton( btMinus ) then

DecValue( FIncrement );

FMinusBtnDown := False; FPlusBtnDown := False;

Repaint;

end;

end;

function TddgSpinner.DoMouseWheelDown( Shift: TShiftState;

const MousePos: TPoint ): Boolean;

begin

inherited DoMouseWheelDown( Shift, MousePos );

DecValue( FIncrement );

Result := True;

end;

function TddgSpinner.DoMouseWheelUp( Shift: TShiftState;

begin

const MousePos: TPoint ): Boolean;

inherited DoMouseWheelUp( Shift, MousePos ); IncValue( FIncrement );

Result := True;

end;

end.Как видите, исходный код для CLX очень  похож  на исходный код для VCL, но, тем не менее,  в нем есть несколько существенных отличий.

Во первых, подключаются модули,  связанные с Qt:  Qt, QControls и QGraphics. Также  используется новый модуль Types, который применяется и в VCL, и в CLX. К счастью, основная часть  объявлений класса  CLX TddgSpinner идентична объявле ниям  VCL. В частности, это можно  сказать  об объявлении полей  экземпляра, а также о методах  обработки событий.

В первую  очередь, при  переносе компонента в CLX, необходимо внести измене ния  в код методов обработки сообщений CMEnabledChanged() и WMGetDlgCode(). Сообщения cm_EnabledChanged и wm_GetDlgCode в CLX не используются, а значит, их функции должны  быть реализованы по другому.

Как уже упоминалось, в CLX сообщения компонентов, наподобие cm_Enabled- Changed, заменены соответствующими динамическими методами. Поэтому  класс CLX TControl при   изменении  свойства  Enabled вместо   отправки  сообщения cm_EnabledChanged просто  вызывает метод  EnabledChanged(). Таким   образом программный код из метода  CMEnabledChanged() просто переносится в переопре деленный метод EnabledChanged().

Обычной задачей при  разработке компонентов является обработка событий кла виш  управления курсором.  В компоненте TddgSpinner эти  клавиши  используются для  увеличения и  уменьшения значения.  В компоненте VCL данная  функция была реализована через обработку сообщения wm_GetDlgCode. Как  уже упоминалось, со общение wm_GetDlgCode в компонентах CLX не используется, следовательно, необ ходим  какой нибудь  другой  подход.  Положительным моментом является то,  что  в классе TWidgetControl определено свойство InputKeys, где указывается набор  кла виш для обработки в конструкторе компонента.

В конструкторе содержится еще одно изменение, связанное с преобразованием из VCL  в  CLX:  класс  TWidgetControl инициализирует  свойство Color,  которому  в классе TControl присваивается значение clNone. В VCL класс TWinControl просто использует унаследованное значение clWindow, поэтому  свойству  Color нужно  при своить в конструкторе значение clWindow.

Теперь, после того как был модифицирован конструктор, в исходный код осталось внести совсем немного изменений. Большинство методов обработки событий исполь зуются  также  и в CLX. Учитывая это,  переход к CLX намного упрощается, если  для компонента вместо  обработки сообщений Windows  использовать переопределенные методы  обработки событий VCL.

В начале  настоящей главы было сказано, что все методы  построения компонентов VCL можно  применять и при  разработке компонентов CLX. И действительно, объяв ления  свойств, методы доступа и обработчики событий в VCL и CLX аналогичны.Больше всего изменений при переносе компонента из VCL в CLX необходимо вне

сти в метод Paint().

При  переносе компонентов методы  отображения,  наподобие Paint(), обычно

подвергаются самым значительным модификациям, даже несмотря на то, что классы

TCanvas в обеих архитектурах имеют почти идентичные интерфейсы.

При  переносе компонента класса  TddgSpinner в его исходный код следует внести

два  изменения,  связанных с  отображением. Во первых, в  версии VCL  используется

функция GDI SetTextAlign, которая автоматически центрирует текстовое поле  ком понента. Эта функция API Windows  в Linux  не используется. Кроме  того,  она не будет работать даже в среде  Windows,  так как ориентируется на дескриптор графического контекста устройства вывода.  Компоненты CLX не имеют доступа к контексту устройст ва, потому что для них свойство Canvas.Handle указывает на объект Qt Painter.

К счастью, большинство методов класса  TCanvas используются и в Windows,  и в

Linux, поэтому  проблема выравнивания текста  может  быть  разрешена достаточно

просто обычным вычислением необходимой позиции.

Вторая проблема, связанная с отображением, заключается в использовании мето да DrawButton(). В частности, символы “+” и “ ” на кнопках в VCL прорисовываются с использованием цвета  clActiveCaption, а идентификатору  clActiveCaption в модуле QGraphics.pas соответствует значение clActiveHighlightedText.

НА ЗАМЕТКУ

Для выполнения прорисовки вне метода Paint() компонентов CLX необходимо сна- чала вызвать метод Canvas.Start(). После завершения прорисовки вызывается ме- тод Canvas.Stop().

Не все модификации, связанные с переносом компонента, настолько просты, как кажется на первый взгляд.  В частности, вместо  определенных в VCL констант кодов виртуальных  клавиш,  наподобие vk_Left, в CLX используется совершенно другой набор  констант. Это  объясняется тем,  что  коды  виртуальных клавиш  являются  со ставной частью интерфейса API Windows и, следовательно, не используются в Linux.

Вот и все! Теперь создан  полнофункциональный компонент CLX, который может быть   использован  как   в  приложениях,  разрабатываемых  в   Delphi  6  для   среды Windows,  так и в приложениях, разрабатываемых в Kylix для среды  Linux.  При  этом, без сомнения, очень  важно  то, что на обеих  платформах используется один  и тот же исходный код.

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

По теме:

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