var 
  FQuality: array[0..1] of byte = (NONANTIALIASED_QUALITY, DEFAULT_QUALITY); 
 
function SetFontAlias(Font: TFont; AntiAliasing: boolean): boolean; 
var 
  LogFont: TLogFont; 
begin 
  result := false; 
  try 
    if GetObject(Font.Handle, SizeOf(TLogFont), @LogFont) = 0 
      then exit; 
    LogFont.lfQuality := FQuality[ord(AntiAliasing)]; 
    Font.Handle := CreateFontIndirect(LogFont); 
    result := true; 
  except end; 
end; 
 
 
// Testbeispiel 
 
procedure TForm1.FormCreate(Sender: TObject); 
  function ChangFont(Image: TImage; AntiAliasing: boolean): boolean; 
  begin 
    with image.picture.bitmap do begin 
      width := 100; 
      height := 135; 
      with canvas do begin 
        brush.color := clyellow; 
        Font.color := clGreen; 
        Font.Style := [fsBold]; 
        Font.name := 'Arial'; 
        Font.size := 100; 
        fillrect(cliprect); 
        result := SetFontAlias(Font, AntiAliasing); 
        Textout(5, 5, 'Ä'); 
      end; 
    end; 
  end; 
begin 
  if not ChangFont(Image1, true) then showmessage('Fehler') 
  else 
    if not ChangFont(Image2, false) then showmessage('Fehler'); 
end;