uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ExtCtrls;
type
TForm2 =
class(TForm)
OpenDialog1: TOpenDialog;
Panel1: TPanel;
Image1: TImage;
Button1: TButton;
ListBox1: TListBox;
CheckBox_autosize: TCheckBox;
CheckBox_stretched: TCheckBox;
CheckBox_proportional: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure CheckBox_autosizeClick(Sender: TObject);
procedure CheckBox_proportionalClick(Sender: TObject);
procedure CheckBox_stretchedClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FLargeBitmap : TBitmap;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
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;
/// <summary>
/// This code will fill a bitmap by stretching an image coming from a big
/// bitmap on disk. <br /><br />
/// </summary>
/// <param name="FileName">
/// Name of the uncompressed bitmap toread
/// </param>
/// <param name="DestBitmap">
/// Target bitmapwhere the bitmap on disk will be resampled
/// </param>
/// <param name="BufferSize">
/// The size of a memory buffer used for reading scanlines fromthe physical
/// bitmap on disk. <br />This value will decide how manyscanlines can be
/// read from disk at the same time, with always a <br />minimum value of 2
/// scanlines
/// </param>
/// <param name="Proportional">
/// Adjust the size of the des
/// </param>
/// <param name="TotalBitmapWidth">
/// nr. of pixels
/// </param>
/// <param name="TotalBitmapHeight">
/// nr. of pixels
/// </param>
/// <returns>
/// Will return false on error.
/// </returns>
function GetDIBInBands(
const FileName:
string;
DestBitmap: TBitmap; BufferSize: Integer; Proportional : Boolean;
out TotalBitmapWidth, TotalBitmapHeight: Integer): Boolean;
var
FileSize: int64;
// calculated file size
ImageSize: int64;
// calculated image size
dest_MaxScans: int64;
// number of scanline from source bitmap
dsty_top: int64;
// used to calculate number of passes
NumPasses: int64;
// number of passed needed
dest_Residual: int64;
// 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: int64;
// size of header of bitmap
SourceIsTopDown: Boolean;
// is reversed bitmap ?
SourceBytesPerScanLine: int64;
// number of bytes per scanline
SourceLastScanLine: Extended;
// last scanline processes
SourceBandHeight: Extended;
//
BitmapInfo: PBITMAPINFO;
img_start: int64;
img_end: int64;
img_numscans: int64;
OffsetInFile: int64;
OldHeight: int64;
bits: Pointer;
CurrentTop: int64;
CurrentBottom: int64;
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);
//
if Proportional
then
begin
DestBitmap.Height := Round( DestBitmap.Width * TotalBitmapHeight / TotalBitmapWidth );
end;
// 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;
procedure TForm2.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|Raw files (*.raw)|*.RAW';
Title := '
Define bitmap to display';
if not Execute
then Exit;
{ define the size of the required bitmap }
FLargeBitmap.Width := Self.ClientWidth;
FLargeBitmap.Height := Self.ClientHeight;
FLargeBitmap.PixelFormat := pf24Bit;
Screen.Cursor := crHourglass;
// use 100 KB of buffer
if not GetDIBInBands(FileName, FLargeBitmap, 100 * 1024, true, bmw, bmh)
then Exit;
ListBox1.Items.Add('
width :' + bmw.ToString);
ListBox1.Items.Add('
height:' + bmh.ToString);
// Self.Canvas.Draw(0,0,Bitmap);
image1.Picture.Bitmap.Assign(FLargeBitmap)
finally
Free;
Screen.Cursor := crDefault;
end;
end;
procedure TForm2.CheckBox_autosizeClick(Sender: TObject);
begin
image1.AutoSize := CheckBox_autosize.Checked;
end;
procedure TForm2.CheckBox_proportionalClick(Sender: TObject);
begin
image1.Proportional := CheckBox_proportional.Checked;
end;
procedure TForm2.CheckBox_stretchedClick(Sender: TObject);
begin
image1.Stretch := CheckBox_stretched.Checked;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
FLargeBitmap :=TBitmap.Create;
end;
end.