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

Материал из DRKB


Вот ещё одну функцию обнаружил 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.


Author: Deni
Source: http://forum.sources.ru
ID: 03746