Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007
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;

Взято с сайта: https://www.swissdelphicenter.ch