ColoSizerвид изнутри

Программа написана на Delphi в рамках VCL Win32. Одной из задач, которые надо уметь решать при написании подобных программ, является получение координат курсора в любом месте экрана, а не только в пределах окна самой программы. Сделать это можно с промощью вызова системной функции GetCursorPos, объявление которой в Delphi выглядит так:

function GetCursorPos(var lpPoint: TPoint): bool; stdcall;

Через параметр lpPoint возвращаются именно экранные координаты курсора, а не координаты в клиентской области программы. Сам тип TPoint предсавляет собой запись:

type
  TPoint = packed record
    X: Longint;
    Y: Longint;
  end;

При успешном завершении функция возвращает true. В справке Delphi есть пояснение, что эта функция всегда должна завершаться успешно. Так это или нет, непонятно. На всякий случай я проверяю результат. В исходном коде программы это выглядит так:

var
  cp: TPoint;    // cursor position
  ...
  if not GetCursorPos(cp) then
    Exit;        // выход
  // если все в порядке, то работаем дальше, имея в cp координаты курсора
  ...

Этот способ получения экранных координат не единственный. Можно также воспользоваться сообщением мыши WM_NCMOUSEMOVE когда курсор находится вне клиентской области программы и, имеющимся в Delphi, обработчиком OnMouseMove, если курсор внутри клиентской области. Подробнее об этом варианте можно прочитать в [1], гл.12.3. Однако, вариант с перехватом сообщений я оцениваю как более сложный, сильнее нагружающий компьютер, и для данного типа программ избыточный.

Итак, координаты курсора получены. Теперь нужно решить вторую задачу - получить доступ к самим пикселам, то есть к растру экрана. Типовым способом для этого в операционной системе Windows является получение, так называемого, контекста графического устройства, точнее дескриптора контекста устройства. Здесь, видимо, нужно сначала пояснить, а для кого-то всего лишь напомнить, что же такое контекст устройства.

Важнейшей составной частью операционных систем семейства Windows является графическая подсистема, которая называется GDI (Graphics Device Interface - Интерфейс графического устройства). Целью разработки GDI было создание такого положения вещей, при котором любая прикладная программа могла бы осуществлять вывод своей графики на любое графическое устройство, без необходимости знать что-либо об особенностях его конструкции. От производителя монитора или видеокарты требуется лишь обеспечить свое изделие драйвером, отвечающим заранее объявленным требованиям. Все осталное берет на себя операционная система.

Базовым понятием GDI является понятие контекста устройства (Device Context - DC). Это набор данных необходимых для правильного взаимодействия с графическим устройством с учетом особенностей его конструкции и текущего режима работы. Прикладные программы никогда не работают с этим набором данных непосредственно. С ним работают функции GDI, которых имеется очень много. Вот как раз к функциям GDI и обращаются прикладные программы. Те же графические функции Delphi всего лишь чуть более удобная упаковка для соответствующих функций GDI.

Естественно, при вызове фунций GDI, им нужно как-то указать с каким именно набором данных для графических устройств, то есть контекстом, следует работать. Дескриптор контекста устройства это некий уникальный системный номер, под которым в текущий момент зарегистрирован в системе соответствующий контекст. Все функции GDI одним из параметров получают этот дескриптор по которому и находят нужный контекст. Тип дескриптора контекста HDC. Несколько более подробно об этом можно прочитать в [2].

Итак, получаем дескриптор контекста экрана монитора. Для этого существует системная функция GetDC:

function GetDC(hWnd: HWND): HDC;

Параметр hWnd - это дескриптор того окна, контекст которого надо получить. Если в качестве значения этого параметра указать 0, то функция вернет дескриптор контекста экрана, что нам и требуется. После того, как все графические операции, необходимые в данный момент будут выполнены, контекст устройства надо сразу же освободить. Это важно! Если этого не сделать, то разработчики Windows обещают большие проблемы. Освобождается дескриптор контекста функцией ReleaseDC:

function ReleaseDC(hWnd: HWND; DC: HDC): integer;

Здесь первый параметр - дескриптор того окна, контекст которого получали фунцией GetDC, а второй, сам освобождаемый дескриптор контекста. Если освобождение контекста устройства прошло успешно функция возвращает 1, если нет, то 0. Пример:

var
  DC : HDC;
begin
  //  получаем контекст экрана
  DC:= GetDC(0);
  //  вызываем нужные нам GDI функции
  ...
  //  освобождаем контекст экрана
  if ReleaseDC(0, DC) <> 1 then
    Halt;   // ничего не поделаешь, придется сворачивать балаган
  //  если освобождение контекста прошло успешно, можно работать дальше, но уже без GDI
  ...
end;

Итак, контекст экрана получен, что дальше? А дальше, все что душа пожелает. Используя функции GDI, которых немало, можно копировать с экрана любые его области, или наборот на него, рисовать прямо на экране пером или кистью (именно "на растре", а не на Рабочем Столе). Описывать подробно применение функций GDI в рамках данной статьи нет смысла. Не только потому, что Вы легко найдете массу превосходной литературы по данной теме, но еще и потому, что в ColoSizer'е этот вариант не используется. Точнее, используется несколько иначе.

Дело в том, что у тех кто программирует на Delphi есть возможность, вместо функций GDI, использовать для рисования на экране привычные для себя методы канвы. Лично я подсмотрел этот способ в [3], хотя, думаю, есть и другие источники. Суть его предельно проста. Как указывалось выше, методы канвы Delphi это упаковка Функций GDI. Цель этого "пакования" - упростить использование системных функций для графики. И вполне естественно, в свете этого, что канва имеет свойство Handle, тип которого точно соответствует типу контекста устройства - HDC. Если полученный дескриптор контекста экрана, присвоить свойству Handleканвы, то все методы канвы будут работать прямо по экрану. Это удобно, хотя бы уже тем, что привычно. Пример:

var
  DC : HDC;
  ScrCv : TCanvas;      // канва для доступа к экрану
  ...
//  где-то в начале программы, например в обработчике OnCreate формы, нужно создать канву
procedure TForm1.FormCreate(Sender: TObject);
begin
  //  создание канвы для доступа к экрану
  ScrCv:= TCanvas.Create;
  ...
end;
  ...
//  процедура использующая методы канвы
begin
  //  получаем контекст экрана
  DC:= GetDC(0);
  //  "совмещаем" нашу канву с экраном
  ScrCv.Handle:= DC;
  //  используем методы канвы
  ...
  //  освобождаем контекст экрана
  if ReleaseDC(0, DC) <> 1 then
    Halt;    // закрываемся
  //  если освобождение контекста прошло успешно, можно работать дальше, но уже не используя канву
  ...
end;
  ...
//  где-то в конце программы, например в обработчике OnDestroy формы, нужно удалить канву
begin
  ...
  ScrCv.free;
  ...
end;

Осталось решить последний вопрос: каким образом вызывать процедуру работающую с экраном, именно в свете специфики ColoSizer'а. Если бы использовался перехват собщений перемещения мыши, тогда эта процудура была бы в соответствующих обработчиках событий: перемещения внутри клиентской области окна ColoSizer'а и вне ее. Но поскольку этот варинт не используется, я просто использую компонент Timer. Период я утановил 100мс, то есть опрос положения курсора и вся связанная с этим работа выполняется 10 раз в секунду, что на практике оказалось вполне нормальным вариантом. Привожу пример обработчика событий таймера, в котором по сути и содержится базовый функционал программы.

Однако, сразу поясню, что это не точная копия исходного кода ColoSizer'а. Пример упрощен, местами до условного уровня, для того, чтобы яснее была суть. В нем отсутствуют ветвления связанные с переключением масштаба и тем, какой режим включен: "цвет" или "расстояние/размер". Вместо этого считается, что есть, как бы только режим "цвет" и только один масштаб. Отсутствует закрашивание черным части увеличивающего образа, когда курсор приближается к границам экрана и еще много чего отсутствует из того, что обеспечивает правильную работу любой реальной программы. Однако, все эти подробности относятся к общим, типовым приемам программирования. Предполагается, что раз Вы читаете эту статью, то с решением типовых задач у Вас уже больших проблем нет. Цель же данной статьи в том, чтобы осветить сугубо специальный вопрос, который как правило не упоминается в большинстве книг по программированию в связи с его редкой востребованностью со стороны большинства программистов.

Итак, сам пример:

implementation

{$R *.DFM}

var
  //  Screen Canvas - канвa, методами которой будем пользоваться для доступа к экрану
  ScrCv : TCanvas;
  //  вспомогательная запись для упрощения доступа к отдельным байтам цвета
  Pix : record
    case integer of
      0: (cl: TColor);
      1: (r : byte;
          g : byte;
          b : byte;
          a : byte);
    end;
  //  loupe fixed - зафиксировано изображени в увеличивающем образе или должно перерисовываться
  lfix : boolean = false;
  //  cursor area width, ... height - ширина и высота увеличиваемой области вокруг курсора
  carw, carh : integer;
  //  cursor position in cursor area - 
  //  координаты курсора относительно левого верхнего угла увеличиваемой области
  cpcar : TPoint;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //  создаем канву для доступа к экрану
  ScrCv:= TCanvas.Create;
  //  задаем размеры матрицы закрашиваемого цветом пиксела образа (Color Image - вверху слева) 
  CImg.Picture.Bitmap.Width:= CImg.Width;
  CImg.Picture.Bitmap.Height:= CImg.Height;
  //  задаем размеры матрицы увеличивающего образа (Loupe Image)
  LImg.Picture.Bitmap.Width:= 350;
  LImg.Picture.Bitmap.Height:= 170;
  //  задаем размеры области вокруг курсора
  carw:= 35;
  carh:= 17;
  //  задаем положение курсора относительно левого верхнего угла увеличиваемой области
  cpcar.x:= carw div 2;
  cpcar.y:= carh div 2;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  //  при каждом нажатии клавиши "пробел" фиксируем или освобождаем изображение в увеличивающем образе
  if Key = VK_SPACE then
    lfix:= not lfix;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  cp : TPoint;          // экранные координаты курсора
  DC : HDC;             // дескриптор контекста экрана
  //  следующие переменные нужны лишь для улучшения читаемости текста программы
  scrrt, irt : TRect;   // прямоугольники на экране и в образе
  car : TPoint;         // экранные координаты увеличиваемой области вокруг курсора
begin
  //  получаем экранные координаты курсора
  if not GetCursorPos(cp) then
    Exit;
  //  получаем контекст экрана
  DC:= GetDC(0);
  //  "совмещаем" нашу канву с экраном
  ScrCv.Handle:= DC;
  //  получаем цвет пиксела под курсором обычным для Delphi способом
  Pix.cl:= ScrCv.Pixels[cp.x, cp.y];
  //  копируем пиксел под курсором с растяжением и тем самым закрашиваем его цветом образ CImg (ColorImage)
  irt:= Rect(0, 0, CImg.Width, CImg.Height);
  scrrt:= Rect(cp.x, cp.y, cp.x+1, cp.y+1);
  CImg.Canvas.CopyRect(irt, ScrCv, scrrt);
  //  если увеличивающий образ не зафиксирован, то надо перерисовывать
  if not lfix then begin
    //  готовим данные для копирования области вокруг курсора
    irt:= Rect(0, 0, LImg.Picture.Bitmap.Width, LImg.Picture.Bitmap.Height);
    //  вычисляем экранные координаты области вокруг курсора
    car.x:= cp.x - cpcar.x;
    car.y:= cp.y - cpcar.y;
    scrrt:= Rect(car.x, car.y, car.x + carw, car.y + carh);
    //  копируем область вокруг курсора с увеличением в предназначенный для этого образ LImg (Loupe Image)
    LImg.Canvas.CopyRect(irt, ScrCv, scrrt);
  end;
  //  освобождаем контекст экрана
  if ReleaseDC(0, DC) <> 1 then
    Halt;    // увы, придется "вылетать"
  //  чтобы удерживать контекст экрана как можно меньше,
  //  все что можно сделать без него, делаем или до его получения или уже после его освобождения
  ...
  //  отображаем значения цветовых составляющих на панельках под заголовком окна
  //  (показано для красного цвета, остальные аналогично)
  RhPanel.Caption:= IntToHex(Pix.r, 2);
  RdPanel.Caption:= IntToStr(Pix.r);
  ...
  if not lfix then begin
    //  если надо, рисуем сетку и маркер пиксела каким угодно способом
    ...
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //  удаляем канву для экрана
  ScrCv.free;
end;

На всякий случай напоминаю, метод канвы CopyRect работает с увеличением или уменьшением копируемого изображения в тех случаях, когда размеры прямоугольника источника не совпадают с размерами прямоугольника приемника копии. Размеры матрицы увеличивающего образа LImg и размеры увеличиваемой области на экране можно выбирать любые, но они должны быть кратными (другими словами, масштаб увеличения обязательно целое число), иначе увеличение будет неравномерным, причем кратность эта должна быть одинакова для ширины и высоты, иначе увеличенные пикселы не будут квадратными. Кроме того, матрица образа может быть равной размеру самого образа или чуть больше, а вот меньше ее делать не следует, иначе при перерисовке могут появиться неприятные помехи.

Рассмотренный способ получения доступа к растру экрана не единственный. Можно использовать, так называемую, первичную поверхность DirectX [3], а те кто пишет что-либо на OpenGL, возможно, сделали бы по своему. Первоначальная версия программы, как раз и была написана с использованием DirectX 7. Она прекрасно работала в Windows XP, но в семерке работать отказалась. Разбираться с причинами я не стал, поскольку к тому моменту стало ясно, что применение DirectX для такой, относительно несложной задачи, избыточно. Нынешний вариант выглядит как самый простой.

СПИСОК ЛИТЕРАТУРЫ

1. Архангельский А.Я. Приемы программирования в Delphi на основе VCL. - М.; ООО "Бином-пресс", 2006 г. - 944 с.; ил.
2. Гончаров Д., Салихов Т. DirectX 7.0 для программистов. Учебный курс (+CD). - СПб.; Питер, 2001 - 528 с.; ил.
3. Краснов М.В. DirectX. Графика в проектах Delphi. - СПб.; БХВ-Петербург, 2001. - 416 с.; ил.