Bug-fix for Delphi 3.x graphics.pas

The TBitmap.SetPixelFormat procedure of the Delphi 3.x graphics.pas unit leaks a palette handle each time a TBitmap is converted to pf8bit pixel format (8 bits/pixel).

One possible solution to this problem is to modify the TBitmap.SetPixelFormat procedure as indicated below.


  TBitmap.SetPixelFormat
Add the lines marked with red.
 
 
procedure TBitmap.SetPixelFormat(Value: TPixelFormat);
const
  BitCounts: array [pf1Bit..pf32Bit] of Byte = (1,4,8,16,16,24,32);
var
  DIB: TDIBSection;
  Pal: HPalette;
  DC: HDC;
  KillPal: Boolean;
begin
  if Value = GetPixelFormat then Exit;
  case Value of
    pfDevice:
      begin
        HandleType := bmDDB;
        Exit;
      end;
    pfCustom: InvalidGraphic(SInvalidPixelFormat);
  else
    FillChar(DIB, sizeof(DIB), 0);
    DIB.dsbm := FImage.FDIB.dsbm;
    KillPal := False;
    with DIB, dsbm, dsbmih do
    begin
      biSize := sizeof(DIB.dsbmih);
      biWidth := bmWidth;
      biHeight := bmHeight;
      biPlanes := 1;
      biBitCount := BitCounts[Value];
      Pal := 0;
      case Value of
        pf4Bit: Pal := SystemPalette16;
        pf8Bit:
          begin
            DC := GDICheck(GetDC(0));
            Pal := CreateHalftonePalette(DC);
            ReleaseDC(0, DC);
            KillPal := True;
          end;
        pf16Bit:
          begin
            biCompression := BI_BITFIELDS;
            dsBitFields[0] := $F800;
            dsBitFields[1] := $07E0;
            dsBitFields[2] := $001F;
          end;
      end;
      try
        NewImage(0, Pal, DIB, FImage.FOS2Format);
      finally
        if (KillPal) then
          DeleteObject(Pal);
      end;
      Changed(Self);
    end;
  end;
end;
 


Copyright © 1999 Anders Melander. All rights reserved.