Delphi-PRAXiS
Seite 3 von 3     123   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi DrawShadowText in Delphi (commctrl.h/ComCtl32.dll) (https://www.delphipraxis.net/66678-drawshadowtext-delphi-commctrl-h-comctl32-dll.html)

turboPASCAL 15. Apr 2006 19:51

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
:gruebel: Also TA_CENTER und VTA_CENTER wollen nicht so...

// Edit:

Ne, also die Parameter sind wohl doch etwas anders, für dwFlags eingesetzte Werte von 0 .. 2
sind:

0: normal (rechts oben)
1: center text oben
2: links oben


Die Parameter von MSDN-Library durchsuchenDrawText passen anscheinend besser. ;)

MagicAndre1981 15. Apr 2006 19:59

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
wo hast du die Werte her? Im PSDK hab ich nix dazu gefunden.

Delphi-Freak 15. Apr 2006 20:05

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
Oder sind das gleich die Werte von DrawText mit DT_ (DT_LEFT, DT_CENTER, DT_RIGHT AND DT_TOP, DT_VCENTER, DT_BOTTOM)?

LG, ich

turboPASCAL 15. Apr 2006 20:11

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
Guckt mal Post #21. :mrgreen:

Und kein roter Kasten nicht ... :gruebel:

Delphi-Freak 15. Apr 2006 20:40

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
Nein, irgendwie kein roter Kasten :gruebel: (ich glaube dazu kann man nicht zu blöd sein, oder doch :mrgreen: )
Aber danke, jedenfalls...

LG, ich

turboPASCAL 29. Apr 2006 08:53

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
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.

turboPASCAL 7. Mai 2006 12:36

Re: DrawShadowText in Delphi (commctrl.h/ComCtl32.dll)
 
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


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:39 Uhr.
Seite 3 von 3     123   

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz