Delphi-PRAXiS - TBitmap mit 50.000 x 50.000 pixel

mit diesem Code fragment aus dem Swiss Delphi center, kann ich zumindest schon mal große BMPs zur Anzeige bringen,
nachdem die Datentypen jetzt 64 bit breit sind
Delphi-Quellcode:
			
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.