BitmapCanvasList not unlocked

Description

Reported by Robert Frahm; checked by Stefan Hoffmeister

Two procedures in 'Graphics.pas' are missing a call to 'BitmapCanvasList.UnlockList'.
This bug will cause VCL graphics functions, which have not been called from the main thread, to hang. They cannot lock 'BitmapCanvasList' because the main thread never unlocks it.

Solution / workaround

There is no alternative to modifying 'Graphics.pas' (please note the implications for Delphi 3 package support). Change these two procedures:

procedure FreeMemoryContexts;
var
  I: Integer;
begin
  with BitmapCanvasList.LockList do
  begin
{$IFDEF FixFreeUnlockList}
    try
{$ENDIF}
      for I := Count-1 downto 0 do
      with TBitmapCanvas(Items[I]) do
        if TryLock then
        try
          FreeContext;
        finally
          Unlock;
        end;
{$IFDEF FixFreeUnlockList}
    finally
      BitmapCanvasList.UnLockList;
    end
{$ENDIF}
  end;
end;

...

procedure DeselectBitmap(AHandle: HBITMAP);
var
  I: Integer;
begin
  if AHandle = 0 then Exit;
  with BitmapCanvasList.LockList do
{$IFDEF FixDeselectBMPUnlockList}
  try
{$ENDIF}
    for I := Count - 1 downto 0 do
      with TBitmapCanvas(Items[I]) do
        if (FBitmap <> nil) and
           (FBitmap.FImage.FHandle
= AHandle) then
          FreeContext;
{$IFDEF FixDeselectBMPUnlockList}
  finally
    BitmapCanvasList.UnLockList;
  end
{$ENDIF}
end;

There's a bug in the "ByteSwapColors" procedure of the Delphi 3 graphics.pas unit. "ByteSwapColors" is used various places in graphics.pas to convert an array of RGB values (TPaletteEntry) to BGR values (TRGBQuad) and vice versa. The problem is that the first entry of the array is never converted.

Description

Reported by Anders Bo Melander; checked by Reinier Sterkenburg

The problem does not exist in versions of Delphi prior to 3.0 since they use a different method to convert between RGB and BGR.
The following procedure should produce a small red bitmap, but the resulting bitmap turns out to be blue instead because the first palette entry isn't converted from RGB to BGR.

procedure RedBitmap;
var
  hPal                  : HPalette;
  Pal                   : TMaxLogPalette;
  i                     : Integer;
  Bitmap                : TBitmap;
begin
  // Create a 16 color palette - all entries red
  Pal.palVersion := $300;
  Pal.palNumEntries := 16;
  for i := 0 to Pal.palNumEntries-1 do
    with Pal.palPalEntry[i] do
    begin
      peRed := 255;
      peGreen := 0;
      peBlue := 0;
      peFlags := 0;
    end;
  hPal := CreatePalette(PLogPalette(@Pal)^);

  // Create a bitmap
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := 50;
    Bitmap.Height := 50;
    Bitmap.PixelFormat := pf8bit;

    // Assign red palette to bitmap
    Bitmap.Palette := hPal;

    // Save bitmap
    Bitmap.SaveToFile('red.bmp');
  finally
    Bitmap.Free;
  end;
end;

The following is the ByteSwapColors() procedure. As far as I have been able to tell, the problem is caused by the method used to test for end of loop. I have marked the offending line below with "*** WRONG ***".

// convert RGB to BGR and vice-versa.  TRGBQuad <-> TPaletteEntry
procedure ByteSwapColors(var Colors; Count: Integer);
var
  SysInfo: TSystemInfo;
begin
  GetSystemInfo(SysInfo);
  asm
        MOV   EDX, Colors
        MOV   ECX, Count
        DEC   ECX
        JS    @@END
        LEA   EAX, SysInfo
        CMP   [EAX].TSystemInfo.wProcessorLevel, 3
        JE    @@386
  @@1:  MOV   EAX, [EDX+ECX*4]
        BSWAP EAX
        SHR   EAX,8
        MOV   [EDX+ECX*4],EAX
        DEC   ECX
//      JNZ   @@1   *** WRONG ***
        JNS   @@1 // Much better!
        JMP   @@END
  @@386:
        PUSH  EBX
  @@2:  XOR   EBX,EBX
        MOV   EAX, [EDX+ECX*4]
        MOV   BH, AL
        MOV   BL, AH
        SHR   EAX,16
        SHL   EBX,8
        MOV   BL, AL
        MOV   [EDX+ECX*4],EBX
        DEC   ECX
//      JNZ   @@2   *** WRONG ***
        JNS   @@2 // Much better!
        POP   EBX
    @@END:
  end;
end;

Solution / workaround

The offending lines should be replaced by

        JNS   @@1

and

        JNS   @@2

respectively.
The same correction has been made by Borland in the 3.01/3.02 versions of Delphi.

A bitmap handle is leaked every time a TBitmap opens a RLE encoded bitmap.

Description

Reported by David Willis; checked by Anders Melander

To reproduce, test attached program using Memory Sleuth. A RLE bitmap is included. A memory leak occurs in TBitmap.ReadDIB. A handle is leaked every time Button1 is clicked which leads to "out of resources" over time in a graphical application. If you resave RleBitmap.bmp in straight RGB format, leak does not occur.
Here's the test program: Test465.zip

Solution / workaround

To fix, you must edit TBitmap.ReadDIB in GRAPHICS.PAS as follows. (David Willis also provided a fix; because of the shortness and nice formatting Anders' solution is shown; RPS)
Changes to the original source are marked red.

procedure TBitmap.ReadDIB(Stream: TStream; ImageSize: LongWord);
const
  DIBPalSizes: array [Boolean] of Byte = (sizeof(TRGBQuad), sizeof(TRGBTriple));
var
...
  DIB: TDIBSection;
  Pal, OldPal: HPalette;
  OldHandle: HGDIOBJ;
begin
  Pal := 0;
  Stream.Read(HeaderSize, sizeof(HeaderSize));
  OS2Format := HeaderSize = sizeof(OS2Header);
  if OS2Format then HeaderSize := sizeof(TBitmapInfoHeader);
  GetMem(BitmapInfo, HeaderSize + 12 + 256 * sizeof(TRGBQuad));
...
    DC := GDICheck(GetDC(0));
    try
      if (bmiHeader.biCompression = BI_RLE8)
        or (bmiHeader.biCompression = BI_RLE4) or DDBsOnly then
      begin
        MemDC := 0;
        GetMem(BitsMem, ImageSize);
        try
          Stream.ReadBuffer(BitsMem^, ImageSize);
          MemDC := GDICheck(CreateCompatibleDC(DC));
          OldHandle := SelectObject(MemDC, CreateCompatibleBitmap(DC, 1, 1));
          try
            OldPal := 0;
            if bmiHeader.biClrUsed > 0 then
            begin
              Pal := PaletteFromDIBColorTable(0, ColorTable, bmiHeader.biClrUsed);
              OldPal := SelectPalette(MemDC, Pal, False);
              RealizePalette(MemDC);
            end;

            try
              BMHandle := CreateDIBitmap(MemDC, BitmapInfo^.bmiHeader, CBM_INIT, BitsMem,
                BitmapInfo^, DIB_RGB_COLORS);
              if (BMHandle = 0) then
                if GetLastError = 0 then InvalidBitmap else
                RaiseLastWin32Error;
            finally
              if OldPal <> 0 then
                SelectPalette(MemDC, OldPal, True);
            end;
          finally
            DeleteObject(SelectObject(MemDC, OldHandle));
          end;
        finally
          if MemDC <> 0 then DeleteDC(MemDC);
          FreeMem(BitsMem);
        end;
...
end;

There's a bug with the Palette of TBitmap: it displays a random background colour when Transparent = True

Description

Reported by Brian Lowe; checked by Chris Rankin

A Delphi 3 bug has been confirmed by Borland [but not fixed in the Delphi 3 update release]. It is a palette bug in TBitmap. It manifests as strange colors in TImage when Transparent = True, but only on some bitmaps. It also causes problems when using TCanvas.BrushCopy on some bitmaps. The bitmaps which illustrate the problem are 256 color or greater and have colors in palette locations 8 - 15 which are different from palette entries 248 - 255. In other words, to NOT have this problem, the bitmap must contain the last 8 system colors in palette locations 8 - 15.
The attached bitmap (zipped; 2.59 kb) has the problem; load it into a Delphi 3 TImage and set Transparent := True to see it.
Note from the checker:
When you load this bitmap, the parts of the form visible behind the image appear to be cyan. Turning transparency off turns these areas back to the default form colour.

There's a palette handle leak in certain cases when PixelFormat is set to pf8bit.

Description

Reported by borland.public.delphi.graphics; fix by Greg Chapman

There was a thread in this group back in December about GDI palettes not being freed by the JPEG unit. A fix for one bug was posted by Xavier Pacheco, but a second bug, which occurs when the JPEG's PixelFormat = pf8Bit, did not have a fix posted. I would like to propose a temporary fix here (a permanent fix requires modifying the VCL Graphics unit). The leak occurs in the TJPEGImage.GetBitmap method in cases in which the newly allocated FBitmap's PixelFormat is set to pf8Bit. In TBitmap.SetPixelFormat, the pf8Bit parameter will result in a call to CreateHalftonePalette, which returns a newly allocated GDI palette which is then passed to TBitmap.CopyImage. CopyImage creates a new TBitmapImage for the bitmap, and, in so doing, it creates a new copy of the passed in palette (through the call to CopyPalette). The problem is that the original copy (allocated in SetPixelFormat) is never freed.

Solution / workaround

As far as I can tell, there is no way to fix this palette leak without modifying the Graphics unit (and thus forcing oneself to do without packages). However, the leak can be limited to one palette per application by adding the following routine to the JPEG unit:

var pf8BitBitmap: TBitmap = nil;

procedure Set8BitPixelFormat(ABitmap: TBitmap);
begin
  if not Assigned(pf8BitBitmap) then begin
    pf8BitBitmap:= TBitmap.Create;
    pf8BitBitmap.PixelFormat:= pf8Bit;
  end;
  ABitmap.Assign(pf8BitBitmap);
end;

Then change the TJPEGImage.GetBitmap routine as follows:

       // Set the bitmap pixel format
      FBitmap.Handle := 0;
      if (PixelFormat = jf8Bit) or (jc.d.out_color_space = JCS_GRAYSCALE) then
// FBitmap.PixelFormat := pf8bit {causes palette leak}
        Set8BitPixelFormat(FBitmap)
      else
        FBitmap.PixelFormat := pf24bit;

Finally, include a call to pf8BitBitmap.Free in the unit's finalization section.

RLE (Run Length Encoded) bitmaps loaded in a TImage are not displayed correctly. Furthermore, viewing a form with such an image as text and then as form again can make the IDE crash silently.

Description

Reported by David Willis; checked by Anders Melander

To reproduce:

1. Create a new project.
2. Put a TImage on the form.
3. Load a RLE-encoded bitmap.
4. Run the program: First scanline(s) appear(s) mangled
5. Stop the program
6. Right click on the form -> View as text
7. Right click on the editor window - > View as form
   at this point there is either an error in the first scanlines of the picture or the IDE crashes (disappears).

To make the IDE crash more likely repeat steps 4-5.
Note from RPS: I didn't get the IDE to crash in Delphi 4 anymore but the 'first scanline problem' is still there.

What I figured out for the moment is, that there is an error in the streaming procedures for DIB's. At some point the image size may get negative, (because the stored image data is smaller than the unpacked image) and this error is not detected by the VCL. But this cannot be the whole story because the bug appears regardless of the image size. I'm not sure if the error appears with EVERY bitmap but I have found it for all the bitmaps I tested.

While the Style and the Color properties of TBrush should be independent, if you set the Style of a TBrush to bsClear, it also changes the Color to clWhite, and changing the Color of a TBrush will change the Style to bsSolid if it was bsClear.

Description

Reported by Alistair Ward; not checked independently

If you set the style of a TBrush to bsClear, it also changes the Color to clWhite. Changing the Color of a TBrush will change the Style to bsSolid if it was bsClear.
These properties should be independent. The Windows SDK specifically states that if a brush is set to style BS_NULL (bsClear in Delphi) then the color will be ignored. There is no need for Delphi to change it.
This behaviour is a nuisance if you are drawing a series of shapes (in the same color) and want some to be filled and others to be clear. The workaround is that you must set the brush colour for each shape that is to be filled, rather than just setting/resetting the brush style.

Solution / workaround

This could be easily fixed by removing the offending lines of code from TBrush.SetColor and TBrush.SetStyle in GRAPHICS.PAS.

The documentation for TCanvas.Pixels doesn't mention that -1 can be returned as result.

Description

Reported by Frank Heyne and Stefan Hoffmeister

The documentation for TCanvas.Pixels fails to mention that the result of a "Canvas.Pixels" MAY be -1, implying that the coordinate queried is not within the clipping area or the device does not support this operation. In particular this will affect the TPaintBox component during a redraw (OnPaint). Code relying on Canvas.Pixels returning always a valid RGB colour will fail. A runtime error indicating this erroneous situation will only occur if range checking has been enabled ({$R+}).

Solution / workaround

Either make sure that the coordinate that is queried for colour information is always within the clipping area and the device has these capability or (preferrably) test the value returned by Canvas.Pixel:

  with PaintBox1.Canvas do
  begin
    theColour := Pixels[0, 0];
    if theColour <> -1 then { inside clipping area }
    begin
      { valid value in theColour }
      Pixels[0, 0] := theColour;
    end
    { else ... }
  end;

The property access method SetWidth has a bug, when using a screen resolution with Large Fonts.

Description

Reported by Reinier Sterkenburg

When your screen is configured in a high resolution with Large Fonts, setting the size of a TMetafile object makes its width too large.
This is caused by the fact that in the SetWidth method of TMetafile, a division by 96 is done, where the expression should be divided by Screen.PixelsPerInch (which has a value of 96 in many cases, but it can also be 120 for example when you use a screen resolution with Large Fonts).

Solution / workaround

When you have the VCL source, change the line (unit Graphics, procedure TMetafile.SetWidth)

      Value := MulDiv(Value, FInch, 96);

to

      Value := MulDiv(Value, FInch, Screen.PixelsPerInch);

Metafile.SetHeight and TMetafile.SetWidth have scaling errors (by a factor of 10)

Description

Reported by Tjarko de Jong; checked by Reinier Sterkenburg

The conversion factors between inch and 0.01 mm in the procedures TMetafile.SetHeight and TMetafile.SetWidth are incorrect. The value is used 25400 in stead of 2540.

The error is in the Graphics.pas file code, at the end of TMetafile.SetHeight:

      MMHeight := MulDiv(Value, 25400, ScreenLogPixels);

and at the end of TMetafile.SetWidth:

      MMWidth := MulDiv(Value, 25400, ScreenLogPixels);

An inch is 25.4 mm = 25.4*100 = 2540 hundreths of mm.