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

[turboPASCAL]

So, und damit man die Funktion auch ohne die VCL nutzen kann hab ich schnell noch eine
nonVLC - Version geschrieben. ( für die Tippfaulen )

Delphi-Quellcode:

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

  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 ShadowTextN;

interface

uses
  Windows;

  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(DC: HDC; x, y: Integer; AText: string;
    TextColor, ShadowColor: COLORREF; ShadowSpaceX, ShadowSpaceY: Integer): Integer;

  // Ausgabe eines Textes mit Schatten über eine TRect- Struktur mit
  // angabe der Textformatierung (Textflags siehe Delphi-Hilfe "DrawText")
  function DrawShadowTextR(DC: HDC; TextRect: TRect; x, y: Integer;
    AText: string; TextColor, ShadowColor: COLORREF;
    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;

(*
// Declaration der Funktion 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;
var
  dwWindowsMajorVersion,
  dwWindowsMinorVersion,
  dwVersion: DWORD;
begin
  dwVersion := GetVersion;
  dwWindowsMajorVersion := LOBYTE(LOWORD(dwVersion));
  dwWindowsMinorVersion := HIBYTE(LOWORD(dwVersion));

  Result := ((dwWindowsMajorVersion = 5) and
             (dwWindowsMinorVersion >= 1)) or (dwWindowsMajorVersion > 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(DC: HDC; TextRect: TRect; AText: string;
  TextColor, ShadowColor: longint; ShadowSpaceX,
  ShadowSpaceY: Integer; TextFlags: DWORD): Integer;
var
  OldTextColor: COLORREF;
  OldBkMode: Integer;
begin
  OldBkMode    := SetBKMode(DC, TRANSPARENT);
  OldTextColor := GetTextColor(DC);

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

    SetTextColor(DC, ShadowColor);

    Result :=
      DrawText(DC, 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;

  SetTextColor(DC, TextColor);

  Result := Result and
    DrawText(DC, PChar(AText), length(AText), TextRect, TextFlags);

  SetBKMode(DC, OldBkMode);
  SetTextColor(DC, OldTextColor);
end;

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

function DrawShadowText(DC: HDC; x, y: Integer; AText: string;
  TextColor, ShadowColor: COLORREF; ShadowSpaceX, ShadowSpaceY: Integer): Integer;
var
  TextSize: TSize;
  TextRect: TRect;
begin
  GetTextExtentPoint(DC, PChar(AText), Length(AText), TextSize);
  TextRect := RECT(x, y, x + TextSize.cx, y + TextSize.cy);

  // TextColor-Bug umgehen
  if TextColor = $00000000 then TextColor := $00010101;

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

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

function DrawShadowTextR(DC: HDC; TextRect: TRect; x, y: Integer;
  AText: string; TextColor, ShadowColor: COLORREF;
  ShadowSpaceX, ShadowSpaceY: Integer; TextFlags: DWord): Integer;
begin
  // TextColor-Bug umgehen
  if TextColor = $00000000 then TextColor := $00010101;

  if @DrawShadowTextI <> nil then
  begin
    Result := DrawShadowTextI(DC, PWideChar(WideString(AText)),
      length(AText), @TextRect, TextFlags,
      TextColor, ShadowColor,
      ShadowSpaceX, ShadowSpaceY);
  end else
  begin
    Result := DrawShadowTextL(DC, 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. // End of Unit ShadowTextN