[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