paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 12:00:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Add scanline support

Browse Source 
git-svn-id: trunk@41855 -
This commit is contained in:
marc 2013-06-23 19:46:43 +00:00
parent 698715cdc9
commit 84d4e52eae
3 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/graphics.pp
View File

@ -1297,6 +1297,7 @@ type
procedure FreeCanvasContext; procedure FreeCanvasContext;
function GetCanvas: TCanvas; function GetCanvas: TCanvas;
function GetRawImage: TRawImage; function GetRawImage: TRawImage;
function GetScanline(ARow: Integer): Pointer;
function GetTransparentColor: TColor; function GetTransparentColor: TColor;
procedure SetTransparentColor(AValue: TColor); procedure SetTransparentColor(AValue: TColor);
protected protected
@ -1379,7 +1380,7 @@ type
property MaskHandle: HBITMAP read GetMaskHandle write SetMaskHandle; property MaskHandle: HBITMAP read GetMaskHandle write SetMaskHandle;
property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat default pfDevice; property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat default pfDevice;
property RawImage: TRawImage read GetRawImage; // be carefull with this, modify only within a begin/endupdate property RawImage: TRawImage read GetRawImage; // be carefull with this, modify only within a begin/endupdate
// property ScanLine[Row: Integer]: Pointer; -> Use TLazIntfImage for such things property ScanLine[Row: Integer]: Pointer read GetScanLine; platform; // Use only when wrpped by a begin/endupdate
property TransparentColor: TColor read GetTransparentColor property TransparentColor: TColor read GetTransparentColor
write SetTransparentColor default clDefault; write SetTransparentColor default clDefault;
property TransparentMode: TTransparentMode read FTransparentMode property TransparentMode: TTransparentMode read FTransparentMode

9
lcl/graphtype.pp
View File

@ -209,6 +209,7 @@ type
procedure ReleaseData; procedure ReleaseData;
procedure ExtractRect(const ARect: TRect; out ADst: TRawImage); procedure ExtractRect(const ARect: TRect; out ADst: TRawImage);
function GetLineStart(ALine: Cardinal): PByte;
procedure PerformEffect(const ADrawEffect: TGraphicsDrawEffect; CreateNewData: Boolean = True; FreeOldData: boolean = false); procedure PerformEffect(const ADrawEffect: TGraphicsDrawEffect; CreateNewData: Boolean = True; FreeOldData: boolean = false);
function ReadBits(const APosition: TRawImagePosition; APrec, AShift: Byte): Word; function ReadBits(const APosition: TRawImagePosition; APrec, AShift: Byte): Word;
procedure ReadChannels(const APosition: TRawImagePosition; out ARed, AGreen, ABlue, AAlpha: Word); procedure ReadChannels(const APosition: TRawImagePosition; out ARed, AGreen, ABlue, AAlpha: Word);
@ -1585,6 +1586,14 @@ begin
Description.MaskLineEnd, ADst.Mask, ADst.MaskSize); Description.MaskLineEnd, ADst.Mask, ADst.MaskSize);
end; end;
function TRawImage.GetLineStart(ALine: Cardinal): PByte;
begin
Result := Data;
if Result = nil then Exit;
if ALine = 0 then Exit;
Inc(Result, ALine * Description.BytesPerLine);
end;
procedure TRawImage.PerformEffect(const ADrawEffect: TGraphicsDrawEffect; procedure TRawImage.PerformEffect(const ADrawEffect: TGraphicsDrawEffect;
CreateNewData: Boolean; FreeOldData: boolean); CreateNewData: Boolean; FreeOldData: boolean);

8
lcl/include/rasterimage.inc
View File

@ -467,6 +467,14 @@ begin
else Result := p^; else Result := p^;
end; end;
function TRasterImage.GetScanline(ARow: Integer): Pointer;
var
RI: TRawImage;
begin
RI := GetRawImage;
Result := RI.GetLineStart(ARow);
end;
function TRasterImage.GetTransparentColor: TColor; function TRasterImage.GetTransparentColor: TColor;
begin begin
if FTransparentColor = clDefault if FTransparentColor = clDefault