Использование цветов
В Windows цвета определяются тремя величинами: красный, зеленый и синий. Каждая величина определяет интенсивность компонента цвета. Если все величины будут иметь минимальное значение 0, то результирующий цвет будет черным. Если все величины будут равны максимальному значению 255, результирующий цвет будет белым. Чтобы создать цвет из этих отдельных цветовых компонентов, вы должны использовать функцию RGB.
Функция RGB принимает три параметра типа Byte – по одному параметру для каждого компонента цвета – и возвращает значение COLORREF. Значение COLORREF представляет собой 32-битное беззнаковое целочисленное значение, используемое для определения цвета.
function RGB(r, g, b: Byte): COLORREF;
Пример:
Приложение использует компонент TPanel в качестве фрейма предварительного просмотра и три компонента TScrollBar, которые позволяют пользователю модифицировать компоненты красного, зеленого и синего цветов. Свойство Max всех трех компонентов TScrollBar имеет максимальное значение для каждого компонента цвета: 255. Все три компонента TScrollBar совместно используют один очень простой обработчик события OnChange.
procedure TForm1.ScrollChange(Sender: TObject);
begin
Panel1.Color := RGB(RedBar.Position, GreenBar.Position, BlueBar.Position);
end;
В Delphi цвета автоматически представлены 32-битными значениями TColor. Тип TColor объявлен в модуле Graphics, вместе с несколькими полезными константами цветов. Эти константы цветов охватывают:
• Стандартные цвета, такие как clWhite, clRed, clGreen, clBlue, clBlack и clMaroon
• Системные цвета, такие как clBtnFace, clScrollBar, clActiveBorder, clMenu и clWindow
• Названные Веб-цвета, такие как clWebBlueViolet, clWebGainsboro, clWebThistle
Вы можете также определить цвета как шестнадцатеричные числа. В этом случае следует определять компоненты в обратном порядке, то есть сначала определить синий, затем зеленый и, наконец, красный:
Color := $000000; { Черный }
Color := $FF0000; { Синий }
Color := $00FF00; { Зеленый }
Color := $0000FF; { Красный }
Color := $FFFFFF; { Белый }
Холст
GDI ОС Windows позволяет нам создавать графические изображения с использованием объектов GDI и посредством вызова функций GDI, которые «умеют» рисовать линии, формы, текст или изображения. Класс TCanvas заключает в себе многие функции и объекты GDI и предлагает поверхность для рисования. Тремя графическими объектами, используемыми для рисования, являются Pen (Перо), Brush (Кисть) и Font (Шрифт).
Pen
Перо Pen используется для рисования линий и форм. При рисовании форм Pen используется для прорисовки контура.
Чтобы нарисовать линию, вы должны использовать два метода Canvas: MoveTo и LineTo. Метод MoveTo используется для задания начальной позиции рисования. Метод LineTo используется для рисования линии, начиная с позиции, заданной методом MoveTo, и до точки, определяемой его параметрами X и Y. После завершения рисования метод LineTo обновляет позицию рисования.
Следующий пример показывает, как можно нарисовать треугольник с помощью методов MoveTo и LineTo.
procedure TMainForm.DrawButtonClick(Sender: TObject);
begin
Canvas.MoveTo(100, 100);
Canvas.LineTo(200, 150);
Canvas.LineTo(100, 200);
Canvas.LineTo(100, 100);
end;
Стили пера Pen
procedure TMainForm.StylesButtonClick(Sender: TObject);
const
PEN_NAMES: array[TPenStyle] of string = ('psSolid', 'psDash', 'psDot', 'psDashDot', 'psDashDotDot', 'psClear', 'psInsideFrame');
var
i: Integer;
y: Integer;
begin
for i := 0 to Ord(psInsideFrame) do
begin
y := 20 + (i * 40);
Canvas.Pen.Style := TPenStyle(i);
Canvas.TextOut(10, y, PEN_NAMES[Canvas.Pen.Style]);
Canvas.MoveTo(10, y);
Canvas.LineTo(200, y);
end;
end;
Класс TPen имеет еще одно свойство, которое изменяет внешний вид линий на холсте: Mode. Это свойство определяет операцию, выполняемую над пикселями в процессе рисования линии на холсте. Например, если вы присвоите свойству Mode значение pmWhite, то все линии рисования будут белыми, независимо от цвета пера Pen. Если вы присвоите свойству Mode значение pmNotCopy, то цвет пера Pen будет инвертированным. Чтобы посмотреть список всех возможных значений свойства Mode, найдите в справочной службе Delphi раздел TPenMode.
Одним из режимов Pen, которых нет в каркасе .NET framework, является режим pmNotXor, который чаще всего используется для создания эффекта резиновой ленты.
Эффект резиновой ленты можно реализовать довольно просто. Единственное, что вам нужно будет сделать, это нарисовать одну и ту же линию два раза. При первом разе пиксели холста будут инвертированными, чтобы сделать линию видимой. Когда вы прорисуете линию еще раз с помощью pmNotXor, пиксели на холсте будут восстановлены до своего первоначального состояния, стирая, таким образом, линию.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FMouseDown: Boolean;
FStart, FEnd: TPoint;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
FStart := Point(X, Y);
FEnd := FStart;
FMouseDown := True;
end; // Завершение условия if Button
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FMouseDown := False;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FMouseDown then
begin
{ Сначала стираем предыдущую линию }
Canvas.Pen.Mode := pmNotXor;
Canvas.MoveTo(FStart.X, FStart.Y);
Canvas.LineTo(FEnd.X, FEnd.Y);
{ Рисуем новую линию }
Canvas.MoveTo(FStart.X, FStart.Y);
Canvas.LineTo(X, Y);
{ Запоминаем новые координаты, с тем чтобы мы могли стереть
их в следующий раз, когда произойдет событие OnMouseMove }
FEnd := Point(X, Y);
end;
end;
end.
Кисть
Кисть Brush используется методами, рисующими формы, для заполнения внутренней части рисуемой формы. Обычно, кисть Brush определяет только цвет формы, однако она может также определить шаблонное, или побитовое изображение, которое может быть использовано в качестве шаблона. На рис. 22.5 показаны различные стили кисти Brush.
procedure TMainForm.DrawButtonClick(Sender: TObject);
const
RECT_SIZE = 50;
BRUSH_NAMES: array[TBrushStyle] of string = ('bsSolid', 'bsClear', 'bsHorizontal', 'bsVertical', 'bsFDiagonal', 'bsBDiagonal', 'bsCross', 'bsDiagCross');
var
y: Integer;
style: TBrushStyle;
begin
{ Стираем всю канву }
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clWhite;
Canvas.FillRect(ClientRect);
{ Рисуем прямоугольники }
y := 10;
for style := bsSolid to bsDiagCross do
begin
Canvas.Brush.Style := style;
{ Выбираем случайный цвет }
Canvas.Brush.Color := Random(High(TColor));
Canvas.Rectangle(10, y, 10 + RECT_SIZE, y + RECT_SIZE);
{ Временно изменяем стиль кисти на bsClear, чтобы начертить текст без цвета фона }
Canvas.Brush.Style := bsClear;
Canvas.TextOut(70, y + (RECT_SIZE div 2), BRUSH_NAMES[style]);
Inc(y, RECT_SIZE + 10);
end; // Завершение конструкции for
end;
Черчение текста
Самым простым методом черчения текста на холсте является метод TextOut. Как вы уже могли видеть, метод TextOut принимает три параметра. Первые два параметра представляют координаты X и Y, а последний параметр представляет строку, которую необходимо начертить на холсте.
Для черчения строки метод TextOut использует свойства Brush и Font холста. Свойство Font определяет общие характеристики текста (семейство шрифта и его атрибуты), а свойство Brush определяет цвет фона. Если вы хотите начертить текст с разноцветным фоном, присвойте свойству Brush.Style значение bsSolid. Чтобы начертить текст без разноцветного фона, присвойте свойству Brush.Style значение bs.Clear.
Вместо свойства Brush холста можно использовать также функции GDI API SetBkMode и SetBkColor, чтобы задать цвет фона и режим (TRANSPARENT или OPAQUE):
function SetBkMode(DC: HDC; BkMode: Integer): Integer; stdcall;
function SetBkColor(DC: HDC; Color: COLORREF): COLORREF; stdcall;
Обрате внимание на первый параметр обеих функций. Он принимает переменную HDC – логический номер контекста устройства. На уровне API контексты устройств (структуры данных, которые содержат информацию об экране или принтере) представляют поверхность рисования. Класс TCanvas инкапсулирует контекст устройства, а свойство Handle холста на самом деле является логическим номером контекста устройства GDI, необходимым для всех функций GDI.
procedure TMainForm.DrawButtonClick(Sender: TObject);
begin
Canvas.Font.Name := 'Verdana';
Canvas.Font.Size := 14;
{ VCL }
Canvas.Brush.Color := clBlack;
Canvas.Font.Color := clLime;
Canvas.TextOut(10, 10, 'Brush.Style := bsSolid; (opaque background)');
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := clBlue;
Canvas.TextOut(10, 40, 'Brush.Style := bsClear; (transparent background)');
{ GDI API + VCL}
SetBkMode(Canvas.Handle, OPAQUE);
SetBkColor(Canvas.Handle, clWhite);
SetTextColor(Canvas.Handle, clBlack);
Canvas.TextOut(10, 70, 'SetBkMode(Canvas.Handle, OPAQUE);');
SetBkMode(Canvas.Handle, TRANSPARENT);
Canvas.TextOut(10, 100, 'SetBkMode(Canvas.Handle, TRANSPARENT);');
end;
Чтобы начертить текст на холсте, вы можете также воспользоваться процедурой TextRect, которая выводит строку внутри прямоугольника и обрезает те участки строки, которые не попадают в заданный прямоугольник, как показано на рис. 22.7.
Листинг 22.7 Метод TextRect
procedure TMainForm.DrawButtonClick(Sender: TObject);
var
rc: TRect;
begin
rc := Rect(10, 10, 100, 40);
Canvas.Brush.Color := clWhite;
Canvas.Rectangle(rc);
Canvas.TextRect(rc, 10, 10, 'TextRect displays text in a rectangle.');
end;
GDI API обладает еще одной, по-настоящему сильной функцией черчения текста, которая не заключена в классе TCanvas, и которая часто используется разработчиками компонентов: DrawText. Функция DrawText может использоваться для отображения форматированного текста. С ее помощью можно задать прямоугольник, который будет использоваться для форматирования, количество символов для черчения, и параметры форматирования. Далее показано объявление функции DrawText:
function DrawText(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
Когда вы вызываете функцию DrawText, вы должны сделать следующее:
• Передать дескриптор холста Canvas в качестве параметра hDC.
• Передать строковое значение в качестве параметра lpString. (Если вы передаете строковую переменную или строковое свойство, вы должны привести ее или его к типу PChar.)
• Передать длину строки в качестве параметра nCount. (Если вы передадите -1, то функция DrawText отобразит всю строку.)
• В качестве параметра lpRect передать прямоугольную область, в рамках которой будет начерчен текст.
• Передать одну или более констант в качестве параметра uFormat. (Если вы хотите использовать несколько стилей форматирования, вы должны будете комбинировать их с помощью операции or.)
Наиболее часто используемые значения форматирования перечислены в таблице 22.1.
Таблица 22.1 Некоторые значения форматирования текста
Константа Назначение
DT_SINGLELINE Чертит текст в одной строке.
DT_LEFT Выравнивает текст по левому краю.
DT_CENTER Центрирует текст по горизонтали.
DT_RIGHT Выравнивает текст по правому краю.
DT_VCENTER Выравнивает текст по вертикали.
DT_WORD_ELLIPS Отсекает слова, которые не умещаются в заданной прямоугольной области, и отображает эллипсы.
DT_WORDBREAK Переносит слова на новые строки, если слова не умещаются в заданной прямоугольной области.
DT_CALCRECT Используйте это значение, чтобы вычислить, насколько большой должна быть прямоугольная область, чтобы уместить всю строку. (Если вы используете это значение, функция DrawText произведет расчет, но не отобразит строку.)
На следующем рисунке показано несколько строк, отображенных с помощью функции DrawText.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, XPMan, StdCtrls;
type
TMainForm = class(TForm)
DrawButton: TButton;
XPManifest: TXPManifest;
procedure DrawButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure ClearCanvas(ACanvas: TCanvas; AColor: TColor);
begin
with ACanvas do
begin
Brush.Style := bsSolid;
Brush.Color := AColor;
{ ClipRect идентифицирует участок холста, который необходимо перерисовать. }
FillRect(ClipRect);
end;
end;
procedure TMainForm.DrawButtonClick(Sender: TObject);
var
rc: TRect;
msg: string;
begin
{ Очистка холста }
ClearCanvas(Canvas, clWhite);
Canvas.Font.Name := 'Times New Roman';
Canvas.Font.Size := 20;
Canvas.Brush.Style := bsClear;
{ Текст слева, по центру, справа }
rc := Rect(10, 10, 420, 10 + Canvas.TextHeight('W'));
Canvas.Rectangle(rc);
DrawText(Canvas.Handle, 'Left', -1, rc, DT_SINGLELINE or DT_LEFT);
DrawText(Canvas.Handle, 'Centered', -1, rc, DT_SINGLELINE or DT_CENTER);
DrawText(Canvas.Handle, 'Right', -1, rc, DT_SINGLELINE or DT_RIGHT);
{ Центрирование по вертикали и горизонтали }
rc := Rect(10, rc.Bottom + 10, 420, rc.Bottom + 150);
Canvas.Rectangle(rc);
DrawText(Canvas.Handle, 'Horizontally && Vertically Centered', -1, rc, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
{ Отсечение с помощью эллипсов }
msg := 'This line is too long and will be truncated.';
rc := Rect(10, rc.Bottom + 10, 220, rc.Bottom + 10 + Canvas.TextHeight('W'));
Canvas.Rectangle(rc);
DrawText(Canvas.Handle, PChar(msg), -1, rc, DT_WORD_ELLIPSIS);
{ Черчение многострочного текста }
msg := 'The DrawText function determined the appropriate ' + 'rectangle for this string. DrawText calculates the ' + 'rectangle size when you pass DT_CALCRECT as the uFormat parameter.';
rc := Rect(10, rc.Bottom + 10, 500, rc.Bottom + 20);
{ Вычисление подходящей прямоугольной области }
DrawText(Canvas.Handle, PChar(msg), -1, rc, DT_CALCRECT or DT_WORDBREAK);
Canvas.Rectangle(rc);
DrawText(Canvas.Handle, PChar(msg), -1, rc, DT_WORDBREAK);
end;
end.
Измерение текста
Класс TCanvas имеет три метода, которые позволяют вам определить ширину и высоту строки: TextExtent, TextHeight и TextWidth. В то время как методы TextHeight и TextWidth возвращают только высоту и ширину строки, функция TextExtent возвращает ширину и высоту в записи tagSize (TSize):
tagSIZE = record
cx: Longint; { width }
cy: Longint; { height }
end;
Следующий рисунок показывает пример приложения, рисующего каждый символ в строке с разным шрифтом. Это приложение использует функцию TextWidth, чтобы определить, нужно ли рисовать каждый символ.
procedure TMainForm.DrawButtonClick(Sender: TObject);
const
s = 'Borland Delphi';
var
c: Char;
x: Integer;
begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(ClientRect);
x := 25;
for c in s do
begin
Canvas.Font.Name := Screen.Fonts[Random(Screen.Fonts.Count)];
Canvas.Font.Size := Random(60) + 12;
Canvas.Font.Color := Random(High(TColor));
Canvas.TextOut(x, 100, c);
Inc(x, Canvas.TextWidth©);
end;
end;
Использование функций API для получения поверхности рисования
Хотя для рисования на экране монитора и вывода на печать лучше всего использовать холст Canvas, в некоторых ситуациях бывает необходимо (или желательно) делать так, как в API. Чтобы получить контекстный номер устройства, вы можете использовать функцию API GetDC. Эта функция принимает дескриптор окна и возвращает логический номер устройства, который позволяет рисовать в клиентской области определенного окна:
function GetDC(hWnd: HWND): HDC; stdcall;
Если вы будете использовать функцию GetDC для получения идентификатора контекста устройства, вы должны освободить полученный идентификатор, когда он вам больше не будет необходим. Чтобы освободить контекст устройства, вызовите функцию ReleaseDC. Для этой функции необходимо передать идентификатор контекста устройства и идентификатор окна, чей контекст устройства вы освобождаете:
function ReleaseDC(hWnd: HWND; hDC: HDC): Integer; stdcall;
При рисовании с использованием функций API вы заметите, что вам нужно будет делать больше, чем при использовании методов класса TCanvas. Например, если вы хотите начертить простую строку, вы можете использовать функцию TextOut, однако вам нужно будет передать функции пять параметров вместо трех. Наряду с координатами X и Y, а также строкой, функция GDI TextOut требует еще два параметра: идентификатор контекста устройства и длину строки. Следующий листинг показывает, как используются функции API GDI для отображения текстового сообщения на форме.
Использование функций API для рисования на форме
procedure TMainForm.GetDCButtonClick(Sender: TObject);
var
context: HDC;
msg: string;
begin
context := GetDC(Handle);
try
msg := 'Using GetDC & TextOut API functions.';
TextOut(context, 20, 20, PChar(msg), Length(msg));
finally
{ Освобождение контекста устройства после завершения работы }
ReleaseDC(Handle, context);
end;
end;
Функция GetWindowDC является еще одной функцией, позволяющей получить контекст устройства. В отличие от класса TCanvas и функции GetDC, которые позволяют рисовать только в клиентской области окна, GetWindowDC возвращает контекст устройства всего окна, включая строку заголовка, меню и границы окна.
procedure TMainForm.GetWindowDCButtonClick(Sender: TObject);
var
winContext: HDC;
begin
winContext := GetWindowDC(Handle);
try
{ erase the entire window, including borders & the title bar }
Canvas.Brush.Color := clWebPaleGoldenrod;
FillRect(winContext, Rect(0, 0, Width, Height), Canvas.Brush.Handle);
finally
ReleaseDC(Handle, winContext);
end;
end;
Событие OnPaint
Чтобы гарантировать, что элементы вашей графики останутся «невредимыми» вследствие других действий, вы должны написать свой код раскраски в обработчике события OnPaint, поскольку событие OnPaint возникает всякий раз, когда операционная система определяет, что или все окно, или его часть будет перерисовано. Вы можете также вручную запросить перерисовку окна, вызвав Invalidate.
В листинге 22.12 показано, как можно нарисовать простой градиент в обработчике события OnPaint.
Нарисовать градиент проще всего можно следующим образом:
1. Нарисовать градиент черный-синий, черный-красный или черный-зеленый.
2. Нарисовать градиент в 256 этапов, независимо от ширины или высоты окна назначения.
3. Рассчитать высоту или ширину прямоугольной области, которую необходимо перерисовать для каждого цвета (если форма имеет 1000 пикселей по высоте, вы должны нарисовать прямоугольник высотой 4 пикселя для каждого цвета).
Рисование простого градиента
{ Градиент черный-синий }
procedure TMainForm.FormPaint(Sender: TObject);
var
rowHeight: Integer;
i: Integer;
begin
{ Вычисление высоты каждой строки }
rowHeight := Succ(ClientHeight div 256);
{ Рисование 256 различных цветных прямоугольников - градиент}
for i := 0 to 255 do
begin
Canvas.Brush.Color := RGB(0, 0, i);
Canvas.FillRect(Rect(0, i * rowHeight, ClientWidth, Succ(i) * rowHeight));
end; // Завершение конструкции for
end;
Если вы хотите, чтобы градиент отображался правильно при изменении размеров окна, вызовите Invalidate в обработчике события OnResize, чтобы перерисовать всю форму:
procedure TMainForm.FormResize(Sender: TObject);
begin
Invalidate;
end;
Когда вы выполните этот код, вы заметите мерцание, вызванное методом Invalidate, когда вы попытаетесь изменить размеры окна. Некоторые разработчики пытаются убирать мерцание путем вызова Paint в обработчике события OnResize или путем назначения этого же обработчика событиям OnPaint и OnResize. Так поступать не нужно никогда, особенно если для ваших элементов графики требуется очень много вычислений, так как обработчик события OnPaint будет вызван дважды.
Мерцание появляется вследствие того, что ОС Windows стирает фон окна, прежде чем перерисовывать его. Поэтому, чтобы избежать мерцания, вы просто должны дать Windows команду, чтобы она остановила стирание фона окна. Чтобы сделать это, вы должны обработать сообщение WM_ERASEBKGND и присвоить результату сообщения ненулевое значение (обычно 1).
Обработка сообщения WM_ERASEBKGND для устранения мерцания
type
TMainForm = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure EraseBackground(var Message: TWMEraseBkgnd);
message WM_ERASEBKGND;
end;
procedure TMainForm.EraseBackground(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
Invalidate;
end;
Еще один способ рисования градиента
type
TMainForm = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure EraseBackground(var Message: TWMEraseBkgnd);
message WM_ERASEBKGND;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.FormPaint(Sender: TObject);
var
colorHeight: Double;
i: Integer;
begin
if ClientHeight = 0 then Exit;
{ Определяем, насколько должен перекрываться один цвет }
colorHeight := 256 / ClientHeight;
for i := 0 to ClientHeight do
begin
{ Рисуем градиент красный-черный }
Canvas.Pen.Color := RGB(Round(i * colorHeight), 0, 0);
Canvas.MoveTo(0, i);
Canvas.LineTo(ClientWidth, i);
end; // Завершение конструкции for i
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
Invalidate;
end;
procedure TMainForm.EraseBackground(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
end.
Рисование градиентов, поддерживающих специальные цвета
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, XPMan, Menus;
type
TMainForm = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
procedure EraseBackground(var Message: TWMEraseBkgnd);
message WM_ERASEBKGND;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.FormPaint(Sender: TObject);
var
startColor: TColor;
endColor: TColor;
redStart, blueStart, greenStart: Integer;
redStep, blueStep, greenStep: Double;
i: Integer;
rc: TRect;
begin
if ClientHeight = 0 then Exit;
{ Используем цвета из двух компонентов TColorDialogs }
startColor := StartColorDialog.Color;
endColor := EndColorDialog.Color;
{ Извлекаем значения R, G и B из исходного цвета }
redStart := GetRValue(startColor);
greenStart := GetGValue(startColor);
blueStart := GetBValue(startColor);
{ Определяем, сколько нужно добавить endColor в startColor на каждом этапе }
redStep := (GetRValue(endColor) - redStart) / ClientHeight;
greenStep := (GetGValue(endColor) - greenStart) / ClientHeight;
blueStep := (GetBValue(endColor) - blueStart) / ClientHeight;
for i := 0 to ClientHeight do
begin
Canvas.Pen.Color := RGB(redStart + Round(i * redStep), greenStart + Round(i * greenStep), blueStart + Round(i * blueStep));
Canvas.MoveTo(0, i);
Canvas.LineTo(ClientWidth, i);
end;
{ Чертим заголовок }
rc := ClientRect;
Canvas.Brush.Style := bsClear;
Canvas.Font := FontDialog.Font;
DrawText(Canvas.Handle, PChar(Caption), -1, rc, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
end;
procedure TMainForm.StartColorItemClick(Sender: TObject);
begin
if StartColorDialog.Execute then Invalidate;
end;
procedure TMainForm.EndColorItemClick(Sender: TObject);
begin
if EndColorDialog.Execute then Invalidate;
end;
procedure TMainForm.SelectFontItemClick(Sender: TObject);
begin
if FontDialog.Execute then Invalidate;
end;
procedure TMainForm.ExitItemClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
Invalidate;
end;
procedure TMainForm.EraseBackground(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
end.
Рисование побитовых изображений
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
type
TMainForm = class(TForm)
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FImage: TBitmap;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
var
imagePath: string;
begin
{ Здесь создается и загружается изображение; на самом деле,
не следует полагаться полностью на обработчик события
OnPaint, и помещать в него код только если в этом
Действительно есть необходимость }
FImage := TBitmap.Create;
imagePath := ExtractFilePath(Application.ExeName) + 'image.bmp';
FImage.LoadFromFile(imagePath);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
{ Не забывайте удалять побитовое изображение из памяти }
FImage.Free;
end;
procedure TMainForm.FormPaint(Sender: TObject);
var
srcRect: TRect;
destRect: TRect;
txtHeight: Integer;
begin
with Canvas do
begin
Font.Color := clYellow;
Font.Size := 16;
txtHeight := TextHeight('Wg');
end; // Завершение конструкции Canvas
{ Рисование всего изображения }
Canvas.TextOut(10, 0, 'Draw');
Canvas.Draw(10, txtHeight, FImage);
{ Рисование изображения, растянутого в прямоугольной области 400х400 }
Canvas.TextOut(10, FImage.Height + (txtHeight * 2), 'StretchDraw');
srcRect := Rect(10, FImage.Height + txtHeight * 3, 410, FImage.Height + (txtHeight * 3) + 100);
Canvas.StretchDraw(srcRect, FImage);
{ Рисование в прямоугольной области размером 100x100 в левой верхней части экрана }
Canvas.TextOut(FImage.Width + 20, 0, 'CopyRect');
srcRect := Rect(0, 0, 100, 100);
destRect := Rect(FImage.Width + 20, txtHeight, FImage.Width + 120, txtHeight + 100);
Canvas.CopyRect(destRect, FImage.Canvas, srcRect);
end;
end.
|
Главная
Каталог файлов
