Kod: Tümünü seç
procedure ChangeCleartype(canvas:Tcanvas;ClearType:boolean);
var
lf: TLogFont;
tf: TFont;
begin
tf := Tfont.create;
try
tf.Assign(canvas.font);
GetObject(tf.Handle, sizeof(lf), @lf);
if ClearType then
lf.lfQuality := DEFAULT_QUALITY
else
lf.lfQuality := NONANTIALIASED_QUALITY;
tf.Handle := CreateFontIndirect(lf);
canvas.font.assign(tf);
finally
tf.Free;
end;
end;