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

richmemo: background color

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3808 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2014-11-28 21:18:38 +00:00
parent 88e2799ba5
commit 5f2a5fd8f8
2 changed files with 61 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
components/richmemo/richmemo.pas
View File

@ -28,10 +28,12 @@ uses
type
TFontParams = record
Name : String;
Size : Integer;
Color : TColor;
Style : TFontStyles;
Name : String;
Size : Integer;
Color : TColor;
Style : TFontStyles;
HasBkClr : Boolean;
BkColor : TColor;
end;
TParaAlignment = (paLeft, paRight, paCenter, paJustify);
@ -58,7 +60,7 @@ type
NumIndent : Double;
end;
TTextModifyMask = set of (tmm_Color, tmm_Name, tmm_Size, tmm_Styles);
TTextModifyMask = set of (tmm_Color, tmm_Name, tmm_Size, tmm_Styles, tmm_BackColor);
TParaModifyMask = set of (pmm_FirstLine, pmm_HeadIndent, pmm_TailIndent, pmm_SpaceBefore, pmm_SpaceAfter, pmm_LineSpacing);
TSearchOption = (soMatchCase, soWholeWord, soBackward);
@ -113,7 +115,9 @@ type
procedure SetTextAttributes(TextStart, TextLen: Integer; AFont: TFont);
procedure SetRangeColor(TextStart, TextLength: Integer; FontColor: TColor);
procedure SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
const FontName: String; FontSize: Integer; FontColor: TColor; AddFontStyle, RemoveFontStyle: TFontStyles);
const FontName: String; FontSize: Integer; FontColor: TColor; AddFontStyle, RemoveFontStyle: TFontStyles); overload;
procedure SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
const fnt: TFontParams; AddFontStyle, RemoveFontStyle: TFontStyles); overload;
procedure SetRangeParaParams(TextStart, TextLength: INteger; ModifyMask: TParaModifyMask;
const ParaMetric: TParaMetric);
@ -384,8 +388,6 @@ end;
function TCustomRichMemo.GetParaAlignment(TextStart: Integer;
var AAlign: TParaAlignment): Boolean;
var
ac: Integer;
begin
Result := HandleAllocated and
TWSCustomRichMemoClass(WidgetSetClass).GetParaAlignment(Self, TextStart, AAlign);
@ -506,6 +508,19 @@ end;
procedure TCustomRichMemo.SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
const FontName: String; FontSize: Integer; FontColor: TColor; AddFontStyle, RemoveFontStyle: TFontStyles);
var
fnt : TFontParams;
begin
InitFontParams(fnt);
fnt.Name:=FontName;
fnt.Size:=FontSize;
fnt.Color:=FontColor;
SetRangeParams(TextStart, TextLength, ModifyMask, fnt, AddFontStyle, RemoveFontStyle);
end;
procedure TCustomRichMemo.SetRangeParams(TextStart, TextLength: Integer;
ModifyMask: TTextModifyMask; const fnt: TFontParams; AddFontStyle,
RemoveFontStyle: TFontStyles);
var
i : Integer;
j : Integer;
@ -521,11 +536,14 @@ begin
while i < j do begin
GetTextAttributes(i, p);
if tmm_Name in ModifyMask then p.Name := FontName;
if tmm_Color in ModifyMask then p.Color := FontColor;
if tmm_Size in ModifyMask then p.Size := FontSize;
if tmm_Name in ModifyMask then p.Name := fnt.Name;
if tmm_Color in ModifyMask then p.Color := fnt.Color;
if tmm_Size in ModifyMask then p.Size := fnt.Size;
if tmm_Styles in ModifyMask then p.Style := p.Style + AddFontStyle - RemoveFontStyle;
if tmm_BackColor in ModifyMask then begin
p.HasBkClr:=fnt.HasBkClr;
p.BkColor:=fnt.BkColor;
end;
l := GetContStyleLength(i);
if i + l > j then l := j - i;
if l = 0 then l := 1;
@ -537,8 +555,7 @@ end;
procedure TCustomRichMemo.SetRangeParaParams(TextStart, TextLength: INteger;
ModifyMask: TParaModifyMask; const ParaMetric: TParaMetric);
var
i : integer;
st, ln: Integer;
ln: Integer;
m : TParaMetric;
begin
repeat

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

@ -178,6 +178,10 @@ const
CP_UNICODE = 1200;
HardBreak = #13;
const
CFM_BACKCOLOR = $04000000;
CFE_AUTOBACKCOLOR = CFM_BACKCOLOR;
implementation
const
@ -244,6 +248,19 @@ begin
Params.Style := EffectsToFontStyles(fmt.dwEffects);
end;
procedure CharFormatToFontParams(const fmt: TCHARFORMAT2; var Params: TIntFontParams);
begin
Params.Name := fmt.szFaceName;
Params.Size := Round(fmt.yHeight/TwipsInFontSize);
Params.Color := fmt.crTextColor;
Params.Style := EffectsToFontStyles(fmt.dwEffects);
if fmt.cbSize > sizeof(CHARFORMAT) then begin
Params.HasBkClr:=(fmt.dwEffects and CFE_AUTOBACKCOLOR) = 0;
if Params.HasBkClr then Params.Color:=Params.Color;
end;
end;
{ TRichEditManager }
class function TRichEditManager.GetTextLength(RichEditWnd: Handle): Integer;
@ -260,8 +277,7 @@ class function TRichEditManager.SetSelectedTextStyle(RichEditWnd: Handle;
Params: TIntFontParams): Boolean;
var
w : WPARAM;
fmt : TCHARFORMAT;
fmt : TCHARFORMAT2;
begin
if RichEditWnd = 0 then begin
Result := false;
@ -273,11 +289,10 @@ begin
FillChar(fmt, sizeof(fmt), 0);
fmt.cbSize := sizeof(fmt);
fmt.dwMask := fmt.dwMask or CFM_COLOR;
fmt.crTextColor := Params.Color;
fmt.dwMask := fmt.dwMask or CFM_FACE ;
fmt.dwMask := fmt.dwMask or CFM_FACE;
// keep last char for Null-termination?
CopyStringToCharArray(Params.Name, fmt.szFaceName, LF_FACESIZE-1);
@ -286,7 +301,15 @@ begin
fmt.dwMask := fmt.dwMask or CFM_EFFECTS;
fmt.dwEffects := FontStylesToEffects(Params.Style);
if Params.HasBkClr then begin
fmt.dwMask := fmt.dwMask or CFM_BACKCOLOR;
fmt.crBackColor := Params.BkColor;
end else begin
fmt.dwMask := fmt.dwMask or CFM_BACKCOLOR;
fmt.dwEffects := fmt.dwEffects or CFE_AUTOBACKCOLOR;
end;
Result := SendMessage(RichEditWnd, EM_SETCHARFORMAT, w, PtrInt(@fmt))>0;
end;
@ -294,7 +317,7 @@ class function TRichEditManager.GetSelectedTextStyle(RichEditWnd: Handle;
var Params: TIntFontParams): Boolean;
var
w : WPARAM;
fmt : TCHARFORMAT;
fmt : TCHARFORMAT2;
begin
Result := false;
@ -304,7 +327,7 @@ begin
FillChar(fmt, sizeof(fmt), 0);
fmt.cbSize := sizeof(fmt);
fmt.dwMask := CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS;
fmt.dwMask := CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS or CFM_BACKCOLOR;
SendMessage(RichEditWnd, EM_GETCHARFORMAT, w, PtrInt(@fmt));