Как отбрасывать тень от текста
Материал из 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