Графика в Delphi - примеры задач на построение графиков, а также компоненты для графики

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

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;

Powered WP Ъ скачать delphi, delphi 7, скачать delphi 7, delphi файлы, delphi, компоненты, delphi 2009, delphi программы, delphi бесплатно, delphi скачать, бесплатно работа delphi, delphi создание, delphi строки, программирования delphi, borland delphi, delphi формы