Как отбрасывать тень от текста?
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.
Взято из https://forum.sources.ru