[Lazarus] Read image from resources with TLazIntfImage
Felipe Monteiro de Carvalho
felipemonteiro.carvalho at gmail.com
Mon Apr 28 00:16:18 CEST 2008
I don't know how to answer your original doubt, but I load bitmaps
with color transparency from .rc resources which are linked inside the
executable on win32 or from external files in any other operating
system with the following code. Maybe it will help you:
{*******************************************************************
* TGlass.LoadBitmap ()
*
* DESCRIPTION: Loads bitmap from an internal resource to a bitmap object
*
* PARAMETERS:
*
* RETURNS:
*
*******************************************************************}
class function TGlass.LoadBitmap(bmp: TBitmap; NomeDoRecurso: Integer): Boolean;
var
buffer: THandle;
memstream: TMemoryStream;
FileName: string;
begin
Result := False;
{$IFDEF Win32}
buffer := Windows.LoadBitmap(hInstance, MAKEINTRESOURCE(NomeDoRecurso));
if (buffer = 0) then exit;
bmp.Handle := buffer;
memstream := TMemoryStream.create;
try
try
bmp.savetostream(memstream);
memstream.position := 0;
bmp.loadfromstream(memstream);
finally
memstream.free;
end;
except
Exit;
end;
{$ENDIF}
{$IFDEF Unix}
case NomeDoRecurso of
IDB_TOPLEFT: FileName := 'topleft.bmp';
IDB_TOPRIGHT: FileName := 'topright.bmp';
IDB_BOTTOMLEFT: FileName := 'bottomleft.bmp';
IDB_BOTTOMRIGHT: FileName := 'bottomright.bmp';
IDB_TOP: FileName := 'top.bmp';
IDB_LEFT: FileName := 'left.bmp';
IDB_BOTTOM: FileName := 'bottom.bmp';
IDB_RIGHT: FileName := 'right.bmp';
IDB_CECAE: FileName := 'cecae.bmp';
IDB_FEUSP: FileName := 'feusp.bmp';
IDB_VMG: FileName := 'vmg.bmp';
IDB_LUPA: FileName := 'lupa.bmp';
IDB_USPLEGAL: FileName := 'usplegal.bmp';
else
WriteLn('Wrong image name');
Exit;
end;
Write('[TGlass.LoadBitmap] Loading ' + vConfigurations.MyDirectory +
FileName);
try
bmp.LoadFromFile(vConfigurations.MyDirectory + FileName);
except
WriteLn(ErrorLoading);
Exit;
end;
WriteLn('');
{$ENDIF}
Result := True;
end;
{*******************************************************************
* TGlass.LoadImages ()
*
* DESCRIPTION: Load bitmaps required by the Magnifying Glass
* This function loads and generates the rectangular glass
*
* PARAMETERS:
*
* RETURNS:
*
*******************************************************************}
function TGlass.LoadImages: Boolean;
begin
Result := True;
if (not LoadBitmap(bmpTopLeft, IDB_TOPLEFT)) then Result := False;
bmpTopLeft.Transparent := True;
bmpTopLeft.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpTopRight, IDB_TOPRIGHT)) then Result := False;
bmpTopRight.Transparent := True;
bmpTopRight.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpBottomLeft, IDB_BOTTOMLEFT)) then Result := False;
bmpBottomLeft.Transparent := True;
bmpBottomLeft.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpBottomRight, IDB_BOTTOMRIGHT)) then Result := False;
bmpBottomRight.Transparent := True;
bmpBottomRight.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpTop, IDB_TOP)) then Result := False;
bmpTop.Transparent := True;
bmpTop.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpLeft, IDB_LEFT)) then Result := False;
bmpLeft.Transparent := True;
bmpLeft.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpBottom, IDB_BOTTOM)) then Result := False;
bmpBottom.Transparent := True;
bmpBottom.TransparentColor := clFuchsia;
if (not LoadBitmap(bmpRight, IDB_RIGHT)) then Result := False;
bmpRight.Transparent := True;
bmpRight.TransparentColor := clFuchsia;
// Check the sizes
if ((bmpTopLeft.Width <> bmpTopRight.Width) or
(bmpTopLeft.Height <> bmpTopRight.Height) or
(bmpBottomLeft.Width <> bmpBottomRight.Width) or
(bmpBottomLeft.Height <> bmpBottomRight.Height)) // Sizes must match
then Result := False;
// Check the sizes
if ((bmpLeft.Width <> bmpRight.Width) or
(bmpLeft.Height <> bmpRight.Height) or
(bmpTop.Width <> bmpBottom.Width) or
(bmpTop.Height <> bmpBottom.Height)) // Sizes must match
then Result := False;
end;
More information about the Lazarus
mailing list