Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Программирование графики, GDI (Graphical Device Interface) 
:(
    Опции темы
Akella
  Дата 21.6.2006, 08:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 1
Всего: 329



материалы из книги
"Внутренний мир Borland Delphi 2006"

http://www.williamspublishing.com/
http://www.dialektika.com/

это совместный проект ИД Диалектики, ИД Вильямс и мегапортала Винград   - 

Программирование компьютерной графики в Windows основано на GDI (Graphical Device Interface) – интерфейсе графических устройств Windows. GDI представляет собой API, разработанный для рисования графических изображений на экране монитора или вывода их на печать. В Delphi вы можете использовать объекты и функции GDI напрямую, или использовать классы VCL, заключающие в себе функции и объекты GDI. В этой главе мы будем работать главным образом с классами VCL, заключающими функциональные особенности GDI.

Использование цветов
В Windows цвета определяются тремя величинами: красный, зеленый и синий. Каждая величина определяет интенсивность компонента цвета. Если все величины будут иметь минимальное значение 0, то результирующий цвет будет черным. Если все величины будут равны максимальному значению 255, результирующий цвет будет белым. Чтобы создать цвет из этих отдельных цветовых компонентов, вы должны использовать функцию RGB.
Функция RGB принимает три параметра типа Byte – по одному параметру для каждого компонента цвета – и возвращает значение COLORREF. Значение COLORREF представляет собой 32-битное беззнаковое целочисленное значение, используемое для определения цвета.
Код

function RGB(r, g, b: Byte): COLORREF;

В листинге 22.1 используется функция RGB, позволяющая пользователю выбирать специальные цвета, как показано на рис. 22.1.

Рисунок 22.1 Создание специальных цветов с помощью функции RGB
 Приложение использует компонент TPanel в качестве фрейма предварительного просмотра и три компонента TScrollBar, которые позволяют пользователю модифицировать компоненты красного, зеленого и синего цветов. Свойство Max всех трех компонентов TScrollBar имеет максимальное значение для каждого компонента цвета: 255. Все три компонента TScrollBar совместно используют один очень простой обработчик события OnChange.
Листинг 22.1 Использование функции RGB
Код

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. Результат показан на рис. 22.2.
Листинг 22.2 Рисование линий с помощью методов 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;


Рисунок 22.2 Рисование линий
Класс TPen инкапсулирует следующие три свойства: Color, Width и Style. Различные стили пера Pen показаны на рис. 22.3.

Рисунок 22.3 Стили пера Pen
Метод StylesButtonClick, формирующий графический вывод, показанный на рис. 22.3, представлен в листинге 22.3.
Листинг 22.3 «Игра» со стилями
Код

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, который чаще всего используется для создания эффекта резиновой ленты, показанного на рис. 22.4.

Рисунок 22.4 Резиновая лента
Эффект резиновой ленты можно реализовать довольно просто. Единственное, что вам нужно будет сделать, это нарисовать одну и ту же линию два раза. При первом разе пиксели холста будут инвертированными, чтобы сделать линию видимой. Когда вы прорисуете линию еще раз с помощью pmNotXor, пиксели на холсте будут восстановлены до своего первоначального состояния, стирая, таким образом, линию.
Код, представленный в листинге 22.4, позволяет рисовать линии на холсте точно так же, как и в редакторе Paint или в любом другом приложении, поддерживающим рисование.
Листинг 22.4 Рисование линий
Код

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.

Рисунок 22.5 Стили кисти 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. Поэтому, когда вам нужно будет вызвать функцию GDI напрямую, вы можете передать свойство Handle холста в качестве параметра DC (см. рис. 22.6).

Рисунок 22.6 Черчение текста
Следующий листинг содержит код, формирующий графический вывод, показанный на рис. 22.6.
Листинг 22.6 Черчение текста
Код

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;


Рисунок 22.7 Метод TextRect
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.

Рисунок 22.8 Функция DrawText
Следующий листинг содержит код, который генерирует графический вывод, показанный на рис. 22.8.
Листинг 22.8 Использование функции 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, чтобы определить, нужно ли рисовать каждый символ. Код для этой функции вы можете посмотреть в листинге 22.9.

Рисунок 22.9 Использование функции TextWidth для определения ширины символа
Листинг 22.9 Использование функции 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 для отображения текстового сообщения на форме.
Листинг 22.10 Использование функций 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;

Результаты работы метода GetDCButtonClick показаны на рис. 22.10.

Рисунок 22.10 Результаты работы кода, приведенного в листинге 22.10
Функция GetWindowDC является еще одной функцией, позволяющей получить контекст устройства. В отличие от класса TCanvas и функции GetDC, которые позволяют рисовать только в клиентской области окна, GetWindowDC возвращает контекст устройства всего окна, включая строку заголовка, меню и границы окна.
На примере следующего листинга показано рисование в клиентской и не клиентской областях окна.
Листинг 22.11 Использование функции 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;


Рисунок 22.11 Рисование в не клиентской области окна
      

Это сообщение отредактировал(а) Snowy - 22.6.2006, 12:42
PM MAIL   Вверх
Akella
Дата 21.6.2006, 09:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 1
Всего: 329



Событие OnPaint
Вы могли заметить, что элементы графики, показанные в предыдущем примере, выглядят нормально до тех пор, пока вы не начнете перемещать окно, не свернете его, или не закроете другим окном. На самом деле, если вы сделаете что-нибудь, что напрямую или косвенно будет связано с окном, то графические элементы либо исчезнут совсем, либо частично (см. рис. 22.12).

Рисунок 22.12 Частично исчезнувшее изображение
Чтобы гарантировать, что элементы вашей графики останутся «невредимыми» вследствие других действий, вы должны написать свой код раскраски в обработчике события OnPaint, поскольку событие OnPaint возникает всякий раз, когда операционная система определяет, что или все окно, или его часть будет перерисовано. Вы можете также вручную запросить перерисовку окна, вызвав Invalidate.
В листинге 22.12 показано, как можно нарисовать простой градиент в обработчике события OnPaint.
Нарисовать градиент проще всего можно следующим образом:
1.    Нарисовать градиент черный-синий, черный-красный или черный-зеленый.
2.    Нарисовать градиент в 256 этапов, независимо от ширины или высоты окна назначения.
3.    Рассчитать высоту или ширину прямоугольной области, которую необходимо перерисовать для каждого цвета (если форма имеет 1000 пикселей по высоте, вы должны нарисовать прямоугольник высотой 4 пикселя для каждого цвета).
Листинг 22.12 Рисование простого градиента
Код

{ Градиент черный-синий }
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;

Градиент, нарисованный с помощью кода из листинга 22.12, показан на рис. 22.13.

Рисунок 22.13 Простой градиент
Градиент на рис. 22.13 будет отображаться должным образом до тех пор, пока вы не измените размеров окна. Если вы хотите, чтобы градиент отображался правильно при изменении размеров окна, вызовите Invalidate в обработчике события OnResize, чтобы перерисовать всю форму:
Код

procedure TMainForm.FormResize(Sender: TObject);
begin
  Invalidate;
end;

Когда вы выполните этот код, вы заметите мерцание, вызванное методом Invalidate, когда вы попытаетесь изменить размеры окна. Некоторые разработчики пытаются убирать мерцание путем вызова Paint в обработчике события OnResize или путем назначения этого же обработчика событиям OnPaint и OnResize. Так поступать не нужно никогда, особенно если для ваших элементов графики требуется очень много вычислений, так как обработчик события OnPaint будет вызван дважды.
Мерцание появляется вследствие того, что ОС Windows стирает фон окна, прежде чем перерисовывать его. Поэтому, чтобы избежать мерцания, вы просто должны дать Windows команду, чтобы она остановила стирание фона окна. Чтобы сделать это, вы должны обработать сообщение WM_ERASEBKGND и присвоить результату сообщения ненулевое значение (обычно 1). В листинге 22.13 показано, как можно избавиться от проблемы мерцания.
Листинг 22.13 Обработка сообщения 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;

Теперь, когда вы знаете, как можно нарисовать простой немерцающий градиент, мы можем сделать результат еще лучше, используя для повышения качества значения с плавающей точкой. Этот путь будет также более быстрым, поскольку процедуры MoveTo и LineTo рисуют линии быстрее, чем FillRect.
Листинг 22.14 Еще один способ рисования градиента
Код

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.

Градиент, нарисованный с помощью кода в листинге 22.14, показан на рис. 22.14.

Рисунок 22.14 Еще один градиент
В завершение давайте создадим настоящий градиент, в котором можно будет использовать специальные граничные цвета.

Рисунок 22.15 Рисование настоящего градиента со специальными цветами
Самое важное, что вы должны сделать, если хотите нарисовать градиент с использованием специальных цветов, это определить, сколько нужно добавить красного, зеленого и синего, чтобы добавить в начальный цвет на каждом этапе. В листинге 22.15 содержится исходный код приложения, показанного на рис. 22.15.
Листинг 22.15 Рисование градиентов, поддерживающих специальные цвета
Код

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.


Побитовые изображения
Если вам необходимо всего лишь отобразить изображение на форме, вы можете использовать компонент TImage и загрузить побитовое изображение в его свойство Picture. Однако если вам необходимо сделать с побитовыми изображениями что-нибудь более сложное, вы должны использовать класс TBitmap. Этот класс является довольно большим классом, позволяющим загружать, сохранять и обрабатывать побитовые изображения.
Класс TCanvas имеет несколько методов, позволяющих вам рисовать побитовые изображения. Тремя наиболее часто используемыми методами являются Draw, StretchDraw и CopyRect. Методы Draw и StretchDraw позволяют вам рисовать целые изображения, а метод CopyRect позволяет рисовать отдельные части побитового изображения, как показано на рис. 22.16.

Рисунок 22.16 Рисование побитовых изображений на холсте
Если внимательно следить за комментариями (и самим кодом, разумеется) в листинге 22.16, можно понять, как осуществляется работа с побитовыми изображениями и их рисование.
Листинг 22.16 Рисование побитовых изображений
Код

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.


Простая анимация
Самый простой способ сделать что-нибудь после определенного промежутка времени – это использовать компонент TTimer (категория System). Если свойству Enabled компонента TTimer присвоить значение True, то TTimer инициирует событие OnTimer по истечении определенного периода времени. Интервал времени (в миллисекундах) определяется посредством свойства Interval.
В следующем примере компонент TTimer используется для последовательного отображения серии цветных прямоугольников.

Рисунок 22. 17 Анимация TTimer
Свойство Interval таймера имеет значение 100, благодаря чему событие OnTimer возникает каждые 100 миллисекунд. В листинге 22.17 представлен код, который отображает прямоугольники, показанные на рис. 22.17.
Листинг 22.17 Рисование случайным образом цветных прямоугольников
Код

procedure TMainForm.AnimatedDraw(Sender: TObject);
var
  i,j: Integer;
begin
  for i := 0 to (ClientWidth div 50) do
    for j := 0 to (ClientHeight div 50) do
    begin
      Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
      Canvas.Rectangle(i * 50, j * 50, (i + 1) * 50, (j + 1) * 50);
    end;
end;

Компонент TTimer не подходит для высококачественной точно рассчитанной по времени анимации, поскольку его разрешение составляет примерно 50 миллисекунд. Одним из способов более точного измерения времени является использование функции Windows API GetTickCount (объявленной в модуле Windows).
Функция GetTickCount получает количество миллисекунд, прошедших с момента запуска системы. Поэтому все, что вам нужно будет сделать, это определить конкретный интервал, который будет служить в качестве начального времени, и просто подождать, пока не истечет необходимый промежуток времени. В следующем примере переменная FTick (тип Cardinal) хранит стартовое значение:
if GetTickCount > FTick + 40 {25 fps} then
begin
  { Сюда поместите свой код }

  FTick := GetTickCount;
end; // Завершение условия if GetTickCount
Рисование снегопада
Сейчас мы попробуем создать простое приложение, которое будет имитировать снегопад (см. рис. 22.18). К сожалению, у меня не оказалось изображения хлопьев снега, поэтому я использовал т.н. «смайлики».

Рисунок 22.18 «Снегопад»
Приложение, которое мы собираемся создать, должно работать с частотой 25 кадров в секунду и использовать двойную буферизацию с целью удаления мерцания. Двойная буферизация представляет собой технологию рисования, которая часто используется, особенно при рисовании мультипликационной графики, для исключения эффекта мерцания. Двойная буферизация включает рисование на двух различных поверхностях: заднем буфере и экране. Двойная буферизация реализуется:
•    Рисованием всего на заднем буфере (внеэкранное изображение)
•    Отображением заднего буфера на экране после завершения рисования
Первое, что мы должны сделать, это объявить переменные, которые мы планируем использовать в этом приложении. Нам потребуется побитовое изображение заднего буфера, побитовое изображение снежинки и целочисленная переменная, которая будет использоваться для хронометража. Нам также потребуется массив TPoint, в котором будут храниться координаты снежинок. Далее представлены объявления переменных:
Код

type
  TMainForm = class(TForm)
private
  { Private declarations }
  Flake: TBitmap; { Снежинка (побитовое изображение «смайлика») }
  FBuffer: TBitmap; { Задний буфер }
  FTick: Cardinal; { Используется для анимации }
  Snow: array[1..255] of TPoint; { Будем использовать 255 снежинок }
public
  { Public declarations }
end;

Теперь мы должны создать изображения заднего буфера и снежинки в обработчике события OnCreate и написать обработчик события OnDestroy для удаления этих изображений из памяти после завершения работы с ними.
Листинг 22.18 Подготовка заднего буфера и случайный разброс снежинок
Код

procedure TMainForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  { Создание и настройка побитового изображения заднего буфера }
  FBuffer := TBitmap.Create;
  { Очень важная часть: придаем заднему буферу точно такие же размеры, как и у формы}
  FBuffer.Width := Self.ClientWidth;
  FBuffer.Height := Self.ClientHeight;

  { Создание и загрузка изображения снежинки }
  Flake := TBitmap.Create;
  Flake.LoadFromFile('flake.bmp');
  Flake.Transparent := True;

  { Задание случайных координат снежинок; координаты Y должны
    быть отрицательными, чтобы снежинки появлялись вверху экрана
    в момент запуска формы }
  for i := Low(Snow) to High(Snow) do
  begin
    Snow[i].Y := -Random(Self.ClientHeight);
    Snow[i].X := Random(Self.ClientWidth) + Flake.Width;
  end;

  { Начало хронометража }
  FTick := GetTickCount;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  { Удаление «спрайта» и заднего буфера из памяти }
  Flake.Free;
  FBuffer.Free;
end;

Все, что нам нужно сделать сейчас, это создать процедуру, которая будет рисовать снежинки, и процедуру, которая будет вызывать эту процедуру каждые 40 миллисекунд для получения необходимой анимации 25 кадров в секунду.
Анимация снежинок вообще не сложная. Вам нужно сделать всего лишь следующее:
•    Добиться падения снежинок посредством постоянного увеличения координаты Y на пару пикселей (а лучше всего – на случайное количество снежинок).
•    Сделать так, чтобы снежинки случайным образом двигались влево или вправо.
•    Когда снежинка достигнет поверхности основания, нужно присвоить ее координате Y значение 0 или меньше, чтобы снежинка вновь начала падать (если хотите, конечно).
В листинге 22.19 содержится метод DrawFlakes, который рисует все снежинки на заднем буфере и задний буфер на экране. Метод DrawFlakes использует постоянный массив значений для перемещения снежинок, а не функцию Random или RandomRange, поскольку использование массива позволяет получить более качественное движение.
Листинг 22.19 Рисование снежинок
Код

procedure TMainForm.DrawFlakes;
const
  RANDOM_MOVES: array[0..5, 0..2] of Integer = ((1, -2, -1), (-1, 0, 1), (-1, 2, 1), (2, 1, -2), (-3, 1, 3), (2, 0, -2));
var
  i: Integer;
begin
  { Очистка заднего буфера }
  FBuffer.Canvas.Brush.Color := Color;
  FBuffer.Canvas.FillRect(FBuffer.Canvas.ClipRect);


  Randomize;

  for i := Low(Snow) to High(Snow) do
  begin
    { Выбор новой горизонтальной части для каждой снежинки }
    Snow[i].X := Snow[i].X + RANDOM_MOVES[Random(5), Random(2)];

    { Использование Abs для получения положительных значений и снегопада }
    Snow[i].Y := Snow[i].Y + Abs(RANDOM_MOVES[Random(5), Random(2)]);

    { Если снежинка достигает поверхности основания, используем ее повторно }
    if Snow[i].Y > Self.ClientHeight then
      Snow[i].Y := -(Random(ClientHeight) div 2);

    { Не позволяем снежинке оставлять экран горизонтально }
    if Snow[i].X < 0 then
      Snow[i].X := 0
    else if (Snow[i].X + Flake.Width) > Self.ClientWidth then
      Snow[i].X := Self.ClientWidth - Flake.Width;

    { Рисуем снежинку на заднем буфере }
    FBuffer.Canvas.Draw(Snow[i].X, Snow[i].Y, Flake);
  end;

  { Наконец, отображаем буфер }
  Canvas.Draw(0, 0, FBuffer);
end;

Теперь настал черед написания кода анимации. Лучшим местом для этого кода является обработчик события OnIdle приложения. Событие OnIdle потому является удобным для этой цели, что оно позволяет посредством передачи значения False параметру Done получить столько времени работы ЦП, сколько необходимо. Внутри обработчика события OnIdle мы можем вызвать функцию GetTickCount, чтобы определить, сколько времени прошло, и вызвать DrawFlakes для отображения снежинок.
Во-первых, перенесите компонент TApplicationEvents на поверхность Designer Surface (Поверхность конструктора), и затем напишите код, представленный в листинге 22.20.
Листинг 22.20 Анимация снежинок
Код

procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
begin
  { Присвойте Done значение False, чтобы OnIdle работало постоянно }
  Done := False;

  { Если прошло достаточно времени, вызовите DrawFlakes, чтобы обновить экран }
  if GetTickCount > FTick + 40 {25 fps} then
  begin
    DrawFlakes;

    { Запоминаем время, когда был нарисовано кадр }
    FTick := GetTickCount;
  end; // Завершение условия GetTickCount
end;


Рисование на рабочем столе
Если вы хотите рисовать на рабочем столе, вы должны использовать несколько функций GDI, особенно если вы хотите сделать то, над чем мы сейчас бьемся: обновить предыдущий пример и нарисовать снежинки на рабочем столе. Кроме этого, мы собираемся использовать снежинки для рисования изображения на рабочем столе (см. рис. 22.19).

Рисунок 22.19 Рисование на рабочем столе
Чтобы успешно обновить предыдущий пример, вы должны знать следующее:
•    Как используется функция GetDC для получения контекста устройства рабочего стола
•    Как используется функция BitBlt для рисования изображений на экране
•    Как используется функция TransparentBlt для рисования прозрачных изображений (работает только в Win98, Win2K и в поздних версиях)
•    Как используется функция InvalidateRect для обновления окна
Чтобы получить контекст устройства рабочего стола, вызовите функцию GetDC и передайте 0 в качестве параметра hWind. Не забудьте вызвать функцию ReleaseDC, чтобы освободить контекст устройства после окончания работы с ним:
Код

var
  desktopDC: HDC;
begin
  desktopDC := GetDC(0);
  try
  finally
    ReleaseDC(0, desktopDC);
  end; // Завершение конструкции try
end;

Если вы хотите отобразить побитовое изображение как можно быстрее, используйте функцию BitBlt. Эта функция требует передачи большого количества параметров: идентификаторов для контекстов устройств источников и назначения, четыре координаты прямоугольника, две координаты источника и код операции с растром:
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer;
  SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): BOOL; stdcall;
Параметр Rop (raster operation code – код операции с растром) определяет, как пиксели изображения будут комбинированы с исходными пикселями (инвертированы, соединены и т.п.). Существует несколько значений, которые вы можете передать в качестве параметра Rop, однако мы бдем использовать только константу SRCCOPY. Эта константа используется, когда вы хотите скопировать исходные пиксели прямо в прямоугольную область назначения.
Далее показан пример, иллюстрирующий, как функция BitBlt используется для отображения побитового изображения на форме.
Листинг 22.21 Использование функции BitBlt для рисования побитовых изображений
Код

type
  TMainForm = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    B: TBitmap;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  B := TBitmap.Create;
  B.LoadFromFile(ExtractFilePath(Application.ExeName) + 'image.bmp');
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  B.Free;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
  { Рисование всего изображения в верхнем левом углу формы }
  BitBlt(Canvas.Handle, 0, 0, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY);
end;

end.

Список параметров функции TransparentBlt очень похож на список параметров функции BitBlt. Единственное существенное различие заключено в последнем параметре. Функция TransparentBlt требует вместо кода операции с растром передать цвет, который будет обработан как прозрачный. Далее показано объявление функции TransparentBlt:
function TransparentBlt(DC: HDC; p2, p3, p4, p5: Integer; DC6: HDC; p7, p8, p9, p10: Integer; p11: UINT): BOOL; stdcall;
Функция InvalidateRect может использоваться для аннулирования части всего окна. Эта функция принимает три параметра: идентификатор окна, прямоугольную область, которая определяет обновляемую часть окна (чтобы обновить все окно, необходимо передать nil), и булево (логическое) значение, которое определяет, нужно ли удалять фон окна. Далее показано объявление функции InvalidateRect:
function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; stdcall;
Теперь, когда вы знаете о том, как работает функция, вы можете просмотреть листинг 22.22, чтобы понять, как рисуются снежинки на рабочем столе.
Листинг 22.22 Рисование снежинок на рабочем столе
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, AppEvnts, XPMan, StdCtrls;

type
  TMainForm = class(TForm)
    ApplicationEvents: TApplicationEvents;
    RefreshButton: TButton;
    XPManifest: TXPManifest;
    procedure RefreshButtonClick(Sender: TObject);
    procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Flake: TBitmap;
    FBuffer: TBitmap;
  public
    { Public declarations }
    FTick: Cardinal;
    Snow: array[1..255] of TPoint;
    procedure DrawFlakes;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  { Создание заднего буфера для хранения изображения снежинок,
    рисуемых на рабочем столе }
  FBuffer := TBitmap.Create;
  FBuffer.LoadFromFile(ExtractFilePath(Application.ExeName) + 'back.bmp');

  { Создание и загрузка снежинки }
  Flake := TBitmap.Create;
  Flake.LoadFromFile('flake.bmp');

  for i := Low(Snow) to High(Snow) do
  begin
    Snow[i].Y := -Random(Screen.Height);
    Snow[i].X := Random(Screen.Width) + Flake.Width;
  end;

  { Начало хронометража }
  FTick := GetTickCount;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Flake.Free;
  FBuffer.Free;

  { Обновление рабочего стола }
  InvalidateRect(0, nil, True);
end;

procedure TMainForm.DrawFlakes;
  const
    RANDOM_MOVES: array[0..5, 0..2] of Integer = ((1, -2, -1), (-1, 0, 1), (-1, 2, 1), (2, 1, -2), (-3, 1, 3), (2, 0, -2));
  var
    i: Integer;
    desktopDC: HDC;
  begin
    { Получение контекста устройства рабочего стола }
    desktopDC := GetDC(0);
    try
      for i := Low(Snow) to High(Snow) do
      begin
        { Изменение части рабочего стола, прошедшей снежинкой }
        BitBlt(desktopDC, Snow[i].X, Snow[i].Y, Flake.Width, Flake.Height, FBuffer.Canvas.Handle, Snow[i].X, Snow[i].Y, SRCCOPY);

        { Выбор новой горизонтальной позиции для снежинки }
        Snow[i].X := Snow[i].X + RANDOM_MOVES[Random(5), Random(2)];

        { Падение снежинки }
        Snow[i].Y := Snow[i].Y + Abs(RANDOM_MOVES[Random(5), Random(2)]);

        { Если снежинка достигает поверхности основания, использем ее повторно }
        if Snow[i].Y > Screen.Height then
          Snow[i].Y := -(Random(Screen.Height) div 2);

        { Снежинка не должна покинуть пределов экрана }
        if Snow[i].X < 0 then
          Snow[i].X := 0
        else if (Snow[i].X + Flake.Width) > Screen.Width then
          Snow[i].X := Screen.Width - Flake.Width;

        { Рисуем снежинку }
        TransparentBlt(desktopDC, Snow[i].X, Snow[i].Y, Flake.Width, Flake.Height, Flake.Canvas.Handle, 0, 0, Flake.Width, Flake.Height, clWhite);
      end; // Завершение конструкции for
    finally
      ReleaseDC(0, desktopDC);
    end; // Завершение конструкции try
end;

procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
begin
  Done := False;

  if GetTickCount > FTick + 40 {25 fps} then
  begin
    DrawFlakes;
    FTick := GetTickCount;
  end; // Завершение условия if GetTickCount
end;

procedure TMainForm.RefreshButtonClick(Sender: TObject);
begin
  InvalidateRect(0, nil, False);
end;

end.
 

Это сообщение отредактировал(а) Snowy - 22.6.2006, 12:46
PM MAIL   Вверх
Мишка
Дата 21.6.2006, 09:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 5
Регистрация: 17.5.2006

Репутация: нет
Всего: нет



Толково. Всё в одном. И не надо лазить по книгам smile. Зачот. 
PM MAIL   Вверх
December
Дата 21.6.2006, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Antitheorist
****


Профиль
Группа: Участник
Сообщений: 4423
Регистрация: 14.8.2002
Где: Харьков

Репутация: нет
Всего: 57



Предлагаю закрепить тему, потому как это - ответ на все вопросы новичков по GDI 


--------------------
Для друзей с винграда - скидки на разработку сайтов
PM MAIL WWW ICQ   Вверх
Snowy
Дата 21.6.2006, 10:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484



Только нужно оформить и рисунки вставить.
А то просто скопировано с книжки... А рисунки-то где??

Добавлено @ 10:25 
Цитата(Мишка @  21.6.2006,  09:27 Найти цитируемый пост)
Толково. Всё в одном. И не надо лазить по книгам
Это и есть глава из книги.

Цитата(December @  21.6.2006,  10:06 Найти цитируемый пост)
Предлагаю закрепить тему
Закрепил.

Цитата(December @  21.6.2006,  10:06 Найти цитируемый пост)
ответ на все вопросы новичков по GDI 
Остальные ответы ищите в полной версии книги  smile 

Цитата(Akella @  21.6.2006,  09:20 Найти цитируемый пост)
материалы из книги
А вот это нужно на самый верх. С этого нужно было начинать. 
PM MAIL   Вверх
Romikgy
Дата 21.6.2006, 12:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7325
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: нет
Всего: 146



Согласен со 
Snowysmile
Для новичков наверное хороший материал smile
и картинок реально не хватает smile
но все равно выражаю благодарность за труд 
Akella smile 


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile

PM   Вверх
Akella
Дата 21.6.2006, 12:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 1
Всего: 329



парни, давайте ссылки на эту тему своим друзьм, коллегам, знакомым, пусть читают, оставляют отзывы ну и вообще.... 
PM MAIL   Вверх
davandr
Дата 21.6.2006, 17:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 304
Регистрация: 25.10.2005
Где: Украина, Харьков

Репутация: нет
Всего: нет



Где ты был раньше?? 
В свое время твоя статья мне бы очень пригодилась... )))
Неплохо расписал. 


--------------------
PM MAIL   Вверх
Snowy
Дата 21.6.2006, 17:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484



davandr, это КНИГА.
Глава из которой здесь размещена, согласно партнёрской программе с http://www.williamspublishing.com/
Вот купил бы ты эту книгу - и не было бы проблем smile 
PM MAIL   Вверх
Vladimir111
Дата 26.11.2007, 21:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 26.11.2007

Репутация: нет
Всего: нет



ребят, а есть где нибудь эти книги в бесплатном доступе....

а то купить их немогу..)))) smile 
PM MAIL   Вверх
Snowy
Дата 27.11.2007, 12:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484



А что мешает купить?
http://www.williamspublishing.com/cgi-bin/...-4&next=yes

Что касается электронного вариата, то, даже, если бы он существовал, то публиковать линк на него неэтично, ибо партнёрская программа.
PM MAIL   Вверх
Vladimir111
Дата 27.11.2007, 19:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 26.11.2007

Репутация: нет
Всего: нет



то что я не живу не в одной из этих стран..)))) smile 
PM MAIL   Вверх
avosi
Дата 7.5.2008, 10:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 43
Регистрация: 15.11.2007

Репутация: нет
Всего: нет



Если у кого есть электронная варсия напишите плиз в личку. 
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!


Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »


 




[ Время генерации скрипта: 0.2086 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.