DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)

[turboPASCAL]

So, ich habe noch ein wenig an einer Unit gebastelt um die Funktion DrawShadowText ein
wenig Kompatibler / komfortabler zu machen.

Ich bitte mal darum die Unit zu testen und wer Vorschläge oder Verbesserungen hat, her damit.

Um die Funktion DrawShadowText zu nutzen ist Windows XP oder höher erforderlich,
weiterhin ist es notwendig das Windows XP Manifest mit in das Delphiprojekt einzubinden.
An sonnten gibt es nur einen Ersatzschatten.

Delphi-Quellcode:

{
  Unit ShadowText by Matthias G. aka turboPASCAL (tP)
  Version 1.0

  Diese Unit stellt die Funktion DrawShadowText aus der ComCtl32.dll
  zur Verfügung.

  Bei Windowsversionen unter XP oder ohne Windows XP Manifest wird eine
  Ersatzfunktion zum Darstellen des Schattens verwendet.
}

unit ShadowText;

interface

uses
  Windows, SysUtils, Graphics;

  var
    UseLQShadow : Boolean = True; // legt fest ob der alternative Schatten
                                  // verwendet werden soll wenn die Funktion
                                  // aus der ComCtl32.dll nicht zur Verfügung
                                  // steht

  // Ausgabe eines Textes mit Schatten über angabe von X und Y - Koordinaten
  function DrawShadowText(ACanvas: TCanvas; x, y: Integer; AText: string;
    TextColor, ShadowColor: TColor; ShadowSpaceX, ShadowSpaceY: Integer): Integer;

  // Ausgabe eines Textes mit Schatten über eine TRect- Struktur mit
  // angabe der Textformatierung (Textflags siehe Delphi-Hilfe "DrawText")
  function DrawShadowTextR(ACanvas: TCanvas; TextRect: TRect; x, y: Integer;
    AText: string; TextColor, ShadowColor: TColor;
    ShadowSpaceX, ShadowSpaceY: Integer; TextFlags: DWord): Integer;

implementation

type
  TDrawShadowTextI = function(hdc: HDC;
    pszText: LPCWSTR;
    cch: UINT;
    const pRect: PRect;
    dwFlags: DWORD;
    crText: COLORREF;
    crShadow: COLORREF;
    ixOffset: Integer;
    iyOffset: Integer): Integer; stdcall;

var
  hComCtl32DLL: THandle = 0;
  DrawShadowTextI: TDrawShadowTextI;
  OldCanvasColor: TColor;
  OldBkModeColor: Integer;

(*
// DrawShadowText aus der ComCtl32.dll ( erfordert das WindowsXP-Manifest! )
//////////////////////////////////////////////////////////////////////////////

function DrawShadowText_(hdc: HDC; pszText: LPCWSTR; cch: UINT;
   const pRect: PRect; dwFlags: DWORD; crText: COLORREF;
   crShadow: COLORREF; ixOffset: Integer;
   iyOffset: Integer): Integer; stdcall; external 'ComCtl32.dll' name 'DrawShadowText';
*)


// IsWindowsXPAndUp ermittelt ob eine Windowsversion ab WinXP vorhanden ist
// Verwendung intern der Unit
//////////////////////////////////////////////////////////////////////////////

function IsWindowsXPAndUp: Boolean;
begin
  Result := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) or (Win32MajorVersion > 5);
end;


// Rect - Die Funktion Rect erstellt aus Koordinaten eine TRect-Struktur
// Verwendung intern der Unit - no Unit Classes used
//////////////////////////////////////////////////////////////////////////////

function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
begin
  With Result do
  begin
    Left   := ALeft;
    Top    := ATop;
    Right  := ARight;
    Bottom := ABottom;
  end;
end;

// DrawShadowTextL (L - Low Quality)
// Verwendung intern der Unit
//////////////////////////////////////////////////////////////////////////////

function DrawShadowTextL(ACanvas: TCanvas; TextRect: TRect; AText: string;
  TextColor, ShadowColor: TColor; ShadowSpaceX,
  ShadowSpaceY: Integer; TextFlags: DWORD): Integer;
begin
  OldBkModeColor := SetBKMode(ACanvas.Handle, TRANSPARENT);
  OldCanvasColor := ACanvas.Font.Color;

  if UseLQShadow then
  begin
    inc(TextRect.Left, ShadowSpaceX);
    inc(TextRect.Top, ShadowSpaceY);
    inc(TextRect.Right, ShadowSpaceX);
    inc(TextRect.Bottom, ShadowSpaceY);

    ACanvas.Font.Color := ShadowColor;

    Result :=
      DrawText(ACanvas.Handle, PChar(AText), length(AText), TextRect, TextFlags);

    dec(TextRect.Left, ShadowSpaceX);
    dec(TextRect.Top, ShadowSpaceY);
    dec(TextRect.Right, ShadowSpaceX);
    dec(TextRect.Bottom, ShadowSpaceY);
  end else
    Result := 1;

  ACanvas.Font.Color := TextColor;

  Result := Result and
    DrawText(ACanvas.Handle, PChar(AText), length(AText), TextRect, TextFlags);

  ACanvas.Font.Color := OldCanvasColor;
  SetBKMode(ACanvas.Handle, OldBkModeColor);
end;

// DrawShadowText: für einfache Ausgabe
// Verwendung: export aus Unit
//////////////////////////////////////////////////////////////////////////////

function DrawShadowText(ACanvas: TCanvas; x, y: Integer; AText: string;
  TextColor, ShadowColor: TColor; ShadowSpaceX, ShadowSpaceY: Integer): Integer;
var TextRect: TRect;
begin
  TextRect := RECT(x, y, x + ACanvas.TextWidth(AText),
    y + ACanvas.TextHeight(AText));

  if @DrawShadowTextI <> nil then
  begin
    Result := DrawShadowTextI(ACanvas.Handle, PWideChar(WideString(AText)),
      length(AText), @TextRect, 0,
      COLORREF(TextColor), COLORREF(ShadowColor),
      ShadowSpaceX, ShadowSpaceY);
  end else
  begin
    Result := DrawShadowTextL(ACanvas, TextRect, AText,
      TextColor, ShadowColor, ShadowSpaceX, ShadowSpaceY, 0);
  end;
end;

// DrawShadowTextR: für formatierte Ausgabe  (R - Text[R]ect)
// Verwendung: export aus Unit
//////////////////////////////////////////////////////////////////////////////

function DrawShadowTextR(ACanvas: TCanvas; TextRect: TRect; x, y: Integer;
  AText: string; TextColor, ShadowColor: TColor;
  ShadowSpaceX, ShadowSpaceY: Integer; TextFlags: DWord): Integer;
begin
  if @DrawShadowTextI <> nil then
  begin
    Result := DrawShadowTextI(ACanvas.Handle, PWideChar(WideString(AText)),
      length(AText), @TextRect, TextFlags,
      COLORREF(TextColor), COLORREF(ShadowColor),
      ShadowSpaceX, ShadowSpaceY);
  end else
  begin
    Result := DrawShadowTextL(ACanvas, TextRect, AText,
      TextColor, ShadowColor, ShadowSpaceX, ShadowSpaceY, TextFlags);
  end;
end;


// Initialization der Unit
//////////////////////////////////////////////////////////////////////////////
initialization
  if IsWindowsXPAndUp then
  begin
    hComCtl32DLL := LoadLibrary('ComCtl32.dll');
    @DrawShadowTextI := GetProcAddress(hComCtl32DLL, 'DrawShadowText');
  end;

// Finalization der Unit
//////////////////////////////////////////////////////////////////////////////
finalization
  if hComCtl32DLL <> 0 then FreeLibrary(hComCtl32DLL);

end.