Developing with Graphics/ru

From Free Pascal wiki
Jump to navigationJump to search

Deutsch (de) English (en) español (es) français (fr) italiano (it) 日本語 (ja) 한국어 (ko) Nederlands (nl) português (pt) русский (ru) slovenčina (sk) 中文(中国大陆)‎ (zh_CN) 中文(台灣)‎ (zh_TW)

Эта страница описывает основные классы и технологии рисования графики в Lazarus. Какие-то специфические вещи ищите в других статьях.

Графические библиотеки

Графические библиотеки - здесь вы можете посмотреть, какие есть основные графические библиотеки.

Другие статьи по графике

2D-рисование

  • ZenGL - кроссплатформенная библиотека для разработки игр на основе OpenGL.
  • BGRABitmap - Рисование фигур, прозрачных изображений, прямой доступ к пикселям и др.
  • LazRGBGraphics - Пакет для быстрой обработки изображения в памяти и работы с пикселями (например, scan line).
  • fpvectorial - Предоставляет возможность работы с векторной графикой.
  • Double Gradient - Рисуйте легко растровые изображения 'double gradient' и 'n-gradient'.
  • Gradient Filler - TGradientFiller - лучший способ создания пользовательских n-градиентов в Lazarus.
  • PascalMagick - простой в использовании API для взаимодействия с ImageMagick, многоплатформенным пакетом бесплатного программного обеспечения для создания, редактирования и создания растровых изображений.
  • Sample Graphics - графическая галерея, созданная с помощью Lazarus и инструментов для рисования.
  • Fast direct pixel access - сравнение скорости некоторых методов для прямого доступа к растровому пикселю.
  • AggPas - это нативный порт Object Pascal библиотеки Anti-Grain Geometry. Он быстр и очень мощен [при работе] со сглаженным рисунком и субпиксельной точностью. Вы можете думать об AggPas как о механизме рендеринга, который создает пиксельные изображения в памяти из некоторых векторных данных.

3D-рисование

Диаграммы

  • TAChart - компонента для рисования диаграмм в Lazarus
  • PlotPanel - Создание и черчение анимированных графиков
  • Perlin Noise - статья об использовании Perlin Noise в LCL приложениях.

Введение в графическую модель LCL

LCL предоставляет два вида классов рисования: нативные [(собственные)] классы и не-нативные [(сторонние)] классы. Нативные графические классы являются наиболее традиционным способом рисования графики в LCL, а также являются наиболее важными, в то время как не-нативные классы являются дополнительными, но также очень важными. Собственные классы в основном расположены в модуле Graphics LCL и являются хорошо известными классами: TBitmap, TCanvas, TFont, TBrush, TPen, TPortableNetworkGraphic и т.д.

TCanvas - это класс, способный выполнять рисование. Он не может существовать один и должен быть либо прикреплен к чему-то видимому (или, по крайней мере, который может быть видимым), например, к визуальному элементу управления, происходящему из TControl, либо должен быть присоединен к внеэкранному буферу потомка от TRasterImage (TBitmap является наиболее часто использующимся). TFont, TBrush и TPen описывают, как рисование различных операций будет выполняться в Canvas.

TRasterImage (обычно используется через его потомка TBitmap) - это область памяти, зарезервированная для рисования графики, но она создана для максимальной совместимости с собственным Canvas и, следовательно, в LCL-Gtk2 в X11 она расположена на сервере X11, который обеспечивает попиксельный доступ через свойство Pixels чрезвычайно медленно. В Windows это очень быстро, потому что Windows позволяет создавать локально выделенное изображение, которое может получать рисунки из Windows Canvas.

Помимо них существуют также не-нативные классы рисования, расположенные в графическом типе модулей (TRawImage), intfgraphics (TLazIntfImage) и lazcanvas (TLazCanvas, этот существует в Lazarus [с версии] 0.9.31+). TRawImage - это хранилище и описание области памяти, которая содержит изображение. TLazIntfImage - это изображение, которое присоединяется к TRawImage и обеспечивает преобразование между TFPColor и форматом настоящего пикселя TRawImage. TLazCanvas - это не нативный Canvas, который может рисовать изображение в TLazIntfImage.

Основное различие между нативными и не-нативными классами состоит в том, что нативные классы не выполняются одинаково на всех платформах, потому что рисование выполняется самой базовой платформой. Скорость, а также точный конечный результат рисования изображения могут иметь различия. Не-нативные классы гарантированно выполняют одинаковое рисование на всех платформах с точностью до пикселя, и все они работают достаточно быстро на всех платформах.

В наборе виджетов LCL-CustomDrawn нативные классы реализованы с использованием не-нативных классов.

Все эти классы будут лучше описаны в разделах ниже.

Работа с TCanvas

Рисование прямоугольника

Многие элементы управления, например TForm, TPanel или TPaintbox, отображают свой холст как общедоступное свойство или событие OnPaint. Давайте используем TForm в качестве примера, чтобы продемонстрировать, как рисовать на холсте.

Предположим, мы хотим нарисовать красный прямоугольник с синей рамкой толщиной 5 пикселей в центре формы; размер прямоугольника должен составлять половину размера формы. Для этого мы должны добавить код в событие OnPaint формы. Не рисуйте в обработчике OnClick, потому что это рисование не является постоянным и будет стираться всякий раз, когда операционная система запрашивает перерисовку, всегда рисуйте в событии OnPaint!

Метод TCanvas для рисования прямоугольника вызывается именно так: Rectangle(). Он получает координаты краев прямоугольника либо отдельно, либо в виде записи TRect. Цвет заливки определяется цветом кисти Холста, а цвет границы задается цветом пера холста:

procedure TForm1.FormPaint(Sender: TObject);
var
  w, h: Integer;    // Ширина и высота прямоугольника
  cx, cy: Integer;  // центр формы
  R: TRect;         // запись, содержащая координаты левого, верхнего, правого, нижнего углов прямоугольника
begin
  // Высчитываем центр формы
  cx := Width div 2;
  cy := Height div 2;

  // Рассчитываем размер прямоугольника
  w := Width div 2;
  h := Height div 2;

  // Рассчитываем углы прямоугольника
  R.Left := cx - w div 2;
  R.Top := cy - h div 2;
  R.Right := cx + w div 2;
  R.Bottom := cy + h div 2;

  // Устанавливаем цвет заливки
  Canvas.Brush.Color := clRed;
  Canvas.Brush.Style := bsSolid;

  // Устанавливаем цвет границы
  Canvas.Pen.Color := clBlue;
  Canvas.Pen.Width := 5;
  Canvas.Pen.Style := psSolid;

  // Рисуем прямоугольник
  Canvas.Rectangle(R);
end;

Использование шрифта GUI по умолчанию

Это можно сделать с помощью этого простого кода:

SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));

Рисование ограниченного по ширине текста

Используйте процедуру DrawText, сначала с DT_CALCRECT, а затем без него.

// Сначала рассчитываем размер текста, затем рисуем его
TextBox := Rect(0, currentPos.Y, Width, High(Integer));
DrawText(ACanvas.Handle, PChar(Text), Length(Text), TextBox, DT_WORDBREAK or DT_INTERNAL or DT_CALCRECT);

DrawText(ACanvas.Handle, PChar(Text), Length(Text), TextBox, DT_WORDBREAK or DT_INTERNAL);

Рисование текста с резкими краями (без сглаживания)

Некоторые виджеты поддерживают это через

Canvas.Font.Quality := fqNonAntialiased;

Некоторые виджеты, такие как gtk2, не поддерживают это и всегда рисуют сглаживание. Вот простая процедура рисования текста с резкими краями под gtk2. Она не предусматривает все случаи, но должна дать представление:

procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
var
  w,h: integer;
  IntfImg: TLazIntfImage;
  Img: TBitmap;
  dy: Integer;
  dx: Integer;
  col: TFPColor;
  FontColor: TColor;
  c: TColor;
begin
  w:=0;
  h:=0;
  Canvas.GetTextSize(TheText,w,h);
  if (w<=0) or (h<=0) then exit;
  Img:=TBitmap.Create;
  IntfImg:=nil;
  try
    // рисуем текст в растровое изображение
    Img.Masked:=true;
    Img.SetSize(w,h);
    Img.Canvas.Brush.Style:=bsSolid;
    Img.Canvas.Brush.Color:=clWhite;
    Img.Canvas.FillRect(0,0,w,h);
    Img.Canvas.Font:=Canvas.Font;
    Img.Canvas.TextOut(0,0,TheText);
    // получаем изображение в памяти
    IntfImg:=Img.CreateIntfImage;
    // заменяем серые пиксели
    FontColor:=ColorToRGB(Canvas.Font.Color);
    for dy:=0 to h-1 do begin
      for dx:=0 to w-1 do begin
        col:=IntfImg.Colors[dx,dy];
        c:=FPColorToTColor(col);
        if c<>FontColor then
          IntfImg.Colors[dx,dy]:=colTransparent;
      end;
    end;
    // создаем растровое изображение
    Img.LoadFromIntfImage(IntfImg);
    // рисуем
    Canvas.Draw(x,y,Img);
  finally
    IntfImg.Free;
    Img.Free;
  end;
end;

Работа с TBitmap и другими потомками TGraphic

Объект TBitmap хранит растровое изображение, где вы можете рисовать, прежде чем показывать его на экране. Когда вы создаете растровое изображение, вы должны указать высоту и ширину, иначе это будет ноль, и ничто не будет нарисовано. И вообще, все остальные потомки TRasterImage предоставляют те же возможности. Следует использовать тот, который соответствует формату, необходимому для вывода/ввода с диска или TBitmap, в случае, если операции с дисками не будут выполняться, а также для формата Windows Bitmap (*.bmp).

Загрузка/Сохранение изображения из/на диск

Чтобы загрузить изображение с диска, используйте TGraphic.LoadFromFile и для сохранения его на другом диске, используйте TGraphic.SaveToFile. Используйте соответствующий потомок TGraphic, который соответствует ожидаемому формату. См. форматы изображений для [просмотра] списка доступных классов формата изображения.

var
  MyBitmap: TBitmap;
begin
  MyBitmap := TBitmap.Create;
  try
    // Загрузка с диска
    MyBitmap.LoadFromFile(MyEdit.Text);

    // Здесь вы можете использовать MyBitmap.Canvas для чтения/записи в/из изображения

    // Записываем обратно на другой диск
    MyBitmap.SaveToFile(MyEdit2.Text);
  finally
    MyBitmap.Free;
  end;
end;

При использовании любого другого формата процесс полностью идентичен, просто используйте соответствующий класс. Например, для изображений PNG:

var
  MyPNG: TPortableNetworkGraphic;
begin
  MyPNG := TPortableNetworkGraphic.Create;
  try
    // Загрузка с диска
    MyPNG.LoadFromFile(MyEdit.Text);

    // Здесь вы можете использовать MyPNG.Canvas для чтения/записи в/из изображения

    // Записываем обратно на другой диск
    MyPNG.SaveToFile(MyEdit2.Text);
  finally
    MyPNG.Free;
  end;
end;

Если вы заранее не знаете формат изображения, используйте TPicture, который определит формат на основе расширения файла. Обратите внимание, что TPicture не поддерживает все форматы, поддерживаемые Lazarus, с Lazarus 0.9.31 он поддерживает BMP, PNG, JPEG, Pixmap и PNM, в то время как Lazarus также поддерживает ICNS и другие форматы:

var
  MyPicture: TPicture;
begin
  MyPicture := TPicture.Create;
  try
    // Загрузка с диска
    MyPicture.LoadFromFile(MyEdit.Text);

    // Здесь вы можете использовать MyPicture.Graphic.Canvas для чтения/записи в/из изображения

    // Записываем обратно на другой диск
    MyPicture.SaveToFile(MyEdit2.Text);
  finally
    MyPicture.Free;
  end;
end;

Дополнительные форматы файлов для TImage

Вы можете добавить дополнительную поддержку форматов файлов, добавив модули fcl-image fpread* и/или fpwrite* в вашу секцию uses. Таким образом, вы можете, например, добавить поддержку TIFF для TImage

Прямой доступ к пикселям

Для непосредственного доступа к пикселям растровых изображений можно использовать внешние библиотеки, такие как BGRABitmap, LazRGBGraphics и Graphics32, или использовать нативный Lazarus'овский TLazIntfImage. Сравнение методов доступа к пикселям см. fast direct pixel access.

В некоторых наборах виджетов Lazarus (в частности, LCL-Gtk2) данные растрового изображения не сохраняются в памяти, к которой может обращаться приложение, и в общем случае собственные интерфейсы LCL рисуются только через собственные процедуры Canvas, поэтому каждая операция SetPixel / GetPixel включает медленный вызов родного Canvas API. В LCL-CustomDrawn это не так, поскольку растровое изображение локально сохраняется для всех бэкэндов, а SetPixel / GetPixel работает быстро. Для получения решения, которое работает во всех наборах виджетов, следует использовать TLazIntfImage. Поскольку Lazarus должен быть независимым от платформы и работать в gtk2, класс TBitmap не предоставляет такое свойство, как Scanline. Существует функция GetDataLineStart, эквивалентная Scanline, но доступная только для образов памяти, таких как TLazIntfImage, которая внутренне использует TRawImage.

Подводя итог, можно сказать, что со стандартным TBitmap вы можете только косвенно изменять пиксели, используя TCanvas.Pixels. Вызов собственного API для рисования / чтения отдельного пикселя, конечно, медленнее, чем прямой доступ к пикселям, особенно в LCL-gtk2 и LCL-Carbon.


Прим.перев.: Есть весьма неплохая статья (правда, на английском, чуть позже сделаю перевод и выложу на какой-нибудь ресурс), объясняющая суть работы свойства Scanline.


Рисование растровых изображений прозрачным цветом

Новая функция, реализованная в Lazarus 0.9.11, - это растровые изображения с прозрачными цветами. В растровых файлах (*.BMP) не может храниться информация о прозрачности, но они могут работать так же, как если бы вы выбрали цвет для представления прозрачной области. Это распространенный прием, используемый в приложениях Win32.

В следующем примере загружается растровое изображение из ресурса Windows, выбирается прозрачный цвет (clFuchsia) и затем он рисуется на холсте.

procedure MyForm.MyButtonOnClick(Sender: TObject);
var
  buffer: THandle;
  bmp: TBitmap;
  memstream: TMemoryStream;
begin
  bmp := TBitmap.Create;

  buffer := Windows.LoadBitmap(hInstance, MAKEINTRESOURCE(ResourceID));

  if (buffer = 0) then exit; // Ошибка загрузки растрового изображения

  bmp.Handle := buffer;
  memstream := TMemoryStream.create;
  try
    bmp.SaveToStream(memstream);
    memstream.position := 0;
    bmp.LoadFromStream(memstream);
  finally
    memstream.free;
  end;

  bmp.Transparent := True;
  bmp.TransparentColor := clFuchsia;

  MyCanvas.Draw(0, 0, bmp);

  bmp.Free; // Освобождаем выделенный ресурс
end;

Обратите внимание на операции с памятью, выполненные с помощью TMemoryStream. Они необходимы для обеспечения правильной загрузки изображения.

Получение скриншота экрана

Начиная с Lazarus 0.9.16, вы можете использовать LCL, чтобы делать скриншоты экрана кросс-платформенным способом. Следующий пример кода делает это (работает на gtk2 и win32, но не на gtk1 в настоящее время):

uses Graphics, LCLIntf, LCLType;
  ...
var
  MyBitmap: TBitmap;
  ScreenDC: HDC;
begin
  MyBitmap := TBitmap.Create;
  ScreenDC := GetDC(0);
  MyBitmap.LoadFromDevice(ScreenDC);
  ReleaseDC(0,ScreenDC);
  ...

Работа с TLazIntfImage, TRawImage и TLazCanvas

TLazIntfImage не является нативным эквивалентом TRasterImage (чаще используется в форме потомка TBitmap). Первое, что нужно знать об этом классе, это то, что в отличие от TBitmap, он не будет автоматически выделять область памяти для растрового изображения, сначала нужно инициализировать область памяти, а затем передать ее в TLazIntfImage. Сразу после создания TLazIntfImage нужно либо подключить его к TRawImage, либо загрузить из TBitmap.

TRawImage относится к типу объект и поэтому не нуждается ни в создании, ни в освобождении. Он может либо выделить память для самого изображения при вызове TRawImage.CreateData, либо передать блок памяти, выделенный, например, сторонней библиотекой, такой как Windows API Cocoa Framework из Mac OS X, и передать информацию об изображении в TRawImage.Description, TRawImage.Data и TRawImage.DataSize. Вместо того, чтобы прикреплять его к RawImage, можно также загрузить его из TBitmap, который будет копировать данные из TBitmap и впоследствии не будет синхронизироваться с ним. TLazCanvas не может существовать один и всегда должен быть присоединен к TLazIntfImage.

В приведенном ниже примере показано, как выбрать формат для данных и попросить TRawImage создать его для нас, а затем мы присоединим его к TLazIntfImage и потом присоединим к нему TLazCanvas:

uses graphtype, intfgraphics, lazcanvas;

var
  AImage: TLazIntfImage;
  ACanvas: TLazCanvas;
  lRawImage: TRawImage;
begin
    lRawImage.Init;
    lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight);
    lRawImage.CreateData(True);
    AImage := TLazIntfImage.Create(0,0);
    AImage.SetRawImage(lRawImage);
    ACanvas := TLazCanvas.Create(AImage);

Инициализация TLazIntfImage

Нельзя просто создать экземпляр TLazIntfImage и начать его использовать. Нужно добавить к нему хранилище. Есть 3 способа сделать это:

1. Прикрепить его к TRawImage

2. Загрузить его из TBitmap. Обратите внимание, что он скопирует память TBitmap, чтобы [экземпляр TLazIntfImage] не оставался подключенным к нему:

   SrcIntfImg:=TLazIntfImage.Create(0,0);
   SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);

3. Загрузить его из описания необработанного изображения, например так:

   IntfImg := TLazIntfImage.Create(0,0);
   IntfImg.DataDescription:=GetDescriptionFromDevice(0);
   IntfImg.SetSize(10,10);

Устройство 0 в GetDescriptionFromDevice(0) использует текущий формат экрана.

TLazIntfImage.LoadFromFile

Вот пример того, как загрузить изображение непосредственно в TLazIntfImage. Он инициализирует TLazIntfImage в 32-битном формате RGBA. Имейте в виду, что это, вероятно, не собственный формат вашего экрана.

uses LazLogger, Graphics, IntfGraphics, GraphType;
procedure TForm1.FormCreate(Sender: TObject);
var
  AImage: TLazIntfImage;
  lRawImage: TRawImage;
begin
  // создаем TLazIntfImage с 32 битами на пиксель, альфа 8 бит, красный 8 бит, зеленый 8 бит, синий 8 бит,
  // порядок битов: бит 0 - это пиксель 0, сверху вниз: строка 0 - это верх
  lRawImage.Init;
  lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
  lRawImage.CreateData(false);
  AImage := TLazIntfImage.Create(0,0);
  try
    AImage.SetRawImage(lRawImage);
    // Загружаем изображение с диска.
    // Используется расширение файла для правильного выбора изображения зарегистрированным ридером.
    // AImage будет масштабирован до  ширины и высоты загруженного изображения.
    AImage.LoadFromFile('lazarus/examples/openglcontrol/data/texture1.png');
    debugln(['TForm1.FormCreate ',AImage.Width,' ',AImage.Height]);
  finally
    AImage.Free;
  end;
end;

Загрузка TLazIntfImage в TImage

Пиксельные данные для TImage - это свойство TImage.Picture, которое имеет тип TPicture. TPicture - это мультиформатный контейнер, содержащий один из нескольких распространенных форматов изображений, таких как Bitmap, Icon, Jpeg или PNG. Обычно вы будете использовать TPicture.Bitmap для загрузки TLazIntfImage:

    Image1.Picture.Bitmap.LoadFromIntfImage(IntfImg);

Примечание:

  • Чтобы загрузить прозрачный TLazIntfImage, вы должны установить для Image1.Transparent значение true.
  • TImage использует формат экрана. Если TLazIntfImage имеет другой формат, то пиксели будут преобразованы.

Подсказка: вы можете использовать IntfImg.DataDescription:=GetDescriptionFromDevice(0); для инициализации TLazIntfImage с форматом экрана.

Пример обесцвечивания

Пример обесцвечивания с [использованием] TLazIntfImage

{ Этот код был взят из $LazarusPath/examples/lazintfimage/fadein1.lpi project. }
uses LCLType, // HBitmap type
     IntfGraphics, // TLazIntfImage type
     fpImage; // TFPColor type
...
 procedure TForm1.FadeIn(ABitMap: TBitMap);
 var
   SrcIntfImg, TempIntfImg: TLazIntfImage;
   ImgHandle,ImgMaskHandle: HBitmap;
   FadeStep: Integer;
   px, py: Integer;
   CurColor: TFPColor;
   TempBitmap: TBitmap;
 begin
   SrcIntfImg:=TLazIntfImage.Create(0,0);
   SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
   TempIntfImg:=TLazIntfImage.Create(0,0);
   TempIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
   TempBitmap:=TBitmap.Create;
   for FadeStep:=1 to 32 do begin
     for py:=0 to SrcIntfImg.Height-1 do begin
       for px:=0 to SrcIntfImg.Width-1 do begin
         CurColor:=SrcIntfImg.Colors[px,py];
         CurColor.Red:=(CurColor.Red*FadeStep) shr 5;
         CurColor.Green:=(CurColor.Green*FadeStep) shr 5;
         CurColor.Blue:=(CurColor.Blue*FadeStep) shr 5;
         TempIntfImg.Colors[px,py]:=CurColor;
       end;
     end;
     TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
     TempBitmap.Handle:=ImgHandle;
     TempBitmap.MaskHandle:=ImgMaskHandle;
     Canvas.Draw(0,0,TempBitmap);
   end;
   SrcIntfImg.Free;
   TempIntfImg.Free;
   TempBitmap.Free;
 end;

Пример конкретного формата изображения

Если вы знаете, что TBitmap использует синий 8-битный, зеленый 8-битный, красный 8-битный [каналы], вы можете напрямую получить доступ к байтам, что несколько быстрее:

uses LCLType, // HBitmap type
     IntfGraphics, // TLazIntfImage type
     fpImage; // TFPColor type
...
type
  TRGBTripleArray = array[0..32767] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;

procedure TForm1.FadeIn2(aBitMap: TBitMap);
 var
   IntfImg1, IntfImg2: TLazIntfImage;
   ImgHandle,ImgMaskHandle: HBitmap;
   FadeStep: Integer;
   px, py: Integer;
   CurColor: TFPColor;
   TempBitmap: TBitmap;
   Row1, Row2: PRGBTripleArray;
 begin
   IntfImg1:=TLazIntfImage.Create(0,0);
   IntfImg1.LoadFromBitmap(aBitmap.Handle,aBitmap.MaskHandle);

   IntfImg2:=TLazIntfImage.Create(0,0);
   IntfImg2.LoadFromBitmap(aBitmap.Handle,aBitmap.MaskHandle);

   TempBitmap:=TBitmap.Create;
   
   //со Scanline-подобным [свойством]
   for FadeStep:=1 to 32 do begin
     for py:=0 to IntfImg1.Height-1 do begin
       Row1 := IntfImg1.GetDataLineStart(py); //как Delphi TBitMap.ScanLine
       Row2 := IntfImg2.GetDataLineStart(py); //как Delphi TBitMap.ScanLine
       for px:=0 to IntfImg1.Width-1 do begin
         Row2^[px].rgbtRed:= (FadeStep * Row1^[px].rgbtRed) shr 5;
         Row2^[px].rgbtGreen := (FadeStep * Row1^[px].rgbtGreen) shr 5; // Исчезновение
         Row2^[px].rgbtBlue := (FadeStep * Row1^[px].rgbtBlue) shr 5;
       end;
     end;
     IntfImg2.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
     
     TempBitmap.Handle:=ImgHandle;
     TempBitmap.MaskHandle:=ImgMaskHandle;
     Canvas.Draw(0,0,TempBitmap);
   end; 

   IntfImg1.Free;
   IntfImg2.Free;
   TempBitmap.Free;
 end;

Преобразование между TLazIntfImage и TBitmap

Поскольку Lazarus не имеет свойства TBitmap.ScanLines, лучший способ быстрого доступа к пикселям изображения для чтения и записи - использование TLazIntfImage. TBitmap можно преобразовать в TLazIntfImage с помощью TBitmap.CreateIntfImage (), а после изменения пикселей он может быть преобразован обратно в TBitmap с помощью TBitmap.LoadFromIntfImage (); Вот пример того, как создать TLazIntfImage из TBitmap, изменить его и затем вернуться к TBitmap.

uses
  ...GraphType, IntfGraphics, LCLType, LCLProc,  LCLIntf ...

procedure TForm1.Button4Click(Sender: TObject);
var
  b: TBitmap;
  t: TLazIntfImage;
begin
  b := TBitmap.Create;
  try
    b.LoadFromFile('test.bmp');
    t := b.CreateIntfImage;

    // Читаем и/или записываем в пиксели
    t.Colors[10,20] := colGreen;

    b.LoadFromIntfImage(t);
  finally
    t.Free;
    b.Free;
  end;
end;

Использование не-нативного StretchDraw из LazCanvas

Как и в случае с TCanvas.StretchDraw, существует TLazCanvas.StretchDraw, но вам нужно указать интерполяцию, которую вы хотите использовать. Интерполяция, которая обеспечивает Windows-подобный StretchDraw с очень резким результатом (противоположным сглаживанию), может быть добавлена с помощью: TLazCanvas.Interpolation: = TFPSharpInterpolation.Create;

В модуле fpcanvas доступны другие [способы] интерполяции.

uses intfgraphics, lazcanvas;

procedure TForm1.StretchDrawBitmapToBitmap(SourceBitmap, DestBitmap: TBitmap; DestWidth, DestHeight: integer);
var
  DestIntfImage, SourceIntfImage: TLazIntfImage;
  DestCanvas: TLazCanvas;
begin
  // Подготовка получателя

  DestIntfImage := TLazIntfImage.Create(0, 0);
  DestIntfImage.LoadFromBitmap(DestBitmap.Handle, 0);

  DestCanvas := TLazCanvas.Create(DestIntfImage);

  //Подготовка источника
  SourceIntfImage := TLazIntfImage.Create(0, 0);
  SourceIntfImage.LoadFromBitmap(SourceBitmap.Handle, 0);

  // Выполнение процесса растяжения [рисунка] с помощью TFPSharpInterpolation
  DestCanvas.Interpolation := TFPSharpInterpolation.Create;
  DestCanvas.StretchDraw(0, 0, DestWidth, DestHeight, SourceIntfImage);

  // Перезагрузка изображения в TBitmap
  DestBitmap.LoadFromIntfImage(DestIntfImage);

  SourceIntfImage.Free;
  DestCanvas.Interpolation.Free;  
  DestCanvas.Free;
  DestIntfImage.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  Bmp, DestBitmap: TBitmap;
begin
  // Подготовка получателя
  DestBitmap := TBitmap.Create;
  DestBitmap.Width := 100;
  DestBitmap.Height := 100;

  Bmp := TBitmap.Create;
  Bmp.Width := 10;
  Bmp.Height := 10;
  Bmp.Canvas.Pen.Color := clYellow;
  Bmp.Canvas.Brush.Color := clYellow;
  Bmp.Canvas.Rectangle(0, 0, 10, 10);
  StretchDrawBitmapToBitmap(Bmp, DestBitmap, 100, 100);
  Canvas.Draw(0, 0, Bmp);
  Canvas.Draw(100, 100, DestBitmap);
end;

Графика движения - как избежать мерцания

Многие программы выводят свои данные в графический интерфейс в виде 2D-графики. Если эту графику нужно быстро менять, вы скоро столкнетесь с проблемой: быстро меняющаяся графика часто мерцает на экране. Это происходит, когда пользователи иногда видят целые изображения, а иногда только когда они частично прорисованы. Это происходит потому, что процесс отрисовки требует времени.

Но как я могу избежать мерцания и получить лучшую скорость рисования? Конечно, вы можете работать с аппаратным ускорением, используя OpenGL, но этот подход довольно тяжел для небольших программ или старых компьютеров. Этот урок будет сосредоточен на рисовании в TCanvas. Если вам нужна помощь с OpenGL, взгляните на пример, который поставляется с Lazarus. Вы также можете использовать игровой пакет A.J. Venter'а, который предоставляет холст с двойной буферизацией и спрайт-компонент.

Краткую и очень полезную статью по предотвращению мерцания можно найти здесь. Хотя эти методы написаны для Delphi, они хорошо работают [и] с Lazarus.

Теперь мы рассмотрим варианты рисования на холсте:

Рисование на TImage

TImage состоит из 2 частей: TGraphic, обычно TBitmap, в котором хранится постоянное изображение и визуальная область, которые перекрашиваются на каждом OnPaint. Изменение размера TImage не изменяет размер растрового изображения. Графическое изображение (или растровое изображение) доступно через Image1.Picture.Graphic (или Image1.Picture.Bitmap). Холст - это Image1.Picture.Bitmap.Canvas. Холст визуальной области TImage доступен только во время [наступления события] Image1.OnPaint через Image1.Canvas.

Важно: Никогда не используйте событие OnPaint [компонента] Image1 для рисования в графическом/растровом изображении TImage. Графическое изображение TImage буферизуется, поэтому все, что вам нужно сделать, это нарисовать его из любого места, и изменения будут там навсегда. Однако, если вы постоянно перерисовываете, изображение будет мерцать. В этом случае вы можете попробовать другие варианты. Рисование в TImage считается медленнее, чем другие подходы.

Изменение размера растрового изображения TImage

Light bulb  Примечание: Не используйте это в событии OnPaint.
with Image1.Picture.Bitmap do begin
  Width:=100;
  Height:=120;
end;

То же самое в один присест:

with Image1.Picture.Bitmap do begin
  SetSize(100, 120);
end;

Рисование на растровом изображении TImage

Light bulb  Примечание: Не используйте это в событии OnPaint.
with Image1.Picture.Bitmap.Canvas do begin
  // заполняем все растровое изображение красным
  Brush.Color := clRed;
  FillRect(0, 0, Width, Height);
end;
Light bulb  Примечание: Внутри Image1.OnPaint'а Image1.Canvas указывает на изменчивую видимую область. За пределами Image1.OnPaint'а объект Image1.Canvas указывает на Image1.Picture.Bitmap.Canvas.

Другой пример:

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  x, y: Integer;
begin
  // Рисуем фон
  MyImage.Canvas.Pen.Color := clWhite;
  MyImage.Canvas.Rectangle(0, 0, Image.Width, Image.Height);
   
  // Рисуем квадраты
  MyImage.Canvas.Pen.Color := clBlack;
  for x := 1 to 8 do
    for y := 1 to 8 do
      MyImage.Canvas.Rectangle(Round((x - 1) * Image.Width / 8), Round((y - 1) * Image.Height / 8),
        Round(x * Image.Width / 8), Round(y * Image.Height / 8));
end;

Рисование на изменчивой визуальной области TImage

Вы можете рисовать только в этой области в событии OnPaint. [Событие] OnPaint в конечном итоге автоматически вызывается [библиотекой] LCL, когда область перерисовывается. Вы можете перерисовать область вручную с помощью Image1.Invalidate. Это вызовет OnPaint не сразу, и вы можете вызывать Invalidate столько раз, сколько захотите.

procedure TForm.Image1Paint(Sender: TObject);
begin
  // рисуем линию
  Canvas.Pen.Color := clRed;
  Canvas.Line(0, 0, Width, Height);
end;

Рисование в событии OnPaint

В этом случае все рисование должно выполняться по событию OnPaint формы или другого элемента управления. Рисунок не буферизуется, как в TImage, и его необходимо полностью перерисовывать при каждом вызове обработчика события OnPaint.

procedure TForm.Form1Paint(Sender: TObject);
begin
  // рисуем линию
  Canvas.Pen.Color := clRed;
  Canvas.Line(0, 0, Width, Height);
end;

Создание пользовательского элемента управления с самостоятельной отрисовкой

Создание пользовательского элемента управления имеет преимущество структурирования вашего кода, и вы можете использовать его повторно. Этот подход очень быстрый, но он все равно может вызывать мерцание, если вы сначала не рисуете на TBitmap'е, а лишь затем [начнете] рисовать на холсте. В этом случае нет необходимости использовать событие OnPaint элемента управления.

Вот пример пользовательского элемента управления:

uses
  Classes, SysUtils, Controls, Graphics, LCLType;
 
type
  TMyDrawingControl = class(TCustomControl)
  public
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  end;
 
implementation
 
procedure TMyDrawingControl.EraseBackground(DC: HDC);
begin
  // Раскомментируйте это, чтобы включить удаление фона по умолчанию
  //inherited EraseBackground(DC);
end; 
 
procedure TMyDrawingControl.Paint;
var
  x, y: Integer;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    // Инициализируем размер растрового изображения
    Bitmap.Height := Height;
    Bitmap.Width := Width;
 
    // Рисуем фон
    Bitmap.Canvas.Pen.Color := clWhite;
    Bitmap.Canvas.Rectangle(0, 0, Width, Height);
 
    // Рисует квадраты
    Bitmap.Canvas.Pen.Color := clBlack;
    for x := 1 to 8 do
      for y := 1 to 8 do
        Bitmap.Canvas.Rectangle(Round((x - 1) * Width / 8), Round((y - 1) * Height / 8),
          Round(x * Width / 8), Round(y * Height / 8));
       
    Canvas.Draw(0, 0, Bitmap);
  finally
    Bitmap.Free;
  end;
 
  inherited Paint;
end;

и как мы создаем это на форме:

procedure TMyForm.FormCreate(Sender: TObject);
begin
  MyDrawingControl := TMyDrawingControl.Create(Self);
  MyDrawingControl.Height := 400;
  MyDrawingControl.Width := 500;
  MyDrawingControl.Top := 0;
  MyDrawingControl.Left := 0;
  MyDrawingControl.Parent := Self;
  MyDrawingControl.DoubleBuffered := True;
end;

Он уничтожается автоматически, потому что мы используем Self в качестве владельца.

Установка Top и Left на ноль не обязательна, так как это стандартная позиция, но это делается для того, чтобы усилить то место, где будет помещен элемент управления.

"MyDrawingControl.Parent := Self;" - очень важная [строка кода], и вы не увидите свой элемент управления, если вы этого не сделаете.

"MyDrawingControl.DoubleBuffered := True;" требуется, чтобы избежать мерцания в Windows. Это не [оказывает никакого] влияения на GTK.

Форматы изображений

Вот таблица с правильным классом для каждого формата изображения.

Format Image class Unit
Cursor (cur) TCursor Graphics
Bitmap (bmp) TBitmap Graphics
Windows icon (ico) TIcon Graphics
Mac OS X icon (icns) TicnsIcon Graphics
Pixmap (xpm) TPixmap Graphics
Portable Network Graphic (png) TPortableNetworkGraphic Graphics
JPEG (jpg, jpeg) TJpegImage Graphics
PNM (pnm) TPortableAnyMapGraphic Graphics
Tiff (tif) TTiffImage Graphics

См. также список fcl-image supported formats.

Преобразование форматов

Иногда необходимо преобразовать один графический тип в другой. Одним из способов является преобразование графического объекта в промежуточный формат, а затем преобразование его в TBitmap. Большинство форматов могут создавать изображения из TBitmap.

Преобразование растрового изображения в PNG и сохранение его в файл:

procedure SaveToPng(const bmp: TBitmap; PngFileName: String);
var
  png : TPortableNetworkGraphic; 
begin 
  png := TPortableNetworkGraphic.Create;
  try
    png.Assign(bmp);
    png.SaveToFile(PngFileName);
  finally 
    png.Free;
  end;
end;

Пиксельные форматы

TColor

The internal pixel format for TColor in the LCL is the XXBBGGRR format, which matches the native Windows format and is opposite to most other libraries, which use AARRGGBB. The XX part is used to identify if the color is a fixed color, which case XX should be 00 or if it is an index to a system color. There is no space reserved for an alpha channel.

To convert from separate RGB channels to TColor use:

RGBToColor(RedVal, GreenVal, BlueVal);

To get each channel of a TColor variable use the Red, Green and Blue functions:

RedVal := Red(MyColor);
GreenVal := Green(MyColor);
BlueVal := Blue(MyColor);

TFPColor

TFPColor uses the AARRGGBB format common to most libraries, but it uses 16-bits for the depth of each color channel, totaling 64-bits per pixel, which is unusual. This does not necessarily mean that images will consume that much memory, however. Images created using TRawImage+TLazIntfImage can have any internal storage format and then on drawing operations TFPColor is converted to this internal format.

The unit Graphics provides routines to convert between TColor and TFPColor:

function FPColorToTColorRef(const FPColor: TFPColor): TColorRef;
function FPColorToTColor(const FPColor: TFPColor): TColor;
function TColorToFPColor(const c: TColorRef): TFPColor; overload;
function TColorToFPColor(const c: TColor): TFPColor; overload; // does not work on system color

Drawing with fcl-image

You can draw images which won't be displayed in the screen without the LCL, by just using fcl-image directly. For example a program running on a webserver without X11 could benefit from not having a visual library as a dependency. FPImage (alias fcl-image) is a very generic image and drawing library written completely in pascal. In fact the LCL uses FPImage too for all the loading and saving from/to files and implements the drawing function through calls to the widgetset (winapi, gtk, carbon, ...). Fcl-image on the other hand also has drawing routines.

For more information, please read the article about fcl-image.

Common OnPaint Error

A common error that causes many false bug reports is to call an Onpaint event for one object from another object. When using the LCL, this may work in GTK2 and Windows but will probably fail with Qt, Carbon and Cocoa. It is not normally necessary to call Invalidate. However, it may sometimes be needed in the Button1Click procedure,

This is bad:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Shape1Paint(Self); // Call Shape1Onpaint event
  Shape1.Invalidate; // Invoke actual painting

  ... more code for Button1 ...  
end;

This is good:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ... code for Button1 ... 
  Set some condition; 
  // Shape1.Invalidate; // May be necessary on some occasions
end;

// Shape1Paint should be attached to the OnPaint event of shape object !
procedure TForm1.Shape1Paint(Sender: TObject);
var
  Myrect: TRect;
begin   
  if some condition then 
    with Shape1.Canvas do
    begin
      ... lots of stuff ...
    end;
end;

Some useful examples

Example 1: Drawing on loaded JPEG with TImage

Add procedure LoadAndDraw to the public section of your form, and paste next code to implemantation section:

procedure TForm1.LoadAndDraw(const sFileName: String);
var 
  jpg: TPicture;
begin
  jpg := TPicture.Create;
  try
    jpg.LoadFromFile(sFileName);
 
    Image.Picture.Bitmap.SetSize(jpg.Width, jpg.Height);
    Image.Picture.Bitmap.Canvas.Draw(0, 0, jpg.Bitmap);
 
    Image.Picture.Bitmap.Canvas.Pen.Color := clRed;
    Image.Picture.Bitmap.Canvas.Line(0, 0, 140, 140);
  finally
    jpg.Free;
  end;
end;

Example 2: Drawing on controls of Form

1) Create a New project - Application, add to uses section next modules if needed: Types, Controls, Graphics.

2) Place on form Button1, GroupBox1 and RadioGroup1

3) Place on GroupBox1 one more button - Button2

4) Your TForm1.Create should looks like:

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Self.ControlCount - 1 do
    RadioGroup1.Items.AddObject(Controls[i].Name, Controls[i]);

  RadioGroup1.Items.AddObject(Button2.Name,Button2);
end;

5) For RadioGroup1 create handler of OnSelectionChanged event:

procedure TForm1.RadioGroup1SelectionChanged(Sender: TObject);
begin
  Self.Repaint;
end;

6) Add to public section of your form procedure HighlightControl:

procedure TForm1.HighlightControl(AControl: TControl);
var
  R: Types.TRect;
  aCC: TControlCanvas;
begin
  R := AControl.BoundsRect;
  InflateRect(R, 2, 2);          // make rect a bit bigger then control
  aCC := TControlCanvas.Create;
  aCC.Control := AControl.Parent;
  aCC.Pen.Color := clGreen;
  aCC.Pen.Width := 5;
  aCC.Pen.Style := psSolid;
  aCC.Brush.Style := bsClear;
  aCC.Rectangle(R);
  aCC.free;
end;

See also