How to XOR a font on a bitmap canvas

Problem/Question/Abstract:

How to XOR a font on a bitmap canvas

Answer:

Write the text to a (temporary) bitmap and copyrect that to the image:

procedure XORText(sheet: TCanvas; x, y: Integer; text: string);
var
  bmp: TBitmap;
  r1, r2: TRect;
begin
  bmp := TBitmap.create;
  try
    with sheet do
    begin
      bmp.Width := textWidth(text);
      bmp.height := textheight(text);
      r1 := rect(0, 0, bmp.Width, bmp.Height);
      r2 := Rect(x, y, x + bmp.Width, y + bmp.Height);
      bmp.canvas.font.assign(font);
      bmp.canvas.brush.color := clBlack;
      bmp.Canvas.fillrect(r1);
      bmp.canvas.brush.style := bsClear;
      bmp.canvas.textout(0, 0, text);
      copymode := cmSrcInvert;
      copyrect(r2, bmp.canvas, r1);
    end;
  finally
    bmp.free;
  end;
end;