Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как отбрасывать тень от текста?

01.01.2007

Вот ещё одну функцию обнаружил DrawShadowText(...), которая позволяет отбрасывать тень от текста на hdc контексте. Большой минус состоит в том, что она появилась только в XP. Чтобы пример заработал, нужно в системной директории найти новую версию библиотеки comctl32.dll и скопировать её в папку с примером. У меня эта библиотека лежала в папке C:\WINDOWS\WinSxS\x86_Microsoft.Windows.Common-Controls_6595b64144ccf1df_6.0.0.0_x-ww_1382d70a

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls;
 
 
type
  TShadowText = function (dc       : HDC;
                          pszText  : PWideChar;
                          cch      : DWORD;
                          prc      : PRECT;
                          dwFlags  : DWORD;
                          crText   : TColor;
                          crShadow : TColor;
                          ixOffset : integer;
                          iyOffset : integer):integer;stdcall;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    TB_PosX: TTrackBar;
    TB_PosY: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure TB_PosXChange(Sender: TObject);
    procedure TB_PosYChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    lib           : THandle;
    DrawShadowText: TShadowText;
    procedure ShadowText;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  lib:=LoadLibrary(PChar(GetCurrentDir+'\comctl32.dll'));
  if lib=0 then
     begin
       MessageBox(Handle, 'Библиотеки нет...', '!', MB_OK or MB_ICONERROR);
       exit;
     end;
  @DrawShadowText:=GetProcAddress(lib, 'DrawShadowText');
  if @DrawShadowText=nil then
     begin
       FreeLibrary(lib);
       MessageBox(Handle, 'Функции нет... не та библиотека!', '!', MB_OK or MB_ICONERROR);
       exit;
     end;
  ShadowText;
end;
 
procedure TForm1.ShadowText;
var
  rect          : TRECT;
  text          : PWChar;
begin
  if @DrawShadowText=nil then exit;
  text:='forum.sources.ru'+#13+'самый лучший форум';
  Image1.Canvas.Brush.Color:=clWhite;
  Image1.Canvas.FillRect(Image1.ClientRect);
  rect.Left:=Image1.Width div 10;
  rect.Top:=Image1.Height div 4;
  rect.Right:=Image1.Width;
  rect.Bottom:=Image1.Height;
  Image1.Canvas.Font.Size:=20;
  Image1.Canvas.Font.Style:=Image1.Canvas.Font.Style+[fsBold];
  Image1.Canvas.Font.Name:='Times New Roman';
  DrawShadowText(Image1.Canvas.Handle,
                 text,
                 Length(text),
                 @rect,
                 1,                                                //-> центрировать текст
                 clRed,
                 clBlack,
                 TB_PosX.Position,
                 TB_PosY.Position);
end;
 
procedure TForm1.TB_PosXChange(Sender: TObject);
begin
  ShadowText();
end;
 
procedure TForm1.TB_PosYChange(Sender: TObject);
begin
  ShadowText();
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if lib<>0 then FreeLibrary(lib);
end;
 
end.

Автор: Deni

Взято из https://forum.sources.ru