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

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

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
 SourceIsDown: 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;
  Current: 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 ?
  SourceIsDown := (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_ + 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
  Current := 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 Current < 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 SourceIsDown 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,
  Current,
  DestBitmap.Width,
  Abs(CurrentBottom - Current),
  0,
  0,
  TotalBitmapWidth,
  img_numscans,
  Bits,
  lpBitmapInfo^,
  DIB_RGB_COLORS, SRCCOPY);
  finally
  MyFreeMem(bits);
  lpBitmapInfo^.bmiHeader.biHeight := OldHeight;
  end;
  Current := CurrentBottom;
  CurrentBottom := Current + 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;
Взято с сайта: http://www.swissdelphicenter.ch

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...