From 4aaef35274377851d515fb420343d23a3261b9bd Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 1 Dec 2006 21:23:32 +0000 Subject: [PATCH] examples: added an example for ScanLine replacement git-svn-id: trunk@10275 - --- .gitattributes | 5 + examples/scanline/bitmapscanline1.lpi | 66 ++++++++++++++ examples/scanline/bitmapscanline1.lpr | 19 ++++ examples/scanline/unit1.lfm | 22 +++++ examples/scanline/unit1.lrs | 11 +++ examples/scanline/unit1.pas | 126 ++++++++++++++++++++++++++ lcl/graphics.pp | 3 +- lcl/include/bitmap.inc | 9 ++ lcl/intfgraphics.pas | 77 +++++++++++++++- 9 files changed, 336 insertions(+), 2 deletions(-) create mode 100644 examples/scanline/bitmapscanline1.lpi create mode 100644 examples/scanline/bitmapscanline1.lpr create mode 100644 examples/scanline/unit1.lfm create mode 100644 examples/scanline/unit1.lrs create mode 100644 examples/scanline/unit1.pas diff --git a/.gitattributes b/.gitattributes index 609e086f1a..b684680f36 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1158,6 +1158,11 @@ examples/postscript/usamplepostscriptcanvas.lrs svneol=native#text/pascal examples/postscript/usamplepostscriptcanvas.pas svneol=native#text/pascal examples/progressbar.lpi svneol=native#text/plain examples/progressbar.pp svneol=native#text/pascal +examples/scanline/bitmapscanline1.lpi svneol=native#text/plain +examples/scanline/bitmapscanline1.lpr svneol=native#text/plain +examples/scanline/unit1.lfm svneol=native#text/plain +examples/scanline/unit1.lrs svneol=native#text/plain +examples/scanline/unit1.pas svneol=native#text/plain examples/scrollbar.lpi svneol=native#text/plain examples/scrollbar.pp svneol=native#text/pascal examples/selection.pp svneol=native#text/pascal diff --git a/examples/scanline/bitmapscanline1.lpi b/examples/scanline/bitmapscanline1.lpi new file mode 100644 index 0000000000..9ea7435dc4 --- /dev/null +++ b/examples/scanline/bitmapscanline1.lpi @@ -0,0 +1,66 @@ + + + + + + + + + + + + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="bitmapscanline1.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="BitmapScanLine1"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <ComponentName Value="Form1"/> + <IsPartOfProject Value="True"/> + <ResourceFilename Value="unit1.lrs"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <SearchPaths> + <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/> + </SearchPaths> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/examples/scanline/bitmapscanline1.lpr b/examples/scanline/bitmapscanline1.lpr new file mode 100644 index 0000000000..1bc96e2a70 --- /dev/null +++ b/examples/scanline/bitmapscanline1.lpr @@ -0,0 +1,19 @@ +program BitmapScanLine1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, Unit1; + +begin + Application.Title:='project1'; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/examples/scanline/unit1.lfm b/examples/scanline/unit1.lfm new file mode 100644 index 0000000000..c33df5c970 --- /dev/null +++ b/examples/scanline/unit1.lfm @@ -0,0 +1,22 @@ +object Form1: TForm1 + Left = 290 + Height = 144 + Top = 189 + Width = 623 + HorzScrollBar.Page = 622 + VertScrollBar.Page = 143 + Caption = 'Form1' + OnCreate = FormCreate + OnDestroy = FormDestroy + OnPaint = FormPaint + object Label1: TLabel + Left = 156 + Height = 13 + Top = 42 + Width = 407 + Caption = 'You should see a small rectangle filled with gray and a diagonal red line' + Color = clNone + ParentColor = False + WordWrap = True + end +end diff --git a/examples/scanline/unit1.lrs b/examples/scanline/unit1.lrs new file mode 100644 index 0000000000..2e4fab449f --- /dev/null +++ b/examples/scanline/unit1.lrs @@ -0,0 +1,11 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3#144#0#3'Top'#3#189#0#5'W' + +'idth'#3'o'#2#18'HorzScrollBar.Page'#3'n'#2#18'VertScrollBar.Page'#3#143#0#7 + +'Caption'#6#5'Form1'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDest' + +'roy'#7'OnPaint'#7#9'FormPaint'#0#6'TLabel'#6'Label1'#4'Left'#3#156#0#6'Heig' + +'ht'#2#13#3'Top'#2'*'#5'Width'#3#151#1#7'Caption'#6'IYou should see a small ' + +'rectangle filled with gray and a diagonal red line'#5'Color'#7#6'clNone'#11 + +'ParentColor'#8#8'WordWrap'#9#0#0#0 +]); diff --git a/examples/scanline/unit1.pas b/examples/scanline/unit1.pas new file mode 100644 index 0000000000..43a4af4903 --- /dev/null +++ b/examples/scanline/unit1.pas @@ -0,0 +1,126 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Abstract: + This example demonstrates how to + - create an image with an internal format similar to Delphi's pf24bit + - convert it to current format and create a TBitmap from it + - use an approach similar to Delphi's TBitmap.ScanLine. + + Delphi's TBitmap implementation only supports windows formats. For example + the TBitmap.ScanLine function gives a direct pointer to the memory. This is + not possible under all widget sets. And even those who supports it, uses + different formats than windows. So Delphi code using TBitmap.ScanLine has to + be changed anyway. How much depends on how much speed is needed. + + If the goal is to quickly port some Delphi code using TBitmap.Scanline, then + the below code gives some hints how to achieve it. +} +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, + FPImage, GraphType, IntfGraphics, StdCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Label1: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormPaint(Sender: TObject); + private + public + MyBitmap: TBitmap; + procedure PaintToRGB32bitScanLine(Row, ImgWidth: integer; LineStart: Pointer); + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +var + IntfImage: TLazIntfImage; + ScanLineImage: TLazIntfImage; + y: Integer; +begin + MyBitmap:=TBitmap.Create; + + // create an image with a format similar to Delphi's pf32bit + // keep in mind that you access it in bytes, not words or dwords + // For example PowerPC uses another byte order (endian big) + ScanLineImage:=TLazIntfImage.Create(0,0); + ScanLineImage.Set_BPP32_B8G8R8_A1_BIO_TTB(30,20); + + // call the very fast and very specific drawing function + for y:=0 to ScanLineImage.Height-1 do + PaintToRGB32bitScanLine(y,ScanLineImage.Width, + ScanLineImage.GetDataLineStart(y)); + + // create IntfImage with the format of the current LCL interface + IntfImage:=MyBitmap.CreateIntfImage; + // convert the content from the very specific to the current format + IntfImage.CopyPixels(ScanLineImage); + MyBitmap.LoadFromIntfImage(IntfImage); + + ScanLineImage.Free; + IntfImage.Free; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + MyBitmap.Free; +end; + +procedure TForm1.FormPaint(Sender: TObject); +begin + Canvas.Draw(10,10,MyBitmap); +end; + +procedure TForm1.PaintToRGB32bitScanLine(Row, ImgWidth: integer; + LineStart: Pointer); +// LineStart is pointer to the start of a scanline with the following format: +// 4 bytes per pixel. First byte is blue, second green, third is red. +// Black is 0,0,0, white is 255,255,255 +var + i: Integer; +begin + // fill line with gray + for i:=0 to (ImgWidth*4)-1 do + PByte(LineStart)[i]:=128; // set red, green and blue to 128 + // set one pixel to red + PByte(LineStart)[(Row mod ImgWidth)*4+2]:=255; +end; + +initialization + {$I unit1.lrs} + +end. + diff --git a/lcl/graphics.pp b/lcl/graphics.pp index e276fdbb80..1e9366ecfa 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -1171,7 +1171,8 @@ type procedure GetSupportedSourceMimeTypes(List: TStrings); override; function GetDefaultMimeType: string; override; class function GetFileExtensions: string; override; - Procedure LoadFromXPMFile(const Filename: String); + procedure LoadFromXPMFile(const Filename: String); + procedure LoadFromIntfImage(IntfImage: TLazIntfImage); procedure Mask(ATransparentColor: TColor); procedure SaveToStream(Stream: TStream); override; procedure ReadStream(Stream: TStream; UseSize: boolean; Size: Longint); virtual; diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index 7de6a7a292..1cb07ac8b6 100644 --- a/lcl/include/bitmap.inc +++ b/lcl/include/bitmap.inc @@ -488,6 +488,15 @@ Begin LoadFromFile(Filename); end; +procedure TBitmap.LoadFromIntfImage(IntfImage: TLazIntfImage); +var + ImgHandle, ImgMaskHandle: HBitmap; +begin + IntfImage.CreateBitmap(ImgHandle,ImgMaskHandle,false); + Handle:=ImgHandle; + MaskHandle:=ImgMaskHandle; +end; + function TBitmap.GetMonochrome: Boolean; begin with FImage.FDIB.dsbm do diff --git a/lcl/intfgraphics.pas b/lcl/intfgraphics.pas index 00460483c4..081959ebc2 100644 --- a/lcl/intfgraphics.pas +++ b/lcl/intfgraphics.pas @@ -181,6 +181,7 @@ type ExceptionOnError: boolean): boolean; virtual; procedure GetDescriptionFromDevice(DC: HDC); virtual; procedure GetDescriptionFromBitmap(Bitmap: HBitmap); virtual; + procedure Set_BPP32_B8G8R8_A1_BIO_TTB(NewWidth, NewHeight: integer); procedure LoadFromDevice(DC: HDC); virtual; procedure LoadFromBitmap(Bitmap, MaskBitmap: HBitmap; AWidth: integer = -1; AHeight: integer = -1); virtual; procedure CreateBitmap(var Bitmap, MaskBitmap: HBitmap; @@ -188,8 +189,10 @@ type procedure SetRawImage(const RawImage: TRawImage); virtual; procedure GetRawImage(out RawImage: TRawImage); virtual; procedure FillPixels(const Color: TFPColor); virtual; + procedure CopyPixels(Src: TFPCustomImage); virtual; procedure GetXYDataPostion(x, y: integer; var Position: TRawImagePosition); procedure GetXYMaskPostion(x, y: integer; var Position: TRawImagePosition); + function GetDataLineStart(y: integer): Pointer;// similar to Delphi TBitmap.ScanLine. Only works with byte aligned lines. procedure CreateAllData; virtual; procedure CreatePixelData; virtual; procedure CreateMaskData; virtual; @@ -1667,6 +1670,13 @@ begin inc(Position.Byte,BitOffset shr 3); end; +function TLazIntfImage.GetDataLineStart(y: integer): Pointer; +begin + if FDataDescription.LineOrder=riloBottomToTop then + y:=Height-y; + Result:=FPixelData+FLineStarts[y].Byte; +end; + procedure TLazIntfImage.LoadFromDevice(DC: HDC); var ARect: TRect; @@ -1681,7 +1691,7 @@ begin end; procedure TLazIntfImage.LoadFromBitmap(Bitmap, MaskBitmap: HBitmap; - AWidth, AHeight: integer); + AWidth: integer; AHeight: integer); var ARect: TRect; ARawImage: TRawImage; @@ -1775,6 +1785,43 @@ begin DataDescription:=NewDataDescription; end; +procedure TLazIntfImage.Set_BPP32_B8G8R8_A1_BIO_TTB(NewWidth, NewHeight: integer + ); +// Format=ricfRGBA HasPalette=false Depth=24 PaletteColorCount=0 +// BitOrder=riboBitsInOrder ByteOrder=DefaultByteOrder +// LineOrder=riloTopToBottom +// BitsPerPixel=32 LineEnd=rileDWordBoundary +// RedPrec=8 RedShift=16 GreenPrec=8 GreenShift=8 BluePrec=8 BlueShift=0 +// AlphaSeparate=false +var + ADesc: TRawImageDescription; +begin + // setup an artificial ScanLineImage with format RGB 24 bit, 32bit depth format + FillChar(ADesc,SizeOf(ADesc),0); + with ADesc do begin + Format:=ricfRGBA; + Depth:=24; // used bits per pixel + Width:=0; + Height:=0; + BitOrder:=riboBitsInOrder; + ByteOrder:=DefaultByteOrder; + LineOrder:=riloTopToBottom; + BitsPerPixel:=32; // bits per pixel. can be greater than Depth. + LineEnd:=rileDWordBoundary; + RedPrec:=8; // red precision. bits for red + RedShift:=16; + GreenPrec:=8; + GreenShift:=8; // bitshift. Direction: from least to most signifikant + BluePrec:=8; + BlueShift:=0; + AlphaPrec:=0; + AlphaSeparate:=false; + end; + + DataDescription:=ADesc; + SetSize(NewWidth,NewHeight); +end; + procedure TLazIntfImage.FillPixels(const Color: TFPColor); var ColorChar: char; @@ -1823,6 +1870,34 @@ begin // ToDo: mask end; +procedure TLazIntfImage.CopyPixels(Src: TFPCustomImage); +var + y: Integer; + x: Integer; + SrcImg: TLazIntfImage; +begin + if (Src.Width<>Width) or (Src.Height<>Height) then + SetSize(Src.Width,Src.Height); + if Src is TLazIntfImage then begin + SrcImg:=TLazIntfImage(Src); + if CompareMem(@FDataDescription,@SrcImg.FDataDescription, + SizeOf(FDataDescription)) + then begin + // same description -> copy + if FPixelData<>nil then + System.Move(SrcImg.FPixelData^,FPixelData^,FPixelDataSize); + if FMaskData<>nil then + System.Move(SrcImg.FMaskData^,FMaskData^,FMaskDataSize); + exit; + end; + end; + + // copy pixels + for y:=0 to Height-1 do + for x:=0 to Width-1 do + Colors[x,y]:=Src.Colors[x,y]; +end; + { TLazReaderXPM } type