Load Oversize Bitmap

function GetMem(Size: DWORD): Pointer;
begin
  Result := Pointer(GlobalAlloc(GPTR, Size));
end;

procedure FreeMem(p: Pointer);
begin
  if p = nil then Exit;
  GlobalFree(THandle(p));
end;

function GetDIBInBands(const FileName: string;
  DestBitmap: TBitmap; BufferSize: Integer;
  out TotalBitmapWidth, TotalBitmapHeight: Integer): Boolean;
var
  FileSize: integer;
  ImageSize: integer;
  dest_MaxScans: integer;
  dsty_top: Integer;
  NumPasses: integer;
  dest_Residual: integer;
  Stream: TStream;
  bmf: TBITMAPFILEHEADER;
  lpBitmapInfo: PBITMAPINFO;
  BitmapHeaderSize: integer;
  SourceIsTopDown: Boolean;
  SourceBytesPerScanLine: integer;
  SourceLastScanLine: Extended;
  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;
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  FileSize := Stream.Size;
  Stream.ReadBuffer(bmf, SizeOf(TBITMAPFILEHEADER));
  BitmapHeaderSize := bmf.bfOffBits - SizeOf(TBITMAPFILEHEADER);
  ImageSize := FileSize - Integer(bmf.bfOffBits);
  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 := GetMem(BitmapHeaderSize);
  try
    Stream.ReadBuffer(lpBitmapInfo^, BitmapHeaderSize);
    if ((lpBitmapInfo^.bmiHeader.biCompression = BI_RLE4) or
      (lpBitmapInfo^.bmiHeader.biCompression = BI_RLE8)) then
    begin
      Exit;
    end;
    TotalBitmapWidth  := lpBitmapInfo^.bmiHeader.biWidth;
    TotalBitmapHeight := abs(lpBitmapInfo^.bmiHeader.biHeight);

    SourceIsTopDown := (lpBitmapInfo^.bmiHeader.biHeight < 0);

    SourceBytesPerScanLine := ((((lpBitmapInfo^.bmiHeader.biWidth *
      lpBitmapInfo^.bmiHeader.biBitCount) + 31) and not 31) div 8);

    if BufferSize < Abs(SourceBytesPerScanLine) then
      BufferSize := Abs(SourceBytesPerScanLine);

    dest_MaxScans := round(BufferSize / abs(SourceBytesPerScanLine));
    dest_MaxScans := round(dest_MaxScans * (DestBitmap.Height / TotalBitmapHeight));

    if dest_MaxScans < 2 then
      dest_MaxScans := 2;

    if dest_MaxScans > TotalBitmapHeight then
      dest_MaxScans := TotalBitmapHeight;

    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;
    dest_Residual := DestBitmap.Height mod dest_MaxScans;
    SourceBandHeight := (TotalBitmapHeight * (1 - (dest_Residual / DestBitmap.Height))) /
      NumPasses;

    CurrentTop    := 0;
    CurrentBottom := dest_MaxScans;
    SourceLastScanLine := 0.0;

    while CurrentTop < DestBitmap.Height do
    begin
      img_start          := Round(SourceLastScanLine);
      SourceLastScanLine := SourceLastScanLine + SourceBandHeight;
      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;

      bits := GetMem(Abs(SourceBytesPerScanLine) * img_numscans);

      try
        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);
        StretchDIBits(DestBitmap.Canvas.Handle,
          0,
          CurrentTop,
          DestBitmap.Width,
          Abs(CurrentBottom - CurrentTop),
          0,
          0,
          TotalBitmapWidth,
          img_numscans,
          Bits,
          lpBitmapInfo^,
          DIB_RGB_COLORS, SRCCOPY);
      finally
        FreeMem(bits);
        lpBitmapInfo^.bmiHeader.biHeight := OldHeight;
      end;

      CurrentTop    := CurrentBottom;
      CurrentBottom := CurrentTop + dest_MaxScans;
      if CurrentBottom > DestBitmap.Height then
        CurrentBottom := DestBitmap.Height;
    end;
  finally
    Stream.Free;
    FreeMem(lpBitmapInfo);
  end;
  Result := True;
end;

Beispiel :

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 := 'Load Oversize Bitmap to Form';
      if not Execute then Exit;
      Bitmap.Width       := Self.ClientWidth;
      Bitmap.Height      := Self.ClientHeight;
      Bitmap.PixelFormat := pf24Bit;
      Screen.Cursor      := crHourglass;
      if not GetDIBInBands(FileName, Bitmap, 100 * 1024, bmw, bmh) then Exit;
      Self.Canvas.Draw(0,0,Bitmap);
    finally
      Free;
      Bitmap.Free;
      Screen.Cursor := crDefault;
    end;
end;