Загружать большие битовые изображения с небольшим использованием памяти

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(nil) do
 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;
Source: http://www.swissdelphicenter.ch
ID: 03780
Category:Графика
Category:Bitmap