paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

richmemo: added support for subscript and superscript. win32 implementation

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4068 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2015-03-27 13:52:05 +00:00
parent 132cc4c0ff
commit 214b9bdbda
2 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/richmemo/richmemo.pas
View File

@ -29,6 +29,8 @@ uses
, Graphics, StdCtrls, LazUTF8;
type
TVScriptPos = (vpNormal, vpSubScript, vpSuperScript);
TFontParams = record
Name : String;
Size : Integer;
@ -36,6 +38,7 @@ type
Style : TFontStyles;
HasBkClr : Boolean;
BkColor : TColor;
VScriptPos : TVScriptPos;
end;
TParaAlignment = (paLeft, paRight, paCenter, paJustify);

31
components/richmemo/win32/win32richmemoproc.pas
View File

@ -205,6 +205,11 @@ const
PFNS_NEWNUMBER = $8000;
PFNS_SOMESEPCHAR = PFNS_PARENS or PFNS_PERIOD or PFNS_PLAIN;
const
// this is the list of CHARFORMAT attributes that RichMemo supports
CFM_RICHMEMO_ATTRS = CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS
or CFM_SUBSCRIPT or CFM_SUBSCRIPT or CFM_BACKCOLOR;
implementation
@ -263,6 +268,19 @@ begin
if Effects and CFE_UNDERLINE > 0 then Include(Result, fsUnderline);
end;
function VScriptPosToEffects(vpos: TVScriptPos): LongWord;
const
EffMask : array [TVScriptPos] of LongWord = (0, CFE_SUBSCRIPT, CFE_SUPERSCRIPT);
begin
Result:=EffMask[vpos];
end;
function EffectsToVScriptPost(Effects: LongWord): TVScriptPos;
begin
if Effects and CFE_SUBSCRIPT > 0 then Result:=vpSubScript
else if Effects and CFE_SUBSCRIPT > 0 then Result:=vpSuperScript
else Result:=vpNormal;
end;
procedure CharFormatToFontParams(const fmt: TCHARFORMAT; var Params: TIntFontParams);
begin
@ -281,6 +299,7 @@ begin
if fmt.cbSize > sizeof(CHARFORMAT) then begin
Params.HasBkClr:=(fmt.dwEffects and CFE_AUTOBACKCOLOR) = 0;
if Params.HasBkClr then Params.Color:=Params.Color;
Params.VScriptPos:=EffectsToVScriptPost(fmt.dwEffects);
end;
end;
@ -329,8 +348,8 @@ begin
fmt.dwMask := fmt.dwMask or CFM_SIZE;
fmt.yHeight := Params.Size * TwipsInFontSize;
fmt.dwMask := fmt.dwMask or CFM_EFFECTS;
fmt.dwEffects := FontStylesToEffects(Params.Style);
fmt.dwMask := fmt.dwMask or CFM_EFFECTS or CFM_SUBSCRIPT or CFM_SUPERSCRIPT;
fmt.dwEffects := FontStylesToEffects(Params.Style) or VScriptPosToEffects(Params.VScriptPos);
if Params.HasBkClr then begin
fmt.dwMask := fmt.dwMask or CFM_BACKCOLOR;
@ -357,8 +376,8 @@ begin
FillChar(fmt, sizeof(fmt), 0);
fmt.cbSize := sizeof(fmt);
fmt.dwMask := CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS or CFM_BACKCOLOR;
fmt.dwMask := CFM_RICHMEMO_ATTRS;
SendMessage(RichEditWnd, EM_GETCHARFORMAT, w, PtrInt(@fmt));
CharFormatToFontParams(fmt, Params);
@ -383,8 +402,8 @@ var
last : Integer;
const
ALL_MASK = CFM_BOLD or CFM_ITALIC or CFM_STRIKEOUT or CFM_UNDERLINE or
CFM_SIZE or CFM_COLOR or CFM_FACE;
ALL_MASK = CFM_RICHMEMO_ATTRS;
begin
Result := false;
if (RichEditWnd = 0) then Exit;