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

* fixed bug #8550 for loading and alignment. Creating a 1bit bitmap when requesten still needs to be done

Browse Source 
git-svn-id: trunk@12387 -
This commit is contained in:
marc 2007-10-09 00:10:15 +00:00
parent d7ae834ce1
commit 27cda5e7cd
1 changed files with 66 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -736,10 +736,19 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TGtkWidgetSet.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; function TGtkWidgetSet.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
const
MIN_LOADER_HEADER_SIZE = 128;
type type
// the loader internally used starts decoding the header after 128 bytes.
// by adding dummy bytes and adjusting the data offset, we make sure that we
// we write atleast 128 bytes
TBitmapHeader = packed record TBitmapHeader = packed record
FileHeader: tagBitmapFileHeader; FileHeader: tagBitmapFileHeader;
InfoHeader: tagBitmapInfoHeader; InfoHeader: tagBitmapInfoHeader;
Dummy: array[1..MIN_LOADER_HEADER_SIZE] of Byte;
end; end;
var var
@ -760,37 +769,72 @@ var
Header.InfoHeader.biYPelsPerMeter := GetDeviceCaps(0, LOGPIXELSY); Header.InfoHeader.biYPelsPerMeter := GetDeviceCaps(0, LOGPIXELSY);
Header.FileHeader.bfType := LeToN($4D42); Header.FileHeader.bfType := LeToN($4D42);
Header.FileHeader.bfSize := SizeOf(Header) + Header.InfoHeader.biSizeImage; Header.FileHeader.bfSize := MIN_LOADER_HEADER_SIZE + Header.InfoHeader.biSizeImage;
Header.FileHeader.bfOffBits := SizeOf(Header); Header.FileHeader.bfOffBits := MIN_LOADER_HEADER_SIZE;
end; end;
procedure LoadDataByPixbufLoader; procedure LoadDataByPixbufLoader;
const
ALIGNDATA: Word = 0;
var var
Header: TBitmapHeader; Header: TBitmapHeader;
Loader: PGdkPixbufLoader; Loader: PGdkPixbufLoader;
Src: PGDKPixbuf; Src: PGDKPixbuf;
res: Boolean;
LineSize, Count: Integer;
BitsPtr: PByte;
begin begin
Loader := gdk_pixbuf_loader_new; Loader := gdk_pixbuf_loader_new;
if Loader = nil then Exit; if Loader = nil then Exit;
FillBitmapInfo(Header); FillBitmapInfo(Header);
Src := nil;
SRC := nil; try
if not gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@Header), MIN_LOADER_HEADER_SIZE {$ifdef gtk2},nil{$endif})
if gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@Header), SizeOf(Header) {$ifdef gtk2},nil{$endif})
then begin then begin
if gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(BitmapBits), Header.InfoHeader.biSizeImage {$ifdef gtk2},nil{$endif}) DebugLn('WARNING: [TGtkWidgetSet.CreateBitmap] Error occured loading Bitmap Header!');
Exit;
end;
LineSize := (((BitCount * Width + 15) shr 4) shl 1);
if (LineSize and 2) <> 0
then begin then begin
// bitmapdata needs to be DWord aligned, while CreateBitmap is word aligned
// so "feed" the loader line by line :(
Count := Height;
res := True;
BitsPtr := BitmapBits;
while res and (Count > 0) do
begin
res := gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(BitsPtr), LineSize {$ifdef gtk2},nil{$endif})
and gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@ALIGNDATA), 2 {$ifdef gtk2},nil{$endif});
Inc(BitsPtr, LineSize);
Dec(Count);
end;
end
else begin
// data is DWord aligned :)
res := gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(BitmapBits), Header.InfoHeader.biSizeImage {$ifdef gtk2},nil{$endif});
end;
if not res
then begin
DebugLn('WARNING: [TGtkWidgetSet.CreateBitmap] Error occured loading Image!');
Exit;
end;
Src := gdk_pixbuf_loader_get_pixbuf(loader); Src := gdk_pixbuf_loader_get_pixbuf(loader);
if Src = nil if Src = nil
then DebugLn('WARNING: [TGtkWidgetSet.CreateBitmap] Error occured loading Pixbuf!'); then begin
end DebugLn('WARNING: [TGtkWidgetSet.CreateBitmap] Error occured loading Pixbuf!');
else DebugLn('WARNING: [TGtkWidgetSet.CreateBitmap] Error occured loading Image!'); Exit;
end end;
else DebugLn('WARNING: [TGtkWidgetSet.CreateBitmap] Error occured loading Bitmap Header!');
gdk_pixbuf_loader_close(Loader {$ifdef gtk2},nil {$endif});
if Src = nil then Exit; finally
gdk_pixbuf_loader_close(Loader {$ifdef gtk2},nil {$endif});
end;
{$note todo create 1bit bitmap when requested} // then next always returns system depth
gdk_pixbuf_render_pixmap_and_mask(Src, GdiObject^.GDIPixmapObject.Image, GdiObject^.GDIPixmapObject.Mask, $80); gdk_pixbuf_render_pixmap_and_mask(Src, GdiObject^.GDIPixmapObject.Image, GdiObject^.GDIPixmapObject.Mask, $80);
gdk_pixbuf_unref(Src); gdk_pixbuf_unref(Src);