whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

28 Visitors Online


 
...Load big bitmaps with few memory requirement?
Autor: Alex Sanchez
Homepage: www.ezgis.com
[ Print tip ]  

Tip Rating (38):  
     


function MyGetMem(Size: DWORD): Pointer;
begin
  
Result := Pointer(GlobalAlloc(GPTR, Size));
end;

procedure MyFreeMem(p: Pointer);
begin
  if 
p = nil then Exit;
  GlobalFree(THandle(p));
end;

{ This code will fill a bitmap by stretching an image coming from a big bitmap on disk.

  FileName.- Name of the uncompressed bitmap to read
  DestBitmap.- Target bitmap  where the bitmap on disk will be resampled.
  BufferSize.- The size of a memory buffer used for reading scanlines from the physical bitmap on disk.
    This value will decide how many scanlines can be read from disk at the same time, with always a
    minimum value of 2 scanlines.

  Will return false on error.
}
function GetDIBInBands(const FileName: string;
  DestBitmap: TBitmap; BufferSize: Integer;
  out TotalBitmapWidth, TotalBitmapHeight: Integer): Boolean;
var
  
FileSize: integer;    // calculated file size
  
ImageSize: integer;    // calculated image size
  
dest_MaxScans: integer;  // number of scanline from source bitmap
  
dsty_top: Integer;    // used to calculate number of passes
  
NumPasses: integer;    // number of passed needed
  
dest_Residual: integer;  // number of scanlines on last band
  
Stream: TStream;    // stream used for opening the bitmap
  
bmf: TBITMAPFILEHEADER;  // the bitmap header
  
lpBitmapInfo: PBITMAPINFO;  // bitmap info record
  
BitmapHeaderSize: integer;  // size of header of bitmap
  
SourceIsTopDown: Boolean;  // is reversed bitmap ?
  
SourceBytesPerScanLine: integer;  // number of bytes per scanline
  
SourceLastScanLine: Extended;     // last scanline processes
  
SourceBandHeight: Extended;       //
  
BitmapInfo: PBITMAPINFO;
  img_start: integer;
  img_end: integer;
  img_numscans: integer;
  OffsetInFile: integer;
  OldHeight: Integer;
  bits: Pointer;
  CurrentTop: Integer;
  CurrentBottom: Integer;
begin
  
Result := False;

  // open the big bitmap
  
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

  // total size of bitmap
  
FileSize := Stream.Size;
  // read the header
  
Stream.ReadBuffer(bmf, SizeOf(TBITMAPFILEHEADER));
  // calculate header size
  
BitmapHeaderSize := bmf.bfOffBits - SizeOf(TBITMAPFILEHEADER);
  // calculate size of bitmap bits
  
ImageSize := FileSize - Integer(bmf.bfOffBits);
  // check for valid bitmap and exit if not
  
if ((bmf.bfType <> $4D42) or
    
(Integer(bmf.bfOffBits) < 1) or
    
(FileSize < 1) or (BitmapHeaderSize < 1) or (ImageSize < 1) or
    
(FileSize < (SizeOf(TBITMAPFILEHEADER) + BitmapHeaderSize + ImageSize))) then
  begin
    
Stream.Free;
    Exit;
  end;
  lpBitmapInfo := MyGetMem(BitmapHeaderSize);
  try
    
Stream.ReadBuffer(lpBitmapInfo^, BitmapHeaderSize);
    // check for uncompressed bitmap
    
if ((lpBitmapInfo^.bmiHeader.biCompression = BI_RLE4) or
      
(lpBitmapInfo^.bmiHeader.biCompression = BI_RLE8)) then
    begin
      
Exit;
    end;

    // bitmap dimensions
    
TotalBitmapWidth  := lpBitmapInfo^.bmiHeader.biWidth;
    TotalBitmapHeight := abs(lpBitmapInfo^.bmiHeader.biHeight);

    // is reversed order ?
    
SourceIsTopDown := (lpBitmapInfo^.bmiHeader.biHeight < 0);

    // calculate number of bytes used per scanline
    
SourceBytesPerScanLine := ((((lpBitmapInfo^.bmiHeader.biWidth *
      lpBitmapInfo^.bmiHeader.biBitCount) + 31) and not 31) div 8);

    // adjust buffer size
    
if BufferSize < Abs(SourceBytesPerScanLine) then
      
BufferSize := Abs(SourceBytesPerScanLine);

    // calculate number of scanlines for every pass on the destination bitmap
    
dest_MaxScans := round(BufferSize / abs(SourceBytesPerScanLine));
    dest_MaxScans := round(dest_MaxScans * (DestBitmap.Height / TotalBitmapHeight));

    if dest_MaxScans < 2 then
      
dest_MaxScans := 2;         // at least two scan lines

    // is not big enough ?
    
if dest_MaxScans > TotalBitmapHeight then
      
dest_MaxScans := TotalBitmapHeight;

    { count the number of passes needed to fill the destination bitmap }
    
dsty_top  := 0;
    NumPasses := 0;
    while (dsty_Top + dest_MaxScans) <= DestBitmap.Height do
    begin
      
Inc(NumPasses);
      Inc(dsty_top, dest_MaxScans);
    end;
    if NumPasses = 0 then Exit;

    // calculate scanlines on last pass
    
dest_Residual := DestBitmap.Height mod dest_MaxScans;

    // now calculate how many scanlines in source bitmap needed for every band on the destination bitmap
    
SourceBandHeight := (TotalBitmapHeight * (1 - (dest_Residual / DestBitmap.Height))) /
      NumPasses;

    // initialize first band
    
CurrentTop    := 0;
    CurrentBottom := dest_MaxScans;

    // a floating point used in order to not loose last scanline precision on source bitmap
    // because every band on target could be a fraction (not integral) on the source bitmap
    
SourceLastScanLine := 0.0;

    while CurrentTop < DestBitmap.Height do
    begin
      
// scanline start of band in source bitmap
      
img_start          := Round(SourceLastScanLine);
      SourceLastScanLine := SourceLastScanLine + SourceBandHeight;
      // scanline finish of band in source bitmap
      
img_end := Round(SourceLastScanLine);
      if img_end > TotalBitmapHeight - 1 then
        
img_end := TotalBitmapHeight - 1;
      img_numscans := img_end - img_start;
      if img_numscans < 1 then Break;
      OldHeight := lpBitmapInfo^.bmiHeader.biHeight;
      if SourceIsTopDown then
        
lpBitmapInfo^.bmiHeader.biHeight := -img_numscans
      else
        
lpBitmapInfo^.bmiHeader.biHeight := img_numscans;

      // memory used to read only the current band
      
bits := MyGetMem(Abs(SourceBytesPerScanLine) * img_numscans);

      try
        
// calculate offset of band on disk
        
OffsetInFile := TotalBitmapHeight - (img_start + img_numscans);
        Stream.Seek(Integer(bmf.bfOffBits) + (OffsetInFile * abs(SourceBytesPerScanLine)),
          soFromBeginning);
        Stream.ReadBuffer(bits^, abs(SourceBytesPerScanLine) * img_numscans);

        SetStretchBltMode(DestBitmap.Canvas.Handle, COLORONCOLOR);
        // now stretch the band readed to the destination bitmap
        
StretchDIBits(DestBitmap.Canvas.Handle,
          0,
          CurrentTop,
          DestBitmap.Width,
          Abs(CurrentBottom - CurrentTop),
          0,
          0,
          TotalBitmapWidth,
          img_numscans,
          Bits,
          lpBitmapInfo^,
          DIB_RGB_COLORS, SRCCOPY);
      finally
        
MyFreeMem(bits);
        lpBitmapInfo^.bmiHeader.biHeight := OldHeight;
      end;

      CurrentTop    := CurrentBottom;
      CurrentBottom := CurrentTop + dest_MaxScans;
      if CurrentBottom > DestBitmap.Height then
        
CurrentBottom := DestBitmap.Height;
    end;
  finally
    
Stream.Free;
    MyFreeMem(lpBitmapInfo);
  end;
  Result := True;
end;

// example of usage
procedure TForm1.Button1Click(Sender: TObject);
var
  
bmw, bmh: Integer;
  Bitmap: TBitmap;
begin
  
Bitmap := TBitmap.Create;
  with TOpenDialog.Create(nildo
    try
      
DefaultExt := 'BMP';
      Filter := 'Bitmaps (*.bmp)|*.bmp';
      Title := 'Define bitmap to display';
      if not Execute then Exit;
      { define the size of the required bitmap }
      
Bitmap.Width       := Self.ClientWidth;
      Bitmap.Height      := Self.ClientHeight;
      Bitmap.PixelFormat := pf24Bit;
      Screen.Cursor      := crHourglass;
      // use 100 KB of buffer
      
if not GetDIBInBands(FileName, Bitmap, 100 * 1024, bmw, bmh) then Exit;
      // original bitmap width = bmw
      // original bitmap height = bmh
      
Self.Canvas.Draw(0,0,Bitmap);
    finally
      
Free;
      Bitmap.Free;
      Screen.Cursor := crDefault;
    end;
end;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners