/examples/scanline/unit1.pas

http://github.com/graemeg/lazarus · Pascal · 129 lines · 59 code · 20 blank · 50 comment · 2 complexity · 59f851f6fbe9ebc11f00ca3198e6f809 MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. Abstract:
  21. This example demonstrates how to
  22. - create an image with an internal format similar to Delphi's pf24bit
  23. - convert it to current format and create a TBitmap from it
  24. - use an approach similar to Delphi's TBitmap.ScanLine.
  25. Delphi's TBitmap implementation only supports windows formats. For example
  26. the TBitmap.ScanLine function gives a direct pointer to the memory. This is
  27. not possible under all widget sets. And even those who supports it, uses
  28. different formats than windows. So Delphi code using TBitmap.ScanLine has to
  29. be changed anyway. How much depends on how much speed is needed.
  30. If the goal is to quickly port some Delphi code using TBitmap.Scanline, then
  31. the below code gives some hints how to achieve it.
  32. }
  33. unit Unit1;
  34. {$mode objfpc}{$H+}
  35. interface
  36. uses
  37. Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
  38. FPImage, GraphType, IntfGraphics, StdCtrls;
  39. type
  40. { TForm1 }
  41. TForm1 = class(TForm)
  42. Label1: TLabel;
  43. procedure FormCreate(Sender: TObject);
  44. procedure FormDestroy(Sender: TObject);
  45. procedure FormPaint(Sender: TObject);
  46. private
  47. public
  48. MyBitmap: TBitmap;
  49. procedure PaintToRGB32bitScanLine(Row, ImgWidth: integer; LineStart: Pointer);
  50. end;
  51. var
  52. Form1: TForm1;
  53. implementation
  54. {$R unit1.lfm}
  55. { TForm1 }
  56. procedure TForm1.FormCreate(Sender: TObject);
  57. var
  58. IntfImage: TLazIntfImage;
  59. ScanLineImage: TLazIntfImage;
  60. y: Integer;
  61. ImgFormatDescription: TRawImageDescription;
  62. begin
  63. MyBitmap:=TBitmap.Create;
  64. // create an image with a format similar to Delphi's pf32bit
  65. // keep in mind that you access it in bytes, not words or dwords
  66. // For example PowerPC uses another byte order (endian big)
  67. ScanLineImage:=TLazIntfImage.Create(0,0);
  68. ImgFormatDescription.Init_BPP32_B8G8R8_BIO_TTB(30,20);
  69. ScanLineImage.DataDescription:=ImgFormatDescription;
  70. // call the pf24bit specific drawing function
  71. for y:=0 to ScanLineImage.Height-1 do
  72. PaintToRGB32bitScanLine(y,ScanLineImage.Width,
  73. ScanLineImage.GetDataLineStart(y));
  74. // create IntfImage with the format of the current LCL interface
  75. MyBitmap.Width:=ScanLineImage.Width;
  76. MyBitmap.Height:=ScanLineImage.Height;
  77. IntfImage:=MyBitmap.CreateIntfImage;
  78. // convert the content from the very specific to the current format
  79. IntfImage.CopyPixels(ScanLineImage);
  80. MyBitmap.LoadFromIntfImage(IntfImage);
  81. ScanLineImage.Free;
  82. IntfImage.Free;
  83. end;
  84. procedure TForm1.FormDestroy(Sender: TObject);
  85. begin
  86. MyBitmap.Free;
  87. end;
  88. procedure TForm1.FormPaint(Sender: TObject);
  89. begin
  90. Canvas.Draw(10,10,MyBitmap);
  91. end;
  92. procedure TForm1.PaintToRGB32bitScanLine(Row, ImgWidth: integer;
  93. LineStart: Pointer);
  94. // LineStart is pointer to the start of a scanline with the following format:
  95. // 4 bytes per pixel. First byte is blue, second green, third is red.
  96. // Black is 0,0,0, white is 255,255,255
  97. var
  98. i: Integer;
  99. begin
  100. // fill line with gray
  101. for i:=0 to (ImgWidth*4)-1 do
  102. PByte(LineStart)[i]:=0; // set red, green and blue to 0 (i.e. black)
  103. // set one pixel to red (this creates a red line)
  104. PByte(LineStart)[(Row mod ImgWidth)*4+2]:=255;
  105. end;
  106. end.