Guest User

Untitled

a guest
Jan 24th, 2020
78
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2. {$IF NOT DEFINED(CLR)}
  3. procedure TBitmap.ReadDIB(Stream: TStream; ImageSize: LongWord; bmf: PBitmapFileHeader);
  4. const
  5.   DIBPalSizes: array [Boolean] of Byte = (SizeOf(TRGBQuad), SizeOf(TRGBTriple));
  6. var
  7.   DC, MemDC: HDC;
  8.   BitsMem: Pointer;
  9.   OS2Header: TBitmapCoreHeader;
  10.   BitmapInfo: PBitmapInfo;
  11.   ColorTable: Pointer;
  12.   HeaderSize: Integer;
  13.   OS2Format: Boolean;
  14.   BMHandle, OldBMP: HBITMAP;
  15.   DIB: TDIBSection;
  16.   Pal, OldPal: HPalette;
  17.   RLEStream: TStream;
  18.   vbmf: TBitmapFileHeader;
  19. {$IFDEF LINUX}
  20.   I: Integer;
  21. {$ENDIF}
  22. begin
  23.   Pal := 0;
  24.   BMHandle := 0;
  25.   RLEStream := nil;
  26.   Stream.Read(HeaderSize, SizeOf(HeaderSize));
  27.   OS2Format := HeaderSize = SizeOf(OS2Header);
  28.   if OS2Format then
  29.     HeaderSize := SizeOf(TBitmapInfoHeader);
  30.   GetMem(BitmapInfo, HeaderSize + 12 + 256 * SizeOf(TRGBQuad));
  31.   with BitmapInfo^ do
  32.   try
  33.     try
  34.       if OS2Format then  // convert OS2 DIB to Win DIB
  35.       begin
  36.         Stream.Read(Pointer(PByte(@OS2Header) + SizeOf(HeaderSize))^,
  37.           SizeOf(OS2Header) - SizeOf(HeaderSize));
  38.         FillChar(bmiHeader, SizeOf(bmiHeader), 0);
  39.         with bmiHeader, OS2Header do
  40.         begin
  41.           biWidth := bcWidth;
  42.           biHeight := bcHeight;
  43.           biPlanes := bcPlanes;
  44.           biBitCount := bcBitCount;
  45.         end;
  46.         Dec(ImageSize, SizeOf(OS2Header));
  47.       end
  48.       else
  49.       begin // support bitmap headers larger than TBitmapInfoHeader
  50.         Stream.Read(Pointer(PByte(BitmapInfo) + SizeOf(HeaderSize))^,
  51.           HeaderSize - SizeOf(HeaderSize));
  52.         Dec(ImageSize, HeaderSize);
  53.  
  54.         if (bmiHeader.biCompression <> BI_BITFIELDS) and
  55.           (bmiHeader.biCompression <> BI_RGB) then
  56.         begin // Preserve funky non-DIB data (like RLE) until modified
  57.           RLEStream := TMemoryStream.Create;
  58.           // source stream could be unidirectional.  don't reverse seek
  59.           if bmf = nil then
  60.           begin
  61.             FillChar(vbmf, SizeOf(vbmf), 0);
  62.             vbmf.bfType := $4D42;
  63.             vbmf.bfSize := ImageSize + Cardinal(HeaderSize);
  64.             bmf := @vbmf;
  65.           end;
  66.           RLEStream.Write(bmf^, SizeOf(bmf^));
  67.           RLEStream.Write(HeaderSize, SizeOf(HeaderSize));
  68.           RLEStream.Write(Pointer(PByte(BitmapInfo) + SizeOf(HeaderSize))^,
  69.             HeaderSize - SizeOf(HeaderSize));
  70.           RLEStream.CopyFrom(Stream, ImageSize);
  71.           { Cast ImageSize (long word) to integer to avoid integer overflow when negating. }
  72.           RLEStream.Seek(-Integer(ImageSize), soFromEnd);
  73.           Stream := RLEStream;  // the rest of the proc reads from RLEStream
  74.         end;
  75.       end;
  76.  
  77.       with bmiHeader do
  78.       begin
  79.         biSize := HeaderSize;
  80.         ColorTable := Pointer(PByte(BitmapInfo) + HeaderSize);
  81.  
  82.         { check number of planes. DIBs must be 1 color plane (packed pixels) }
  83.         if biPlanes <> 1 then InvalidBitmap;
  84.  
  85.         // 3 DWORD color element bit masks (ie 888 or 565) can precede colors
  86.         // TBitmapInfoHeader sucessors include these masks in the headersize
  87.         if (HeaderSize = SizeOf(TBitmapInfoHeader)) and
  88.           ((biBitCount = 16) or (biBitCount = 32)) and
  89.           (biCompression = BI_BITFIELDS) then
  90.         begin
  91.           Stream.ReadBuffer(ColorTable^, 3 * SizeOf(DWORD));
  92.           Inc(PByte(ColorTable), 3 * SizeOf(DWORD));
  93.           Dec(ImageSize, 3 * SizeOf(DWORD));
  94.         end;
  95.  
  96.         // Read the color palette
  97.         if biClrUsed = 0 then
  98.           biClrUsed := GetDInColors(biBitCount);
  99.  
  100.         if (biClrUsed * DIBPalSizes[OS2Format]) > (256 * SizeOf(TRGBQuad)) then
  101.           InvalidGraphic({$IFNDEF CLR}@{$ENDIF}SInvalidBitmap);
  102.  
  103.         Stream.ReadBuffer(ColorTable^, biClrUsed * DIBPalSizes[OS2Format]);
  104.         Dec(ImageSize, biClrUsed * DIBPalSizes[OS2Format]);
  105.  
  106.         // biSizeImage can be zero. If zero or RGB, compute the size.
  107.         if (biSizeImage = 0) or (biCompression = BI_RGB) then // top-down DIBs have negative height
  108.           biSizeImage := BytesPerScanLine(biWidth, biBitCount, 32) * Abs(biHeight);
  109.  
  110.         if biSizeImage < ImageSize then
  111.           ImageSize := biSizeImage;
  112.       end;
  113.  
  114.       { convert OS2 color table to DIB color table }
  115.       if OS2Format then RGBTripleToQuad(ColorTable^);
  116.  
  117.       DC := GDICheck(GetDC(0));
  118.       try
  119.         if ((bmiHeader.biCompression <> BI_RGB) and
  120.           (bmiHeader.biCompression <> BI_BITFIELDS)) or DDBsOnly then
  121.         begin
  122.           MemDC := 0;
  123.           GetMem(BitsMem, ImageSize);
  124.           try
  125.             Stream.ReadBuffer(BitsMem^, ImageSize);
  126.             MemDC := GDICheck(CreateCompatibleDC(DC));
  127.             OldBMP := SelectObject(MemDC, CreateCompatibleBitmap(DC, 1, 1));
  128.             OldPal := 0;
  129.             if bmiHeader.biClrUsed > 0 then
  130.             begin
  131.               Pal := PaletteFromDIBColorTable(0, ColorTable, bmiHeader.biClrUsed);
  132.               OldPal := SelectPalette(MemDC, Pal, False);
  133.               RealizePalette(MemDC);
  134.             end;
  135.  
  136.             try
  137.               BMHandle := CreateDIBitmap(MemDC, BitmapInfo^.bmiHeader, CBM_INIT, BitsMem,
  138.                 BitmapInfo^, DIB_RGB_COLORS);
  139.               if (BMHandle = 0) then
  140.                 if GetLastError = 0 then
  141.                   InvalidBitmap else RaiseLastOSError;
  142.             finally
  143.               if OldPal <> 0 then
  144.                 SelectPalette(MemDC, OldPal, True);
  145.               DeleteObject(SelectObject(MemDC, OldBMP));
  146.             end;
  147.           finally
  148.             if MemDC <> 0 then DeleteDC(MemDC);
  149.             FreeMem(BitsMem);
  150.           end;
  151.         end
  152.         else
  153.         begin
  154.           BMHandle := CreateDIBSection(DC, BitmapInfo^, DIB_RGB_COLORS, BitsMem, 0, 0);
  155.           if (BMHandle = 0) or (BitsMem = nil) then
  156.             if GetLastError = 0 then
  157.               InvalidBitmap else RaiseLastOSError;
  158.  
  159.           try
  160. {$IFDEF LINUX}
  161.             // I need to pre-touch the memory in 4096 byte increments to ensure
  162.             // the read will succeed. WINE marks this memory as not present to
  163.             // catch when we make changes to it. If we read directly into it
  164.             // Linux will (correctly) terminate the read with a failure since an
  165.             // exception occured during the read. We need to make sure these
  166.             // exceptions are triggered in user space instead of kernel.
  167.             for I := 1 to (ImageSize + 4095) div 4096 do
  168.               PByteArray(BitsMem)^[(I - 1) * 4096] := 0;
  169. {$ENDIF}
  170.             Stream.ReadBuffer(BitsMem^, ImageSize);
  171.           except
  172.             DeleteObject(BMHandle);
  173.             raise;
  174.           end;
  175.         end;
  176.       finally
  177.         ReleaseDC(0, DC);
  178.       end;
  179.       // Hi-color DIBs don't preserve color table, so create palette now
  180.       // 16 bit or more do not have a color palette.
  181.       if (bmiHeader.biBitCount > 8) and (bmiHeader.biBitCount <= 16) and
  182.          (bmiHeader.biClrUsed > 0) and (Pal = 0)then
  183.           Pal := PaletteFromDIBColorTable(0, ColorTable, bmiHeader.biClrUsed);
  184.       FillChar(DIB, SizeOf(DIB), 0);
  185.       GetObject(BMHandle, Sizeof(DIB), @DIB);
  186.       // GetObject / CreateDIBSection don't preserve these info values
  187.       DIB.dsBmih.biXPelsPerMeter := bmiHeader.biXPelsPerMeter;
  188.       DIB.dsBmih.biYPelsPerMeter := bmiHeader.biYPelsPerMeter;
  189.       DIB.dsBmih.biClrUsed := bmiHeader.biClrUsed;
  190.       DIB.dsBmih.biClrImportant := bmiHeader.biClrImportant;
  191.     except
  192.       RLEStream.Free;
  193.       raise;
  194.     end;
  195.   finally
  196.     FreeMem(BitmapInfo);
  197.   end;
  198.   NewImage(BMHandle, Pal, DIB, OS2Format, RLEStream);
  199.  
  200.   if (FImage.FDIB.dsBMIh.biBitCount = 32) and (FAlphaFormat = afDefined) then
  201.     PreMultiplyAlpha;
  202.  
  203.   PaletteModified := Palette <> 0;
  204.   Changed(Self);
  205. end;
  206. {$ENDIF}
RAW Paste Data