l(*
Компонент позволяющий отображать формулы (наследник от TCustomLabel).Возможности: вывод греческих символов, вывод специальных математических символов (в пределах фонта Symbol, использование верхних и нижних индексов, но не одновременно, выравнивание выводимой формулы по вертикали и горизонтали, смена начертания внутри формулы. Для задания формулы используется текст свойства Caption. Формула описывается в текстовом режиме.
Зарезервированные символы
<пробел>, '\', '^','_', '}','{'.
Для вывода зарезервированных символов необходимо использовать их совместно с
символом \. Например для вывода пробела ипользуется \<пробел>,
правая фигурная скобка\}. Символы {} зарезервированы для дальнейшнго
расширения.
Символы греческого алфавита и спецсимволы:
\Delta, \Downarrow, \Gamma, \Lambda, \LeftArrow,
\Leftrightarrow, \Omega, \RightArrow, \Phi, \Pi,
\Psi, \Sigma, \Theta, \Uparrow, \Upsilon,
\Xi, \alpha, \angle, \approx, \beta,
\bullet, \cap, \cdot, \chi, \cong,
\delta, \diamond, \div, \downarrow, \epsilon,
\equiv, \eta, \gamma, \ge, \gets,
\in, \infinity, \iota, \kappa, \lambda,
\le, \mu, \ne, \notin, \nu,
\omega, \oplus, \oslash, \otimes, \partial,
\perp, \phi, \pi, \pm, \psi,
\rho, \sigma, \subset, \subseteq, \supset,
\tau, \theta, \times, \to, \uncup,
\uparrow, \upsilon, \varepsilon, \varphi, \varpi,
\varsigma, \vee, \wedge, \xi, \zeta.
Для задания верхних и нижних идексов используются символы ^ и _ соответственно.
Для смены начертания символов
\it -- италика (курсив)
\bl -- bold (жирный)
\ul -- underline (подчеркнутый)
\st -- strike (перечеркнутый)
\rm -- отмена смены начертания
Недостатки: невозможность использовать струтурные скобки {}
работа только на одной базовой линии (нельзя использовать \frac) и т.д.
Да и нельзя реализовать TeX в 20-30 строках кода.
Примеры:
S=\pi R^2 -- площадь круга
С_2 H_5 OH -- OН и есть
\Delta \phi = 0 уравнение Пуассона
*)
unit MathLabel;
interface
uses
Windows, Messages, SysUtils, Graphics, Classes, Controls, StdCtrls;
type
TAlignH=(taLeftJustifyH, taRightJustifyH, taCenterH, taAutoH);
TAlignV=(taTopJustifyV, taDownJustifyV, taCenterV, taAutoV);
TMathLabel = class(TCustomLabel)
private
FontList:TList;
FAlignH:TAlignH;
FAlignV:TAlignV;
FOldText:string;
RectText:TRect;
procedure ClearFontList;
procedure FillFontList;
procedure SetAlignH(Value:TAlignH);
procedure SetAlignV(Value:TAlignV);
protected
procedure PrepareDrawText;
procedure DoDrawText(var Rect: TRect; Flags: Longint);override;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property Caption;
property Font;
property AlignH:TAlignH read FAlignH write SetAlignH;
property AlignV:TAlignV read FAlignV write SetAlignV;
end;
implementation
uses Math;
Type
TCharSymbol=(
s__Delta, s__Downarrow, s__Gamma, s__Lambda, s__LeftArrow,
s__Leftrightarrow, s__Omega, s__RightArrow, s__Phi, s__Pi,
s__Psi, s__Sigma, s__Theta, s__Uparrow, s__Upsilon, s__Xi,
s_alpha, s_angle, s_approx, s_beta, s_bullet, s_cap,
s_cdot, s_chi, s_cong, s_delta, s_diamond, s_div,
s_downarrow, s_epsilon, s_equiv, s_eta, s_gamma,
s_ge, s_gets, s_in, s_infinity, s_iota, s_kappa,
s_lambda, s_le, s_mu, s_ne, s_notin, s_nu, s_omega,
s_oplus, s_oslash, s_otimes, s_partial, s_perp, s_phi,
s_pi, s_pm, s_psi, s_rho, s_sigma, s_subset,
s_subseteq, s_supset, s_tau, s_theta, s_times,s_to,
s_uncup, s_uparrow, s_upsilon, s_varepsilon, s_varphi,
s_varpi, s_varsigma, s_vee, s_wedge, s_xi, s_zeta
);
const
ArrNameSymbol:array[Ord(s__Delta)..Ord(s_zeta)] of string=
('Delta', 'Downarrow', 'Gamma', 'Lambda', 'LeftArrow',
'Leftrightarrow', 'Omega', 'RightArrow', 'Phi', 'Pi',
'Psi', 'Sigma', 'Theta', 'Uparrow', 'Upsilon', 'Xi',
'alpha', 'angle', 'approx', 'beta', 'bullet', 'cap',
'cdot', 'chi', 'cong', 'delta', 'diamond', 'div',
'downarrow', 'epsilon', 'equiv', 'eta', 'gamma',
'ge', 'gets', 'in', 'infinity', 'iota', 'kappa',
'lambda', 'le', 'mu', 'ne', 'notin', 'nu', 'omega',
'oplus', 'oslash', 'otimes', 'partial', 'perp', 'phi',
'pi', 'pm', 'psi', 'rho', 'sigma', 'subset',
'subseteq', 'supset', 'tau', 'theta', 'times','to',
'uncup', 'uparrow', 'upsilon', 'varepsilon', 'varphi',
'varpi', 'varsigma', 'vee', 'wedge', 'xi', 'zeta');
ArrCodeCharSymbol:array[Ord(s__Delta)..Ord(s_zeta)] of byte=
($44, $DF, $47, $4C, $DC, $DB, $57, $DE, $46, $50, $52, $53, $51,
$DD, $A1, $58, $61, $D0, $BB, $62, $B7, $C7, $D7, $63, $40, $64,
$E0, $B8, $AF, $65, $BA, $68, $67, $B3, $AC, $CE, $A5, $69, $6B,
$6C, $A3, $6D, $B9, $CF, $6E, $77, $C5, $C6, $C4, $B6, $5E, $66,
$70, $B1, $79, $72, $73, $CC, $CD, $C9, $74, $71, $B4, $AE, $C8,
$AD, $75, $65, $6A, $76, $56, $DA, $D9, $78, $74);
const
Blank =[#9, #10, #13, ' '];
Special=['\', '^','_', '}','{'];
LatLetter=['A'..'z']-Special;
CyrLetter=['А'..'я'];
Digits =['!'..'@'];
type
TToken=(toEnd, toUpIndex, toDownIndex, toMacros, toOpenBraces,
toCloseBraces, toString);
function GetToken(var Str, SubStr:string; var StPos, EnPos:integer):TToken;
begin
SubStr:='';
if Str[StPos]=#0 then begin Result:=toEnd; Exit; end;
while Str[StPos] in Blank do Inc(StPos);
EnPos:=StPos;
case Str[EnPos] of
'_',
'^':begin
if Str[EnPos]='_' then Result:=toDownIndex else Result:=toUpIndex;
Inc(EnPos);
while Str[EnPos] in LatLetter+CyrLetter+Digits do Inc(EnPos);
SubStr:=Copy(Str, StPos+1, EnPos-(StPos+1));
end;
'\':begin
Inc(EnPos); Result:=toMacros;
if Str[EnPos] in Blank then begin SubStr:=' '; Inc(EnPos);Exit; end;
if Str[EnPos] in Special then begin SubStr:=Str[EnPos]; Inc(EnPos);Exit; end;
while Str[EnPos] in LatLetter+CyrLetter+Digits do Inc(EnPos);
SubStr:=Copy(Str, StPos+1, EnPos-(StPos+1));
end;
'{':begin Inc(EnPos); Result:=toOpenBraces; end;
'}':begin Inc(EnPos); Result:=toCloseBraces; end;
else
begin
if Str[EnPos] in Special then
begin SubStr:=Copy(Str, StPos, EnPos-StPos); Result:=toString; Exit; end;
while Str[EnPos] in LatLetter+CyrLetter+Digits do Inc(EnPos);
SubStr:=Copy(Str, StPos, EnPos-StPos);
Result:=toString;
end;
end;
end;
function IsMathSymbol(Name:string; var CodeSymbol:byte):boolean;
var M, N, K : integer;
begin
M:=Ord(s__Delta); N:=Ord(s_zeta);
while M<=N do
begin
K:=M+(N-M) div 2;
if Name=ArrNameSymbol[K] then
begin
IsMathSymbol:=true;
CodeSymbol:=ArrCodeCharSymbol[K];
Exit
end
else if Name>ArrNameSymbol[K] then M:=K+1 else N:=K-1;
end;
IsMathSymbol:=false
end;
type
TRecFont=class
HF:HFont;
LF:TLogFont;
Token:TToken;
SubStr:string; {подстрока выводимая с параметрами LF}
S:TSize; {размер прямоугольника ограничивающего подстроку}
DBLine:integer; {Смещение по вертикали относительно базой линии строки}
end;
constructor TMathLabel.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FontList:=TList.Create;
AutoSize:=false;
end;
destructor TMathLabel.Destroy;
begin
ClearFontList;
FontList.Free;
inherited Destroy;
end;
procedure TMathLabel.ClearFontList;
var RF:TRecFont;
begin
while FontList.Count>0 do
begin
RF:=FontList.Items[0];
DeleteObject(RF.HF);
FontList.Delete(0);
end;
end;
procedure TMathLabel.FillFontList;
const cBlank:PChar=' ';
var Text, SubStr: string;
RecFont:TRecFont;
Token:TToken;
StPos, EnPos:integer;
CodeSymbol:byte;
LogFont:TLogFont;
sBlank : PChar absolute cBlank;
DC:HDC;
function HeightIndex(fnHeight:integer):integer;
{высота Font-а для подсточных и надстрочных индексов}
begin
Result:=-Max(1, Round(0.6*Abs(fnHeight)));
end;
function UpShift(fnHeight:integer):integer;
{вертикальный сдвиг отностительно базовой линии для надстрочного индекса}
begin
Result:=-Max(1, Round(0.2*Abs(fnHeight)));
end;
function DownShift(fnHeight:integer):integer;
{вертикальный сдвиг отностительно базовой линии для подстрочного индекса}
begin
Result:=Max(1, Round(0.4*Abs(fnHeight)));
end;
begin
Text:=Caption+#0; StPos:=1;
DC:=Canvas.Handle;
GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
ClearFontList;
while true do
begin
Token:=GetToken(Text, SubStr, StPos, EnPos);
if Token=toEnd then Break;
case Token of
toUpIndex,
toDownIndex:
begin
RecFont:=TRecFont.Create;
RecFont.LF:=LogFont;
RecFont.LF.lfHeight:=HeightIndex(RecFont.LF.lfHeight);
RecFont.HF:=CreateFontIndirect(RecFont.LF);
RecFont.SubStr:=SubStr;
if Token=toUpIndex then RecFont.DBLine:=UpShift(LogFont.lfHeight)
else RecFont.DBLine:=DownShift(LogFont.lfHeight);
SelectObject(DC, RecFont.HF);
GetTextExtentPoint32(DC, PChar(SubStr), Length(SubStr), RecFont.S);
FontList.Add(RecFont);
end;
toMacros:
begin
if IsMathSymbol(SubStr, CodeSymbol) then
begin
RecFont:=TRecFont.Create;
RecFont.LF:=LogFont;
RecFont.LF.lfFaceName:='Symbol';
RecFont.HF:=CreateFontIndirect(RecFont.LF);
RecFont.SubStr:=Char(CodeSymbol);
SelectObject(DC, RecFont.HF);
GetTextExtentPoint32(DC, @CodeSymbol, 1, RecFont.S);
FontList.Add(RecFont);
end
else if (Length(SubStr)=1)and(SubStr[1] in ([' ']+Special)) then
begin
RecFont:=TRecFont.Create;
RecFont.LF:=LogFont;
RecFont.HF:=CreateFontIndirect(RecFont.LF);
RecFont.DBLine:=DownShift(LogFont.lfHeight);
RecFont.SubStr:=SubStr;
SelectObject(DC, RecFont.HF);
GetTextExtentPoint32(DC, sBlank, 1, RecFont.S);
FontList.Add(RecFont);
end
else if SubStr='it' then LogFont.lfItalic:=1
else if SubStr='bl' then LogFont.lfWeight:=700
else if SubStr='st' then LogFont.lfStrikeOut:=1
else if SubStr='ul' then LogFont.lfUnderline:=1
else if SubStr='rm' then
begin
LogFont.lfWeight:=400; LogFont.lfItalic:=0;
LogFont.lfUnderline:=0; LogFont.lfStrikeOut:=0;
end;
end;
toOpenBraces:;
toCloseBraces:;
toString:
begin
RecFont:=TRecFont.Create;
RecFont.LF:=LogFont;
RecFont.HF:=CreateFontIndirect(LogFont);
RecFont.SubStr:=SubStr;
SelectObject(DC, RecFont.HF);
GetTextExtentPoint32(DC, PChar(SubStr), Length(SubStr), RecFont.S);
FontList.Add(RecFont);
end;
end;
StPos:=EnPos;
end;
end;
procedure TMathLabel.SetAlignH(Value:TAlignH);
begin
if FAlignH<>Value then
begin FAlignH:=Value; Invalidate; end;
end;
procedure TMathLabel.SetAlignV(Value:TAlignV);
begin
if FAlignV<>Value then
begin FAlignV:=Value; Invalidate; end;
end;
procedure TMathLabel.PrepareDrawText;
var RecFont:TRecFont;
I:integer;
begin
{ if FOldText<>Caption then}
begin
ClearFontList;
FillFontList;
FillChar(RectText, SizeOf(TRect), #0);
for I:=0 to FontList.Count-1 do
begin
RecFont:=FontList.Items[I];
RectText.Right:=RectText.Right+RecFont.S.cX;
if RectText.Top<RecFont.S.cY then RectText.Top:=RecFont.S.cY;
if RectText.Bottom>RecFont.DBLine then RectText.Bottom:=RecFont.DBLine;
end;
end;
FOldText:=Caption;
end;
procedure TMathLabel.CMTextChanged(var Message: TMessage);
begin
PrepareDrawText;
Invalidate;
{Realign;}
end;
procedure TMathLabel.CMFontChanged(var Message: TMessage);
begin
PrepareDrawText;
Invalidate;
{ Realign;}
end;
procedure TMathLabel.DoDrawText(var Rect: TRect; Flags: Longint);
var I, X, Y, YY:integer;
RecFont:TRecFont;
FAlig:Cardinal;
DC:HDC;
begin
{ PrepareDrawText;}
Canvas.Brush.Color:=Color;
Rect:=ClientRect;
DC:=Canvas.Handle;
FAlig:=GetTextAlign(DC);
SetTextAlign(DC, TA_NOUPDATECP);
case FAlignV of
taAutoV :begin
Height:=RectText.Top; Rect.Bottom:=RectText.Bottom;
YY:=0;
end;
taTopJustifyV:YY:=0;
taDownJustifyV:YY:=Rect.Bottom-RectText.Top;
taCenterV :YY:=(Rect.Bottom-(RectText.Top-RectText.Bottom)) div 2;
end;
case FAlignH of
taAutoH :begin
Width:=RectText.Right; Rect.Right:=RectText.Right;
end;
taLeftJustifyH :X:=0;
taRightJustifyH:X:=Rect.Right-RectText.Right;
taCenterH :X:=(Rect.Right-RectText.Right) div 2;
end;
Canvas.FillRect(Rect);
for I:=0 to FontList.Count-1 do
begin
RecFont:=FontList.Items[I];
SelectObject(DC,RecFont.HF);
Y:=YY+RecFont.DBLine;
Windows.TextOut(DC, X, Y, PChar(RecFont.SubStr), Length(RecFont.SubStr));
X:=X+RecFont.S.cX;
Windows.MoveToEx(DC, X, Y, nil);
end;
SetTextAlign(DC, FAlig);
end;
end.
