DrawDisk procedure

[DelphiGuy]

I'm working with this rather popular DrawDisk procedure which pretty much anti-aliases a circle and draws it, filling it and the background in the process. At the moment the procedure call only lets you modify the background color of the WHOLE canvas and the fill color of the line. Have a look:

procedure DrawDisk(Bitmap: TBitmap; CenterX, CenterY, Radius,
  Feather: single);
// Draw a disk on Bitmap. Bitmap must be a 256 color (pf8bit)
// palette bitmap, and parts outside the disk will get palette
// index 0, parts inside will get palette index 255, and in the
// antialiased area (feather), the pixels will get values
// inbetween.
// ***Parameters***
// Bitmap:
//   The bitmap to draw on
// CenterX, CenterY:
//   The center of the disk (float precision). Note that [0, 0]
//   would be the center of the first pixel. To draw in the
//   exact middle of a 100x100 bitmap, use CenterX = 49.5 and
//   CenterY = 49.5
// Radius:
//   The radius of the drawn disk in pixels (float precision)
// Feather:
//   The feather area. Use 1 pixel for a 1-pixel antialiased
//   area. Pixel centers outside 'Radius + Feather / 2' become
//   0, pixel centers inside 'Radius - Feather/2' become 255.
//   Using a value of 0 will yield a bilevel image.
// Copyright (c) 2003 Nils Haeck M.Sc. www.simdesign.nl
var
  x, y: integer;
  LX, RX, LY, RY: integer;
  Fact: integer;
  RPF2, RMF2: single;
  P: PByteArray;
  SqY, SqDist: single;
  sqX: array of single;
begin
  // Determine some helpful values (singles)
  RPF2 := sqr(Radius + Feather/2);
  RMF2 := sqr(Radius - Feather/2);
 
  // Determine bounds:
  LX := Max(floor(CenterX - RPF2), 0);
  RX := Min(ceil (CenterX + RPF2), Bitmap.Width - 1);
  LY := Max(floor(CenterY - RPF2), 0);
  RY := Min(ceil (CenterY + RPF2), Bitmap.Height - 1);
 
  // Optimization run: find squares of X first
  SetLength(SqX, RX - LX + 1);
  for x := LX to RX do
    SqX[x - LX] := sqr(x - CenterX);
 
  // Loop through Y values
  for y := LY to RY do begin
    P := Bitmap.Scanline[y];
    SqY := Sqr(y - CenterY);
    // Loop through X values
    for x := LX to RX do begin
 
      // determine squared distance from center for this pixel
      SqDist := SqY + SqX[x - LX];
 
      // inside inner circle? Most often..
      if sqdist < RMF2 then begin
        // inside the inner circle.. just give the scanline the
        // new color
        P[x] := 255
      end else begin
        // inside outer circle?
        if sqdist < RPF2 then begin
          // We are inbetween the inner and outer bound, now
          // mix the color
          Fact := round(((Radius - sqrt(sqdist)) * 2 / Feather)
            * 127.5 + 127.5);
          // just in case limit to [0, 255]
          P[x] := Max(0, Min(Fact, 255));
        end else begin
          P[x] := 0;
        end;
      end;
    end;
  end;
end

The problem is that I want the circumference line to be a different color from the fill color of the circle . I presume I have to change something where the comment is "// inside the inner circle.. just give the scanline the new color" but the problem is I haven't worked with Palettes and Scanline before so I don't know how to do it and since this procedure deletes and replaces EVERY pixel in the bitmap I can't find a easy workaround either, I'm going to have to edit the procedure but I don't know how to. Can someone help me change the color inside the circle and still keep the anti-aliasing.

[pritaeas]

If you change it, you will have to extend the "inbetween" code. Now it aliases between the two colours (line and fill). If you want add a third colour, you'll have to adapt the code depending on which side/colour is closest. I'll have a go at it later, but I cannot promise a result.

[DelphiGuy]

Alright thanks mate, I don't think I have the knowledge to modify additional anti-aliasing in this :S

[DelphiGuy]

Just to further help you out, the colors of the disk are defined by using a palette like this:

LineCol := ColorToRGB(clRed);
  Re2 := GetRValue(LineCol);
  Gr2 := GetGValue(LineCol);
  Bl2 := GetBValue(LineCol);
  BackCol := ColorToRGB(clBtnFace);
  Re1 := GetRValue(BackCol);
  Gr1 := GetGValue(BackCol);
  Bl1 := GetBValue(BackCol);
  ABitmap := TBitmap.Create;
  Try
    ABitmap.PixelFormat := pf8bit;

    ABitmap.Width := Image1.Width;
    ABitmap.Height := Image1.Height;

    GetMem(pal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 255);
    Try
      pal.palVersion := $300;
      pal.palNumEntries := 256;
      LineCol := RGB(Re2, Gr2, Bl2);
      BackCol := RGB(Re1, Gr1, Bl1);

      For I := 0 To 255 Do
        Begin
          pal.palPalEntry[i].peRed   := round(i / 255 * (LineCol        AND $FF) + (255 - i) / 255 * (BackCol        AND $FF));
          pal.palPalEntry[i].peGreen := round(i / 255 * (LineCol shr 8  AND $FF) + (255 - i) / 255 * (BackCol shr 8  AND $FF));
          pal.palPalEntry[i].peBlue  := round(i / 255 * (LineCol shr 16 AND $FF) + (255 - i) / 255 * (BackCol shr 16 AND $FF));
        End;

      hpal := CreatePalette(pal^);
      If hpal <> 0 Then ABitmap.Palette := hpal;

    Finally
      FreeMem(pal);
    End;

    For Y := 0 to ABitmap.Height - 1 Do FillChar(ABitmap.Scanline[Y]^, ABitmap.Width, 0);

    ACenterX   := StrToFloat('100');
    ACenterY   := StrToFloat('100');
    ARadius    := StrToFloat('50');
    ALineWidth := StrToFloat('1');
    AFeather   := StrToFloat('1');

    DrawDisk(ABitmap, ACenterX, ACenterY, ARadius, AFeather);
    
    ABitmap.PixelFormat := pf32bit; //Convert back to normal format so normal Delphi canvas colours work
    Image1.Picture.Bitmap.Assign(ABitmap);
 Finally
    ABitmap.Free;
 End;

Once the palette is defined then the procedure is called