Difference between revisions of "Developing with Graphics/ru"

From Free Pascal wiki
Jump to navigationJump to search
m (Fixed syntax highlighting)
 
(6 intermediate revisions by one other user not shown)
Line 53: Line 53:
  
 
Метод TCanvas для рисования прямоугольника вызывается именно так: <tt>Rectangle()</tt>. Он получает координаты краев прямоугольника либо отдельно, либо в виде записи <tt>TRect</tt>. Цвет заливки определяется цветом кисти Холста, а цвет границы задается цветом пера холста:
 
Метод TCanvas для рисования прямоугольника вызывается именно так: <tt>Rectangle()</tt>. Он получает координаты краев прямоугольника либо отдельно, либо в виде записи <tt>TRect</tt>. Цвет заливки определяется цветом кисти Холста, а цвет границы задается цветом пера холста:
<syntaxhighlight>procedure TForm1.FormPaint(Sender: TObject);
+
 
 +
<syntaxhighlight lang=pascal>
 +
procedure TForm1.FormPaint(Sender: TObject);
 
var
 
var
 
   w, h: Integer;    // Ширина и высота прямоугольника
 
   w, h: Integer;    // Ширина и высота прямоугольника
Line 91: Line 93:
 
Это можно сделать с помощью этого простого кода:
 
Это можно сделать с помощью этого простого кода:
  
<syntaxhighlight>SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));</syntaxhighlight>
+
<syntaxhighlight lang=pascal>SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));</syntaxhighlight>
  
 
===Рисование ограниченного по ширине текста===
 
===Рисование ограниченного по ширине текста===
Line 97: Line 99:
 
Используйте процедуру DrawText, сначала с DT_CALCRECT, а затем без него.
 
Используйте процедуру DrawText, сначала с DT_CALCRECT, а затем без него.
  
<syntaxhighlight>// Сначала рассчитываем размер текста, затем рисуем его
+
<syntaxhighlight lang=pascal>
 +
// Сначала рассчитываем размер текста, затем рисуем его
 
TextBox := Rect(0, currentPos.Y, Width, High(Integer));
 
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 or DT_CALCRECT);
Line 107: Line 110:
 
Некоторые виджеты поддерживают это через
 
Некоторые виджеты поддерживают это через
  
<syntaxhighlight>Canvas.Font.Quality := fqNonAntialiased;</syntaxhighlight>
+
<syntaxhighlight lang=pascal>Canvas.Font.Quality := fqNonAntialiased;</syntaxhighlight>
  
 
Некоторые виджеты, такие как gtk2, не поддерживают это и всегда рисуют сглаживание. Вот простая процедура рисования текста с резкими краями под gtk2. Она не предусматривает все случаи, но должна дать представление:
 
Некоторые виджеты, такие как gtk2, не поддерживают это и всегда рисуют сглаживание. Вот простая процедура рисования текста с резкими краями под gtk2. Она не предусматривает все случаи, но должна дать представление:
  
<syntaxhighlight>procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
+
<syntaxhighlight lang=pascal>
 +
procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
 
var
 
var
 
   w,h: integer;
 
   w,h: integer;
Line 165: Line 169:
 
===Загрузка/Сохранение изображения из/на диск===
 
===Загрузка/Сохранение изображения из/на диск===
 
Чтобы загрузить изображение с диска, используйте [http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/tgraphic.loadfromfile.html TGraphic.LoadFromFile] и для сохранения его на другом диске, используйте [http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/tgraphic.savetofile.html TGraphic.SaveToFile]. Используйте соответствующий потомок TGraphic, который соответствует ожидаемому формату. См. [[Developing_with_Graphics/ru#Форматы изображений|форматы изображений]] для [просмотра] списка доступных классов формата изображения.
 
Чтобы загрузить изображение с диска, используйте [http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/tgraphic.loadfromfile.html TGraphic.LoadFromFile] и для сохранения его на другом диске, используйте [http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/tgraphic.savetofile.html TGraphic.SaveToFile]. Используйте соответствующий потомок TGraphic, который соответствует ожидаемому формату. См. [[Developing_with_Graphics/ru#Форматы изображений|форматы изображений]] для [просмотра] списка доступных классов формата изображения.
<syntaxhighlight>
+
 
 +
<syntaxhighlight lang=pascal>
 
var
 
var
 
   MyBitmap: TBitmap;
 
   MyBitmap: TBitmap;
Line 185: Line 190:
 
При использовании любого другого формата процесс полностью идентичен, просто используйте соответствующий класс. Например, для изображений PNG:
 
При использовании любого другого формата процесс полностью идентичен, просто используйте соответствующий класс. Например, для изображений PNG:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
var
 
var
 
   MyPNG: TPortableNetworkGraphic;
 
   MyPNG: TPortableNetworkGraphic;
Line 205: Line 210:
 
Если вы заранее не знаете формат изображения, используйте TPicture, который определит формат на основе расширения файла. Обратите внимание, что TPicture не поддерживает все форматы, поддерживаемые Lazarus, с Lazarus 0.9.31 он поддерживает BMP, PNG, JPEG, Pixmap и PNM, в то время как Lazarus также поддерживает ICNS и другие форматы:
 
Если вы заранее не знаете формат изображения, используйте TPicture, который определит формат на основе расширения файла. Обратите внимание, что TPicture не поддерживает все форматы, поддерживаемые Lazarus, с Lazarus 0.9.31 он поддерживает BMP, PNG, JPEG, Pixmap и PNM, в то время как Lazarus также поддерживает ICNS и другие форматы:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
var
 
var
 
   MyPicture: TPicture;
 
   MyPicture: TPicture;
Line 243: Line 248:
 
В следующем примере загружается растровое изображение из ресурса Windows, выбирается прозрачный цвет (clFuchsia) и затем он рисуется на холсте.
 
В следующем примере загружается растровое изображение из ресурса Windows, выбирается прозрачный цвет (clFuchsia) и затем он рисуется на холсте.
  
<syntaxhighlight>procedure MyForm.MyButtonOnClick(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure MyForm.MyButtonOnClick(Sender: TObject);
 
var
 
var
 
   buffer: THandle;
 
   buffer: THandle;
Line 279: Line 285:
 
Начиная с Lazarus 0.9.16, вы можете использовать LCL, чтобы делать скриншоты экрана кросс-платформенным способом. Следующий пример кода делает это (работает на gtk2 и win32, но не на gtk1 в настоящее время):
 
Начиная с Lazarus 0.9.16, вы можете использовать LCL, чтобы делать скриншоты экрана кросс-платформенным способом. Следующий пример кода делает это (работает на gtk2 и win32, но не на gtk1 в настоящее время):
  
<syntaxhighlight>uses Graphics, LCLIntf, LCLType;
+
<syntaxhighlight lang=pascal>
 +
uses Graphics, LCLIntf, LCLType;
 
   ...
 
   ...
 
var
 
var
Line 299: Line 306:
 
В приведенном ниже примере показано, как выбрать формат для данных и попросить TRawImage создать его для нас, а затем мы присоединим его к TLazIntfImage и потом присоединим к нему TLazCanvas:
 
В приведенном ниже примере показано, как выбрать формат для данных и попросить TRawImage создать его для нас, а затем мы присоединим его к TLazIntfImage и потом присоединим к нему TLazCanvas:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
uses graphtype, intfgraphics, lazcanvas;
 
uses graphtype, intfgraphics, lazcanvas;
  
Line 323: Line 330:
 
2. Загрузить его из TBitmap. Обратите внимание, что он скопирует память TBitmap, чтобы [экземпляр TLazIntfImage] не оставался подключенным к нему:
 
2. Загрузить его из TBitmap. Обратите внимание, что он скопирует память TBitmap, чтобы [экземпляр TLazIntfImage] не оставался подключенным к нему:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
   SrcIntfImg:=TLazIntfImage.Create(0,0);
 
   SrcIntfImg:=TLazIntfImage.Create(0,0);
 
   SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
 
   SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
Line 330: Line 337:
 
3. Загрузить его из описания необработанного изображения, например так:
 
3. Загрузить его из описания необработанного изображения, например так:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
   IntfImg := TLazIntfImage.Create(0,0);
 
   IntfImg := TLazIntfImage.Create(0,0);
 
   IntfImg.DataDescription:=GetDescriptionFromDevice(0);
 
   IntfImg.DataDescription:=GetDescriptionFromDevice(0);
Line 342: Line 349:
 
Вот пример того, как загрузить изображение непосредственно в TLazIntfImage. Он инициализирует TLazIntfImage в 32-битном формате RGBA. Имейте в виду, что это, вероятно, не собственный формат вашего экрана.
 
Вот пример того, как загрузить изображение непосредственно в TLazIntfImage. Он инициализирует TLazIntfImage в 32-битном формате RGBA. Имейте в виду, что это, вероятно, не собственный формат вашего экрана.
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
uses LazLogger, Graphics, IntfGraphics, GraphType;
 
uses LazLogger, Graphics, IntfGraphics, GraphType;
 
procedure TForm1.FormCreate(Sender: TObject);
 
procedure TForm1.FormCreate(Sender: TObject);
Line 372: Line 379:
 
Пиксельные данные для '''TImage''' - это свойство '''TImage.Picture''', которое имеет тип ''TPicture''. '''TPicture''' - это мультиформатный контейнер, содержащий один из нескольких распространенных форматов изображений, таких как Bitmap, Icon, Jpeg или PNG. Обычно вы будете использовать ''TPicture.Bitmap'' для загрузки '''TLazIntfImage''':
 
Пиксельные данные для '''TImage''' - это свойство '''TImage.Picture''', которое имеет тип ''TPicture''. '''TPicture''' - это мультиформатный контейнер, содержащий один из нескольких распространенных форматов изображений, таких как Bitmap, Icon, Jpeg или PNG. Обычно вы будете использовать ''TPicture.Bitmap'' для загрузки '''TLazIntfImage''':
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
     Image1.Picture.Bitmap.LoadFromIntfImage(IntfImg);
 
     Image1.Picture.Bitmap.LoadFromIntfImage(IntfImg);
 
</syntaxhighlight>
 
</syntaxhighlight>
Line 386: Line 393:
 
Пример обесцвечивания с [использованием] TLazIntfImage
 
Пример обесцвечивания с [использованием] TLazIntfImage
  
<syntaxhighlight>{ Этот код был взят из $LazarusPath/examples/lazintfimage/fadein1.lpi project. }
+
<syntaxhighlight lang=pascal>
 +
{ Этот код был взят из $LazarusPath/examples/lazintfimage/fadein1.lpi project. }
 
uses LCLType, // HBitmap type
 
uses LCLType, // HBitmap type
 
     IntfGraphics, // TLazIntfImage type
 
     IntfGraphics, // TLazIntfImage type
Line 429: Line 437:
 
Если вы знаете, что TBitmap использует синий 8-битный, зеленый 8-битный, красный 8-битный [каналы], вы можете напрямую получить доступ к байтам, что несколько быстрее:
 
Если вы знаете, что TBitmap использует синий 8-битный, зеленый 8-битный, красный 8-битный [каналы], вы можете напрямую получить доступ к байтам, что несколько быстрее:
  
<syntaxhighlight>uses LCLType, // HBitmap type
+
<syntaxhighlight lang=pascal>
 +
uses LCLType, // HBitmap type
 
     IntfGraphics, // TLazIntfImage type
 
     IntfGraphics, // TLazIntfImage type
 
     fpImage; // TFPColor type
 
     fpImage; // TFPColor type
Line 483: Line 492:
 
Вот пример того, как создать TLazIntfImage из TBitmap, изменить его и затем вернуться к TBitmap.
 
Вот пример того, как создать TLazIntfImage из TBitmap, изменить его и затем вернуться к TBitmap.
  
<syntaxhighlight>uses
+
<syntaxhighlight lang=pascal>
 +
uses
 
   ...GraphType, IntfGraphics, LCLType, LCLProc,  LCLIntf ...
 
   ...GraphType, IntfGraphics, LCLType, LCLProc,  LCLIntf ...
  
Line 512: Line 522:
 
В модуле fpcanvas доступны другие [способы] интерполяции.
 
В модуле fpcanvas доступны другие [способы] интерполяции.
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
uses intfgraphics, lazcanvas;
 
uses intfgraphics, lazcanvas;
  
Line 590: Line 600:
 
{{Note| Не используйте это в событии OnPaint.}}
 
{{Note| Не используйте это в событии OnPaint.}}
  
<syntaxhighlight>with Image1.Picture.Bitmap do begin
+
<syntaxhighlight lang=pascal>
 +
with Image1.Picture.Bitmap do begin
 
   Width:=100;
 
   Width:=100;
 
   Height:=120;
 
   Height:=120;
Line 597: Line 608:
 
То же самое в один присест:
 
То же самое в один присест:
  
<syntaxhighlight>with Image1.Picture.Bitmap do begin
+
<syntaxhighlight lang=pascal>
 +
with Image1.Picture.Bitmap do begin
 
   SetSize(100, 120);
 
   SetSize(100, 120);
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
Line 605: Line 617:
 
{{Note| Не используйте это в событии OnPaint.}}
 
{{Note| Не используйте это в событии OnPaint.}}
  
<syntaxhighlight>with Image1.Picture.Bitmap.Canvas do begin
+
<syntaxhighlight lang=pascal>
 +
with Image1.Picture.Bitmap.Canvas do begin
 
   // заполняем все растровое изображение красным
 
   // заполняем все растровое изображение красным
 
   Brush.Color := clRed;
 
   Brush.Color := clRed;
Line 615: Line 628:
 
Другой пример:
 
Другой пример:
  
<syntaxhighlight>procedure TForm1.BitBtn1Click(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TForm1.BitBtn1Click(Sender: TObject);
 
var
 
var
 
   x, y: Integer;
 
   x, y: Integer;
Line 635: Line 649:
 
Вы можете рисовать только в этой области в событии OnPaint. [Событие] OnPaint в конечном итоге автоматически вызывается [библиотекой] LCL, когда область перерисовывается. Вы можете перерисовать область вручную с помощью Image1.Invalidate. Это вызовет OnPaint не сразу, и вы можете вызывать Invalidate столько раз, сколько захотите.
 
Вы можете рисовать только в этой области в событии OnPaint. [Событие] OnPaint в конечном итоге автоматически вызывается [библиотекой] LCL, когда область перерисовывается. Вы можете перерисовать область вручную с помощью Image1.Invalidate. Это вызовет OnPaint не сразу, и вы можете вызывать Invalidate столько раз, сколько захотите.
  
<syntaxhighlight>procedure TForm.Image1Paint(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TForm.Image1Paint(Sender: TObject);
 
begin
 
begin
 
   // рисуем линию
 
   // рисуем линию
Line 646: Line 661:
 
В этом случае все рисование должно выполняться по событию OnPaint формы или другого элемента управления. Рисунок не буферизуется, как в TImage, и его необходимо полностью перерисовывать при каждом вызове обработчика события OnPaint.
 
В этом случае все рисование должно выполняться по событию OnPaint формы или другого элемента управления. Рисунок не буферизуется, как в TImage, и его необходимо полностью перерисовывать при каждом вызове обработчика события OnPaint.
  
<syntaxhighlight>procedure TForm.Form1Paint(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TForm.Form1Paint(Sender: TObject);
 
begin
 
begin
 
   // рисуем линию
 
   // рисуем линию
Line 658: Line 674:
 
Вот пример пользовательского элемента управления:
 
Вот пример пользовательского элемента управления:
  
<syntaxhighlight>uses
+
<syntaxhighlight lang=pascal>
 +
uses
 
   Classes, SysUtils, Controls, Graphics, LCLType;
 
   Classes, SysUtils, Controls, Graphics, LCLType;
 
   
 
   
Line 708: Line 725:
 
и как мы создаем это на форме:
 
и как мы создаем это на форме:
  
<syntaxhighlight>procedure TMyForm.FormCreate(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TMyForm.FormCreate(Sender: TObject);
 
begin
 
begin
 
   MyDrawingControl := TMyDrawingControl.Create(Self);
 
   MyDrawingControl := TMyDrawingControl.Create(Self);
Line 763: Line 781:
 
Преобразование растрового изображения в PNG и сохранение его в файл:
 
Преобразование растрового изображения в PNG и сохранение его в файл:
  
<syntaxhighlight>procedure SaveToPng(const bmp: TBitmap; PngFileName: String);
+
<syntaxhighlight lang=pascal>
 +
procedure SaveToPng(const bmp: TBitmap; PngFileName: String);
 
var
 
var
 
   png : TPortableNetworkGraphic;  
 
   png : TPortableNetworkGraphic;  
Line 784: Line 803:
 
Для преобразования из отдельных каналов RGB в TColor используйте:
 
Для преобразования из отдельных каналов RGB в TColor используйте:
  
<syntaxhighlight>RGBToColor(RedVal, GreenVal, BlueVal);</syntaxhighlight>
+
<syntaxhighlight lang=pascal>RGBToColor(RedVal, GreenVal, BlueVal);</syntaxhighlight>
  
 
Чтобы получить каждый канал переменной TColor, используйте функции Red, Green и Blue:
 
Чтобы получить каждый канал переменной TColor, используйте функции Red, Green и Blue:
  
<syntaxhighlight>RedVal := Red(MyColor);
+
<syntaxhighlight lang=pascal>
 +
RedVal := Red(MyColor);
 
GreenVal := Green(MyColor);
 
GreenVal := Green(MyColor);
 
BlueVal := Blue(MyColor);</syntaxhighlight>
 
BlueVal := Blue(MyColor);</syntaxhighlight>
Line 798: Line 818:
 
Модуль Graphics предоставляет процедуры для преобразования между TColor и TFPColor:
 
Модуль Graphics предоставляет процедуры для преобразования между TColor и TFPColor:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
function FPColorToTColorRef(const FPColor: TFPColor): TColorRef;
 
function FPColorToTColorRef(const FPColor: TFPColor): TColorRef;
 
function FPColorToTColor(const FPColor: TFPColor): TColor;
 
function FPColorToTColor(const FPColor: TFPColor): TColor;
Line 813: Line 833:
 
==Распространенная ошибка [при использовании] OnPaint==
 
==Распространенная ошибка [при использовании] OnPaint==
  
Распространенной ошибкой, которая вызывает много ложных сообщений об багах, является вызов события Onpaint для одного объекта из другого объекта. При использовании LCL это может работать в GTK2 и Windows, но, вероятно, не удастся с Qt, Carbon и Cocoa. Обычно не нужно называть Invalidate. Тем не менее, иногда это может быть необходимо в процедуре Button1Click,
+
Распространенной ошибкой, которая вызывает много ложных сообщений об багах, является вызов события Onpaint для одного объекта из другого объекта. При использовании LCL это может работать в GTK2 и Windows, но, вероятно, не удастся с Qt, Carbon и Cocoa. Обычно не нужно вызывать <tt>Invalidate</tt>. Тем не менее, иногда это может быть необходимо в процедуре Button1Click,
  
 
вот так - плохо:
 
вот так - плохо:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TForm1.Button1Click(Sender: TObject);
 
procedure TForm1.Button1Click(Sender: TObject);
 
begin
 
begin
   Shape1Paint(Self); // Call Shape1Onpaint event
+
   Shape1Paint(Self); // Вызов события Shape1Onpaint
   Shape1.Invalidate; // Invoke actual painting
+
   Shape1.Invalidate; // Вызываем фактическую перерисовку
  
   ... more code for Button1 ...   
+
   ... больше кода для Button1 ...   
 
end;
 
end;
 
</syntaxhighlight>
 
</syntaxhighlight>
  
This is good:
+
Вот так - хорошо:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TForm1.Button1Click(Sender: TObject);
 
procedure TForm1.Button1Click(Sender: TObject);
 
begin
 
begin
   ... code for Button1 ...  
+
   ... код для Button1 ...  
   Set some condition;  
+
   <Устанавливаем некоторые условия>;  
   // Shape1.Invalidate; // May be necessary on some occasions
+
   // Shape1.Invalidate; // Может быть необходимо в некоторых случаях
 
end;
 
end;
  
// Shape1Paint should be attached to the OnPaint event of shape object !
+
// Shape1Paint должен быть прописан в  событии OnPaint объекта shape!
 
procedure TForm1.Shape1Paint(Sender: TObject);
 
procedure TForm1.Shape1Paint(Sender: TObject);
 
var
 
var
 
   Myrect: TRect;
 
   Myrect: TRect;
 
begin   
 
begin   
   if some condition then  
+
   if <некоторое условие> then  
 
     with Shape1.Canvas do
 
     with Shape1.Canvas do
 
     begin
 
     begin
       ... lots of stuff ...
+
       ... куча кода ...
 
     end;
 
     end;
 
end;     
 
end;     
 
</syntaxhighlight>
 
</syntaxhighlight>
  
==Some useful examples==
+
==Несколько полезных примеров==
===Example 1: Drawing on loaded JPEG with TImage===
+
===Пример 1: Рисование на загруженном JPEG с [помощью] TImage===
Add procedure LoadAndDraw to the public section of your form, and paste next code to implemantation section:
+
Добавьте процедуру LoadAndDraw в секцию public вашей формы и вставьте следующий код в раздел implementation:
<syntaxhighlight>
+
 
 +
<syntaxhighlight lang=pascal>
 
procedure TForm1.LoadAndDraw(const sFileName: String);
 
procedure TForm1.LoadAndDraw(const sFileName: String);
 
var  
 
var  
Line 873: Line 894:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
===Example 2: Drawing on controls of Form===
+
===Пример 2: Рисование на элементах управления формы===
  
1) Create a New project - Application, add to uses section next modules if needed: Types, Controls, Graphics.
+
1) Создайте новый проект New project -> Application, добавьте в раздел uses следующие модули, если необходимо: Types, Controls, Graphics.
  
2) Place on form Button1, GroupBox1 and RadioGroup1
+
2) Положите на форму Button1, GroupBox1 и RadioGroup1
  
3) Place on GroupBox1 one more button - Button2
+
3) Положите на GroupBox1 еще одну кнопку - Button2
  
4) Your TForm1.Create should looks like:
+
4) Ваша TForm1.Create должна выглядеть так:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TForm1.FormCreate(Sender: TObject);
 
procedure TForm1.FormCreate(Sender: TObject);
 
var
 
var
Line 895: Line 916:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
5) For RadioGroup1 create handler of OnSelectionChanged event:
+
5) Для RadioGroup1 создайте обработчик события OnSelectionChanged:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TForm1.RadioGroup1SelectionChanged(Sender: TObject);
 
procedure TForm1.RadioGroup1SelectionChanged(Sender: TObject);
 
begin
 
begin
Line 904: Line 925:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
6) Add to public section of your form procedure HighlightControl:
+
6) Добавьте в секцию public вашей формы процедуру HighlightControl:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TForm1.HighlightControl(AControl: TControl);
 
procedure TForm1.HighlightControl(AControl: TControl);
 
var
 
var
Line 913: Line 934:
 
begin
 
begin
 
   R := AControl.BoundsRect;
 
   R := AControl.BoundsRect;
   InflateRect(R, 2, 2);          // make rect a bit bigger then control
+
   InflateRect(R, 2, 2);          // сделайте прямоугольник немного больше, чем элемент управления
 
   aCC := TControlCanvas.Create;
 
   aCC := TControlCanvas.Create;
 
   aCC.Control := AControl.Parent;
 
   aCC.Control := AControl.Parent;
Line 925: Line 946:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
==See also==
+
==См. также==
 
* [[Fast direct pixel access]]
 
* [[Fast direct pixel access]]

Latest revision as of 07:03, 13 February 2020

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

Внутренний пиксельный формат для TColor в LCL - это формат XXBBGGRR, который соответствует собственному формату Windows и противоположен большинству других библиотек, которые используют AARRGGBB. Часть XX используется для определения того, является ли цвет фиксированным цветом, в этом случае XX должен быть 00 или это индекс системного цвета. Нет места для альфа-канала.

Для преобразования из отдельных каналов RGB в TColor используйте:

RGBToColor(RedVal, GreenVal, BlueVal);

Чтобы получить каждый канал переменной TColor, используйте функции Red, Green и Blue:

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

TFPColor

TFPColor использует формат AARRGGBB, общий для большинства библиотек, но он использует 16-битную глубину каждого цветового канала, что составляет 64 бита на пиксель, что является необычным. Однако это не обязательно означает, что изображения будут занимать столько памяти. Изображения, созданные с помощью TRawImage + TLazIntfImage, могут иметь любой внутренний формат хранения, а затем при операциях рисования TFPColor преобразуется в этот внутренний формат.

Модуль Graphics предоставляет процедуры для преобразования между TColor и 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; // не работает для системного цвета

Рисование с помощью fcl-image

Вы можете рисовать изображения, которые не будут отображаться на экране без LCL, просто используя fcl-image напрямую. Например, программа, работающая на веб-сервере без X11, может выиграть от отсутствия визуальной библиотеки в качестве зависимости. FPImage (псевдоним fcl-image) - это очень общая библиотека изображений и графики, полностью написанная на паскале. Фактически, LCL использует FPImage также для всех загрузок и сохранений из/в файлы и реализует функцию рисования через вызовы наборов виджетов (winapi, gtk, carbon, ...). Fcl-изображение с другой стороны также имеет процедуры рисования.

Для получения дополнительной информации, пожалуйста, прочитайте статью о fcl-image.

Распространенная ошибка [при использовании] OnPaint

Распространенной ошибкой, которая вызывает много ложных сообщений об багах, является вызов события Onpaint для одного объекта из другого объекта. При использовании LCL это может работать в GTK2 и Windows, но, вероятно, не удастся с Qt, Carbon и Cocoa. Обычно не нужно вызывать Invalidate. Тем не менее, иногда это может быть необходимо в процедуре Button1Click,

вот так - плохо:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Shape1Paint(Self); // Вызов события Shape1Onpaint
  Shape1.Invalidate; // Вызываем фактическую перерисовку

  ... больше кода для Button1 ...  
end;

Вот так - хорошо:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ... код для Button1 ... 
  <Устанавливаем некоторые условия>; 
  // Shape1.Invalidate; // Может быть необходимо в некоторых случаях
end;

// Shape1Paint должен быть прописан в  событии OnPaint объекта shape!
procedure TForm1.Shape1Paint(Sender: TObject);
var
  Myrect: TRect;
begin   
  if <некоторое условие> then 
    with Shape1.Canvas do
    begin
      ... куча кода ...
    end;
end;

Несколько полезных примеров

Пример 1: Рисование на загруженном JPEG с [помощью] TImage

Добавьте процедуру LoadAndDraw в секцию public вашей формы и вставьте следующий код в раздел implementation:

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;

Пример 2: Рисование на элементах управления формы

1) Создайте новый проект New project -> Application, добавьте в раздел uses следующие модули, если необходимо: Types, Controls, Graphics.

2) Положите на форму Button1, GroupBox1 и RadioGroup1

3) Положите на GroupBox1 еще одну кнопку - Button2

4) Ваша TForm1.Create должна выглядеть так:

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) Для RadioGroup1 создайте обработчик события OnSelectionChanged:

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

6) Добавьте в секцию public вашей формы процедуру HighlightControl:

procedure TForm1.HighlightControl(AControl: TControl);
var
  R: Types.TRect;
  aCC: TControlCanvas;
begin
  R := AControl.BoundsRect;
  InflateRect(R, 2, 2);          // сделайте прямоугольник немного больше, чем элемент управления
  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;

См. также