Компонент не нуждается в оконном ресурсе, а так как все его специфические свойства реализуются методом Paint, наилучшим родительским классом для него будет класс TGraphicControl. В листинге 15.2 показан модуль компонента FarText.

Листинг 15.2. Модуль компонента FarText unit FarText;

Этот модуль содержит компонент Fat Text, предназначенный для вывода однострочных надписей под разными углами к горизонтальной оси с использованием трехмерных эффектов. Свойство Orientation определяет направление вывода текста, свойство TextStyle задает нужный трехмерный эффект, свойство Depth3D устанавливает глубину эффекта. Для вывода текста компонент создает логический шрифт на основе шрифта, определенного свойством Font. Этот шрифт должен быть шрифтом TrueType - только в этом случае текст, набранный логическим шрифтом, может выводиться под углом к горизонтали.

interface

uses

SysUtils, Classes, Controls, Windows, Graphics;

продолжение #

Листинг 15.2 (продолжение) type { Следующее перечисление определяет объемность текста:

tsFlat - плоский текст без эффекта объема;
tsRecessed - вдавленный текст;
tsRaised - выпуклый текст;
tsShadow - оттененный текст } TTextStyle = (tsFlat, tsRecessed, tsRaised, tsShadow);
{ Следующее перечисление определяет направление вывода текста: orLeftRigh - слева направо; orBottomTop - снизу вверх; orTopBottom - сверху вниз;
orLeftBottomRightTop - 45 градусов снизу вверх; orLeftTopRightBottom - 45 градусов сверху вниз } TOrientation - (orLeftRight, orBottomTop, orTopBottom, orLeftBottomRightTop, orLeftTopRightBottom);
TFarText = class(TGraphicControl) private { Private declarations }
FLogFont: TLogFont;
FTextStyle: TTextStyle;
FOrientation: TOrientation;
FText: String;

FDepth3D: Byte; protected { Protected declarations } procedure SetOrientation(Value: TOrientation); procedure SetTextStyle(Value: TTextStyle); procedure SetText(Value: String); procedure SetDepth3D(Value: Byte); public

{ Public declarations } constructor Create(AOwner: TComponent); override; procedure Paint; override; published

{ Published declarations } property TextStyle: TTextStyle read FTextStyle

write SetTextStyle default tsFlat; property Orientation: TOrientation read FOrientation

write SetOrientation default orLeftRight;
property Text: String read FText write SetText;
property Depth3D: Byte read FDepth3D write SetDepth3D;
property Font;
property Color;
property Cursor;
property HelpContext;
property HelpType;
property Hint;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property OnClick;
property OnContextPopup;
end;
procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Far', [TFarText]);
end;
{ TFarText }
constructor TFarText.Create(AOwner: TComponent);

// Вызывает унаследованный конструктор и устанавливает

// умалчиваемые значения свойств. Изменяет имя шрифта

// на имя шрифта Truetype begin
inherited;
FTextStyle := tsFiat;
FOrientation := orLeftRight;
FText := 'FarText1;
Font.Name := 1 Times New Roman*; // Эта замена необходима! end;
procedure TFarText.Paint;
// Отрисовывает текст с помощью логического шрифта var
StartText: TPoint;
NewFont, OldFont: HFONT;
procedure DoFont;

// Создает логический шрифт на основе шрифта, // определенного в свойстве Font

var S: String; л

* продолжение ^

Листинг 15.2 (продолжение) begin // Обнуляем структуру

FillChar(FLogFont, SizeOf(TLogFont), 0)/

with FLogFont do // Устанавливаем нужные поля

begin
IfHeight := Font.Height;
S := Font.Name;

StrCopy(IfFaceName, PAnsiChar(S) ) ; lfCharset :- Font.Charset; IfItalic := Byte(fsltalic in Font.Style); if fsBold in Font.Style then IfWeight := 700 else IfWeight 4 00; lfUnderline := Byte(fsUnderLine in Font.Style); lfStrikeOut := Byte(fsStrikeOut in Font.Style); case FOrientation of

// Направление вывода в десятых долях градуса: orLeftRight: IfEscapement := 0; orBottomTop: IfEscapement := 900; orTopBottom: IfEscapement := -900; orLeftBottomRightTop: IfEscapement 450; orLeftTopRightBottom: IfEscapement := -450; end end;

NewFont := CreateFontlndirect(FLogFont) end; // DoFont

procedure TextDraw3D;

// Отрисовывает текст с учетом объемности. // Переменная StartText содержит точку начала // вывода плоского текста var Color: TColor; begin with Canvas do begin Color := Font.Color; // Запоминаем цвет

// основной надписи

if TextStyle <> tsFlat then // Нужен объем?

begin // -Да

Font.Color := clBtnHighLight; // Светлая кромка DoFont; // Шрифт для нее

// Вставляем новый шрифт в контекст устройства // и сохраняем дескриптор прежнего шрифта: OldFont := SelectObject(Handle, NewFont); // Отрисовываем светлую кромку с учетом

// эффекта объема:

if TextStyle = tsRaised then
TextOut(StartText.X - FDepth3D, StartText.Y - FDepth3D, FText) else if TextStyle = tsRecessed then
TextOut(StartText.X + FDepth3D, StartText.Y + FDepth3D, FText); // Восстанавливаем прежний шрифт и удаляем ненужный: SelectObject(Handle, OldFont);
DeleteObject(NewFont);

Font.Color := clBtnShadow; // Темная кромка

DoFont; // Шрифт для нее

OldFont := SelectObject(Handle, NewFont); if (TextStyle = tsRaised) or (TextStyle = tsShadow) then TextOut(StartText.X + FDepth3D, StartText.Y + FDepth3D, FText) else if TextStyle = tsRecessed then TextOut(StartText.X - FDepth3D, StartText.Y - FDepth3D, FText); SelectObject(Handle, OldFont); DeleteObject(NewFont); end; // Конец отрисовки трехмерных кромок

Font.Color := Color; // Основная надпись

DoFont; // Шрифт для нее

OldFont := SelectObject(Handle, NewFont); TextOut(StartText.X, StartText.Y, FText); SelectObject(Candle, OldFont); DeleteObject(NewFont) end end; // TextDraw3D

begin // Paint

Canvas.Font := Font;
Canvas.Brush.Style := bsClear;

// Следующие операторы устанавливают размеры

// компонента в зависимости от его ориентации

W := Canvas.TextWidth(FText) +

2 * Byte(TextStyle <> tsFlat) * FDepth3D; H := Canvas.TextHeight(FText) +

2 * Byte(TextStyle <> tsFlat) * FDepth3D; case Orientation of

orLeftRight: // По горизонтали продолжение #

Листинг 15.2 (продолжение) begin
Width ;= W;
Height := H end;
orTopBottom, orBottomTop: //По вертикали begin
Height := W;
Width := H;
end;

else // Под 45 градусов - квадрат if W > H then begin Width := W; Height := W end else begin * Width := H; Height := H end end end; // case

// Устанавливаем начальную точку с учетом направления // вывода и эффекта объемности: case Orientation of

orLeftRight: // Слева направо

begin
StartText.X := Byte(TextStyle <>
tsFlat) * FDepth3D;
StartText.Y := Byte(TextStyle <>
tsFlat) * FDepth3D;
end;

orBottomTop: // Снизу вверх

begin
StartText.X := Byte(TextStyle <>
tsFlat);
StartText.Y := Height - Byte(TextStyle <>
tsFlat) end;

orTopBottom: // Сверху вниз

begin StartText.X := Canvas.TextHeight('11) +

Byte(TextStyle <>
tsFlat);
StartText.Y := Byte(TextStyle <>
tsFlat);
end;
orLeftBottomRightTop: // Угол снизу вверх begin
StartText.X := Byte(TextStyle <>
tsFlat);
StartText.Y := Height - Canvas.TextHeight('1') end;

orLeftTopRightBottom: // Угол сверху вниз

begin StartText.X := Canvas.TextHeight(111) +

Byte(TextStyle <>
tsFlat);
StartText.Y := Byte(TextStyle <>
tsFlat) end
end; //case TextDraw3D end;
procedure TFarText.SetOrientation(Value: TOrientation);
begin
if Value <>
FOrientation then begin
FOrientation := Valuer-Invalidate end end;
procedure TFarText.SetTextStyle(Value: TTextStyle);
begin
if Value <>
FTextStyle then begin
FTextStyle :== Value;
if (Value <>
tsFlat) and (FDepth3D = 0) then
FDepth3D := 1; Invalidate end end;
procedure TFarText.SetText(Value: String);
begin
if Value <>
FText'then begin
FText := Valuer-Invalidate end end;
procedure TFarText.SetDepth3D(Value: Byte);
begin
if Value <>
FDepth3D then begin
FDepth3D := Value;
Invalidate end end;

end.

В традиционном ШтсЬшБ-программировании нестандартный инструмент используется в контексте устройства по принципу «сэндвича» (рис. 15.4).

15.2.2. Реализация FarText

Рис 15.4. Использование нестандартного инструмента в контексте устройства Таким же образом действуем и мы:

NewFont : = CreateFontlndirect() ; // Создаем н&вый шрифт OldFont := SelectObject () ; // Вставляем его в контекст TextOutO; // Используем

SelectObject(DC, OldFont); // Восстанавливаем прежний контекст DeleteObject(NewFont) ; // Удаляем новый шрифт

Уверен, что если вы программировали для Windows без средств типа Delphi или Visual Basic, вы навсегда запомнили этот железный порядок. Малейший отход от него карается незамедлительно - возникает исключительная ситуация. Внутри класса Canvas все подобные последовательности действий строго соблюдаются, а вот вне его соблюдение установленных последовательностей действий возлагается на программиста.

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

Процесс создания трехмерного шрифта наглядно иллюстрирует рис. 15.5 (на примере стиля stRaised).

15.2.2. Реализация FarText

Рис. 15.5. Создание трехмерного стиля &каі5есІ: а - отрисовка светлой кромки; б - отрисовка темной кромки; в - отрисовка основной надписи

Вначале текст выводится цветом сІВ^НідпІідпі на Эер^ЗБ пикселов влево и вверх относительно точки StartText, затем цветом сІВг-пБї^ою на Бер1:п30 пикселов вправо и вниз от точки StartText и, наконец, основным цветом без смещения относительно StartText. Чтобы накладывающийся текст не стирал предыдущий, он должен выводиться в режиме Transparent - в этом случае прямоугольник отрисовки не закрашивается кистью. Установить этот режим можно, вызвав API-функцию SetBkMode (HDC, BkMode) или поместив в свойство Style кисти канвы значение bsClear.

При вычислении координат начальной точки используется тот факт, что тип Boolean - перечисленный:

type Boolean = (False, True); Таким образом, Byte (False) = 0 и Byte (True) = 1.

Для компонента характерны некоторые недостатки. Например, в нем отсутствуют свойства AutoSize, Align, Alignment, события, связанные с мышью и т. п. Ну что ж, перед вами открытые тексты - вносите в них свои изменения, чтобы создать безупречный компонент XXXText.

15.2. Компонент FarText || Оглавление || 15.3. Компонент FarRgnButton


Искусство создания компонентов Delphi



Новости за месяц

  • Август
    2019
  • Пн
  • Вт
  • Ср
  • Чт
  • Пт
  • Сб
  • Вс