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

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

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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com