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

gtk2: fix TGTKWidgetSet.RawImage_FromPixbuf by C Western (issue #0015080)

Browse Source 
git-svn-id: trunk@22717 -
This commit is contained in:
paul 2009-11-23 06:55:57 +00:00
parent 36a4e85606
commit c8e69ea350
1 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lcl/interfaces/gtk/gtkwidgetset.inc
View File

@ -2117,7 +2117,10 @@ var
ADesc: TRawImageDescription absolute ARawImage.Description;
Pixbuf: PGdkPixbuf;
pixels: pguchar;
Dest: PByte;
R: TRect;
i: Integer;
SourceStride, DestStride: PtrUInt;
begin
Result := False;
if APixbuf = nil then
@ -2151,11 +2154,22 @@ begin
Pixbuf := gdk_pixbuf_new_subpixbuf(APixbuf, R.Left, R.Top, ADesc.Width, ADesc.Height);
try
pixels := gdk_pixbuf_get_pixels(Pixbuf);
ARawImage.DataSize := PtrUInt(gdk_pixbuf_get_rowstride(Pixbuf)) * PtrUInt(ADesc.Height);
SourceStride := PtrUInt(gdk_pixbuf_get_rowstride(Pixbuf));
DestStride := ADesc.BytesPerLine;
ARawImage.DataSize := DestStride * PtrUInt(ADesc.Height);
ReAllocMem(ARawImage.Data, ARawImage.DataSize);
if ARawImage.DataSize > 0 then
System.Move(pixels^, ARawImage.Data^, ARawImage.DataSize);
if SourceStride = DestStride then
System.Move(pixels^, ARawImage.Data^, ARawImage.DataSize)
else begin
{ Extra padding bytes - need to copy by line }
Dest := ARawImage.Data;
for i := 0 to ADesc.Height-1 do begin
System.Move(pixels^, Dest^, ADesc.BytesPerLine);
Inc(pixels, SourceStride);
Inc(Dest, DestStride);
end;
end;
finally
gdk_pixbuf_unref(Pixbuf);
end;