Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Содержание сайт... 65535
Вызов хранимых ... 65535
Эмулятор микроп... 65535
Приложение «Про... 64139
Организация зап... 62771
Оператор выбора... 62586
Invision Power ... 62189
Подключение Mic... 60969
Модуль Forms 59907
Создание отчето... 59826
ТЕХНОЛОГИИ ДОСТ... 56027
Программируемая... 55510
Пример работы с... 53140
Имитационное мо... 51406
21 ошибка прогр... 46394
Реклама
Сейчас на сайте
Гостей: 12
На сайте нет зарегистрированных пользователей

Пользователей: 13,057
новичок: Aidar
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Моделирование работы крупного аэропорта на GPSS + Пояснительная записка
Моделирование процесса поступления заявок в систему, состоящую из трёх Э...
База данных - рабочее место кассира на Delphi + бд Access

Реклама



Подписывайся на YouTube канал о программировании, что бы не пропустить новые видео!

ПОДПИСЫВАЙСЯ на канал о программировании
Программирование графики в Delphi, Graphical Device Interface (Pen, Кисть, Измерение текста и др.)
Использование цветов

В 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.


Опубликовал Kest January 26 2009 18:56:13 · 0 Комментариев · 17048 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Нет комментариев.
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Применение фильтр...
С. Г. Горнаков - ...
TelBook
PDJPack
FileFind
С# для профессион...
VksButton
Алгоритм трассиро...
Сапёр
Пример работы с ф...
Print Grid
Xrumer 4 Platinum...
Игра Car [Исходни...
CoolDev TipsSyste...
Распознавание иде...
Мод "проверочный ...
Профессиональное ...
Панель случайной ...
C# 2005 и платфор...
CABfiles

Топ загрузок
Приложение Клие... 100366
Delphi 7 Enterp... 82120
Converter AMR<-... 20046
Borland C++Buil... 11043
GPSS World Stud... 10399
Borland Delphi ... 8031
Turbo Pascal fo... 6959
Visual Studio 2... 4961
Калькулятор [Ис... 4259
FreeSMS v1.3.1 3508
Случайные статьи
Для игры " Коровы ...
Методы разработки ...
Строковый класс об...
НОК
Предоставление сеа...
Сортировка
SMB-подпись гарант...
Выбор сканирующего...
DVD-риппинг
Текст в ячейках та...
15.4. Принципы Зад...
Этап 3 - сколемизация
Архитектура функци...
Пример шифрования ...
Искусственное подн...
MySQL и Perl: взаи...
Глава 10
Физические явления...
Выполнение обновле...
Метод повторного х...
Эти точки должны б...
Сигнализации новог...
Коллекции атрибутов
Программирование а...
Установка программ...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?