PageRenderTime 13ms CodeModel.GetById 10ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/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
 21  Abstract:
 22    This example demonstrates how to
 23    - create an image with an internal format similar to Delphi's pf24bit
 24    - convert it to current format and create a TBitmap from it
 25    - use an approach similar to Delphi's TBitmap.ScanLine.
 26    
 27  Delphi's TBitmap implementation only supports windows formats. For example
 28  the TBitmap.ScanLine function gives a direct pointer to the memory. This is
 29  not possible under all widget sets. And even those who supports it, uses
 30  different formats than windows. So Delphi code using TBitmap.ScanLine has to
 31  be changed anyway. How much depends on how much speed is needed.
 32  
 33  If the goal is to quickly port some Delphi code using TBitmap.Scanline, then
 34  the below code gives some hints how to achieve it.
 35}
 36unit Unit1;
 37
 38{$mode objfpc}{$H+}
 39
 40interface
 41
 42uses
 43  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
 44  FPImage, GraphType, IntfGraphics, StdCtrls;
 45
 46type
 47
 48  { TForm1 }
 49
 50  TForm1 = class(TForm)
 51    Label1: TLabel;
 52    procedure FormCreate(Sender: TObject);
 53    procedure FormDestroy(Sender: TObject);
 54    procedure FormPaint(Sender: TObject);
 55  private
 56  public
 57    MyBitmap: TBitmap;
 58    procedure PaintToRGB32bitScanLine(Row, ImgWidth: integer; LineStart: Pointer);
 59  end;
 60
 61var
 62  Form1: TForm1; 
 63
 64implementation
 65
 66{$R unit1.lfm}
 67
 68{ TForm1 }
 69
 70procedure TForm1.FormCreate(Sender: TObject);
 71var
 72  IntfImage: TLazIntfImage;
 73  ScanLineImage: TLazIntfImage;
 74  y: Integer;
 75  ImgFormatDescription: TRawImageDescription;
 76begin
 77  MyBitmap:=TBitmap.Create;
 78
 79  // create an image with a format similar to Delphi's pf32bit
 80  // keep in mind that you access it in bytes, not words or dwords
 81  // For example PowerPC uses another byte order (endian big)
 82  ScanLineImage:=TLazIntfImage.Create(0,0);
 83  ImgFormatDescription.Init_BPP32_B8G8R8_BIO_TTB(30,20);
 84  ScanLineImage.DataDescription:=ImgFormatDescription;
 85
 86  // call the pf24bit specific drawing function
 87  for y:=0 to ScanLineImage.Height-1 do
 88    PaintToRGB32bitScanLine(y,ScanLineImage.Width,
 89                            ScanLineImage.GetDataLineStart(y));
 90
 91  // create IntfImage with the format of the current LCL interface
 92  MyBitmap.Width:=ScanLineImage.Width;
 93  MyBitmap.Height:=ScanLineImage.Height;
 94  IntfImage:=MyBitmap.CreateIntfImage;
 95  // convert the content from the very specific to the current format
 96  IntfImage.CopyPixels(ScanLineImage);
 97  MyBitmap.LoadFromIntfImage(IntfImage);
 98
 99  ScanLineImage.Free;
100  IntfImage.Free;
101end;
102
103procedure TForm1.FormDestroy(Sender: TObject);
104begin
105  MyBitmap.Free;
106end;
107
108procedure TForm1.FormPaint(Sender: TObject);
109begin
110  Canvas.Draw(10,10,MyBitmap);
111end;
112
113procedure TForm1.PaintToRGB32bitScanLine(Row, ImgWidth: integer;
114  LineStart: Pointer);
115// LineStart is pointer to the start of a scanline with the following format:
116// 4 bytes per pixel. First byte is blue, second green, third is red.
117// Black is 0,0,0, white is 255,255,255
118var
119  i: Integer;
120begin
121  // fill line with gray
122  for i:=0 to (ImgWidth*4)-1 do
123    PByte(LineStart)[i]:=0; // set red, green and blue to 0 (i.e. black)
124  // set one pixel to red (this creates a red line)
125  PByte(LineStart)[(Row mod ImgWidth)*4+2]:=255;
126end;
127
128end.
129