richmemo: background color

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3808 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/richmemo/richmemo.pas

@@ -28,10 +28,12 @@ uses
 
 type
   TFontParams  = record
-    Name    : String;
+    Name      : String;
-    Size    : Integer;
+    Size      : Integer;
-    Color   : TColor;
+    Color     : TColor;
-    Style   : TFontStyles;
+    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_Name in ModifyMask   then p.Name := fnt.Name;
-    if tmm_Color in ModifyMask then p.Color := FontColor;
+    if tmm_Color in ModifyMask  then p.Color := fnt.Color;
-    if tmm_Size in ModifyMask then p.Size := FontSize;
+    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;
+  ln: Integer;
-  st, ln: Integer;
   m : TParaMetric;
 begin
   repeat

components/richmemo/win32/win32richmemoproc.pas

@@ -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));