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

Previous  Top  Next

    
 

 

Code:

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;

©Drkb::03780

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