Added: X2UtGraphics unit

X2UtGraphics.pas

@@ -0,0 +1,140 @@
+{
+  :: X2UtGraphics contains various graphics-related functions.
+  ::
+  :: Last changed:    $Date$
+  :: Revision:        $Rev$
+  :: Author:          $Author$
+}
+unit X2UtGraphics;
+
+interface
+uses
+  Classes,
+  Controls,
+  Graphics;
+
+  {
+    :$ Applies anti-aliasing to a font.
+
+    :: Sets the font quality to it's maximum value, causing Windows 2000 and
+    :: above to draw the font anti-aliased.
+  }
+  procedure AAFont(const AFont: TFont);
+
+  {
+    :$ Applies anti-aliasing to a control's font.
+
+    :: Sets the font quality to it's maximum value, causing Windows 2000 and
+    :: above to draw the font anti-aliased.
+  }
+  procedure AAControl(const AControl: TControl);
+
+  {
+    :$ Applies anti-aliasing to all child controls.
+
+    :: Sets the font quality to it's maximum value, causing Windows 2000 and
+    :: above to draw the font anti-aliased. If ARecursive is set to True,
+    :: all children's children will be processed as well.
+  }
+  procedure AAChildren(const AParent: TWinControl;
+                       const ARecursive: Boolean = False);
+
+  {
+    :$ Applies anti-aliasing to all owned controls.
+
+    :: Sets the font quality to it's maximum value, causing Windows 2000 and
+    :: above to draw the font anti-aliased.
+  }
+  procedure AAOwned(const AOwner: TComponent);
+
+
+implementation
+uses
+  SysUtils,
+  Windows;
+
+type
+  { Explanation of sneaky hack:
+
+      Normally, protected members are available only in either the unit in which
+      the class is declared, or any descendants. Using this fact, we create a
+      descendant of the class and use the descendant in the same class, thus
+      we are able to access the protected properties...
+  }
+  THackControl  = class(TControl);
+
+
+procedure AAFont;
+var
+  pFont:      TLogFont;
+  hAAFont:    HFONT;
+
+begin
+  // Use AFont as a starting point...
+  with pFont do begin
+    lfHeight          := AFont.Height;
+    lfWidth           := 0;
+    lfEscapement      := 0;
+    lfOrientation     := 0;
+
+    if fsBold in AFont.Style then
+      lfWeight        := FW_BOLD
+    else
+      lfWeight        := 0;
+
+    // These are actually booleans, but implemented as bytes for some reason
+    lfItalic          := Byte(fsItalic in AFont.Style);
+    lfUnderline       := Byte(fsUnderline in AFont.Style);
+    lfStrikeOut       := 0;
+    lfCharSet         := DEFAULT_CHARSET;
+    lfOutPrecision    := OUT_DEFAULT_PRECIS;
+    lfClipPrecision   := CLIP_DEFAULT_PRECIS;
+
+    // This is what causes the anti-aliasing
+    lfQuality         := ANTIALIASED_QUALITY;
+
+    lfPitchAndFamily  := DEFAULT_PITCH;
+    StrPCopy(lfFaceName, AFont.Name);
+  end;
+
+  // Create the font
+  hAAFont := CreateFontIndirect(pFont);
+
+  // Assign it to the control
+  AFont.Handle  := hAAFont;
+end;
+
+procedure AAControl;
+var
+  pControl:     THackControl;
+
+begin
+  pControl              := THackControl(AControl);
+  AAFont(pControl.Font);
+end;
+
+procedure AAChildren;
+var
+  iControl:       Integer;
+
+begin
+  for iControl  := 0 to AParent.ControlCount - 1 do
+  begin
+    AAControl(AParent.Controls[iControl]);
+
+    if ARecursive and (AParent.Controls[iControl] is TWinControl) then
+      AAChildren(TWinControl(AParent.Controls[iControl]), True);
+  end;
+end;
+
+procedure AAOwned;
+var
+  iControl:       Integer;
+
+begin
+  for iControl  := 0 to AOwner.ComponentCount - 1 do
+    if AOwner.Components[iControl] is TControl then
+      AAControl(TControl(AOwner.Components[iControl]));
+end;
+
+end.