added setting style for carbon richmemo

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

components/richmemo/carbon/carbonrichmemo.pas

@@ -5,15 +5,25 @@ unit carbonrichmemo;
 interface
 
 uses
+  MacOSAll,
+
   LCLType, Classes, SysUtils,
 
-  Controls,
+  Controls, Graphics,
 
   RichMemoTypes, WSRichMemo,
 
-  CarbonEdits;
+  CarbonProc, CarbonEdits;
 
 type
+
+  { TCarbonRichEdit }
+
+  TCarbonRichEdit = class(TCarbonMemo)
+  protected
+    function GetCreationOptions: TXNFrameOptions; override;
+  end;
+
   { TCarbonWSCustomRichMemo }
 
   TCarbonWSCustomRichMemo = class(TWSCustomRichMemo)
@@ -27,12 +37,76 @@ type
 
 implementation
 
+const
+  TXNAttributesMax = 10;
+
+procedure AttrSetFontName(const FontName: String; var Attr: TXNTypeAttributes);
+begin
+  Attr.tag := kATSUFontTag;
+  Attr.size := SizeOf(ATSUFontID);
+  Attr.data.dataValue := FindCarbonFontID(FontName);
+end;
+
+procedure AttrSetColor(var MacColor: RGBColor; var Attr: TXNTypeAttributes);
+begin
+  Attr.tag := kTXNQDFontColorAttribute;
+  Attr.size := kTXNQDFontColorAttributeSize;
+  Attr.data.dataPtr := @MacColor;
+end;
+
+procedure AttrSetSize(FontSize: Integer; var Attr: TXNTypeAttributes);
+begin
+  Attr.tag := kTXNQDFontSizeAttribute;
+  Attr.size := kTXNQDFontSizeAttributeSize;
+  Attr.data.dataValue := FontSize;
+end;
+
+procedure AttrSetStyle(FontStyle: TFontStyles; var Attr: TXNTypeAttributes);
+begin
+  Attr.tag := kTXNQDFontStyleAttribute;
+  Attr.size := kTXNQDFontStyleAttributeSize;
+  Attr.data.dataValue := normal;
+
+  if fsBold in FontStyle then Attr.data.dataValue := Attr.data.dataValue or bold;
+  if fsItalic in FontStyle then Attr.data.dataValue := Attr.data.dataValue or italic;
+  if fsUnderline in FontStyle then Attr.data.dataValue := Attr.data.dataValue or underline;
+  // if fsStrikeOut in FontStyle then ... can be implemented only by using ATSU
+end;
+
+procedure ParamsToTXNAttribs(ParamsMask: TTextStyleMask; const Params: TFontParams;
+  var Attr: array of TXNTypeAttributes; var AttrCount: Integer; var MacColor: RGBColor);
+begin
+  AttrCount := 0;
+  //todo: replace QuickDraw style by ATSU style
+
+  if tsm_Color in ParamsMask then begin
+    MacColor := ColorToRGBColor(Params.Color);
+    AttrSetColor(MacColor, Attr[AttrCount] );
+    inc(AttrCount);
+  end;
+
+  if tsm_Name in ParamsMask then begin
+    AttrSetFontName(Params.Name, Attr[AttrCount] );
+    inc(AttrCount);
+  end;
+
+  if tsm_Size in ParamsMask then begin
+    AttrSetSize(Params.Size, Attr[AttrCount] );
+    inc(AttrCount);
+  end;
+
+  if tsm_Styles in ParamsMask then begin
+    AttrSetStyle(Params.Style, Attr[AttrCount]);
+    inc(AttrCount);
+  end;
+end;
+
 { TCarbonWSCustomRichMemo }
 
 class function TCarbonWSCustomRichMemo.CreateHandle(const AWinControl: TWinControl;
   const AParams: TCreateParams): HWND;
 begin
-  Result := TLCLIntfHandle(TCarbonMemo.Create(AWinControl, AParams));
+  Result := TLCLIntfHandle(TCarbonRichEdit.Create(AWinControl, AParams));
 end;
 
 class function TCarbonWSCustomRichMemo.GetTextAttributes(const AWinControl: TWinControl;
@@ -46,16 +120,31 @@ class procedure TCarbonWSCustomRichMemo.SetTextAttributes(const AWinControl: TWi
   Mask: TTextStyleMask; const Params: TFontParams);
 var
   memo  : TCarbonMemo;
+  attr  : array [0..TXNAttributesMax-1] of TXNTypeAttributes;
+  attrcount : Integer;
+  maccolor  : RGBColor;
 begin
-  if not Assigned(AWinControl) or not Assigned(AWinControl.Handle) then Exit;
+  if not Assigned(AWinControl) or (AWinControl.Handle = 0) then Exit;
-  memo := TCarbonMemo.Create(AWinControl.Handle);
+  memo := TCarbonMemo(AWinControl.Handle);
+
+  ParamsToTXNAttribs(Mask, Params, attr, attrcount, maccolor);
+
+  TXNSetTypeAttributes(HITextViewGetTXNObject(ControlRef(memo.Widget)), attrcount, @Attr[0],
+    TextStart, TextStart+TextLen);
 end;
 
-class procedure TCarbonWSCustomRichMemo.SetHideSelection(
+class procedure TCarbonWSCustomRichMemo.SetHideSelection(const AWinControl: TWinControl;
-  const AWinControl: TWinControl; AHideSelection: Boolean);
+  AHideSelection: Boolean);
 begin
 
 end;
 
+{ TCarbonRichEdit }
+
+function TCarbonRichEdit.GetCreationOptions: TXNFrameOptions;
+begin
+  Result := kOutputTextInUnicodeEncodingMask;
+end;
+
 end.
 

components/richmemo/richmemofactory.pas

@@ -7,8 +7,9 @@ interface
 
 uses
   WSLCLClasses,
-  RichMemo,  
+  RichMemo
-  {$ifdef LCLWin32}Win32RichMemo{$endif}
+  {$ifdef LCLWin32},Win32RichMemo{$endif}
+  {$ifdef LCLCarbon},CarbonRichMemo{$endif}
   ;
 
 function RegisterCustomRichMemo: Boolean;
@@ -18,6 +19,7 @@ implementation
 function RegisterCustomRichMemo: Boolean; alias : 'WSRegisterCustomRichMemo';
 begin
   {$ifdef LCLWin32}RegisterWSComponent(TCustomRichMemo, TWin32WSCustomRichMemo);{$endif}
+  {$ifdef LCLCarbon}RegisterWSComponent(TCustomRichMemo, TCarbonWSCustomRichMemo);{$endif}
   Result := False;
 end;
 

components/richmemo/richmemopackage.lpk

@@ -8,7 +8,7 @@
       <Version Value="8"/>
       <PathDelim Value="\"/>
       <SearchPaths>
-        <OtherUnitFiles Value="win32\"/>
+        <OtherUnitFiles Value="win32\;carbon\"/>
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
       <Other>
@@ -19,7 +19,7 @@
 "/>
     <License Value="LGPL"/>
     <Version Minor="8"/>
-    <Files Count="8">
+    <Files Count="9">
       <Item1>
         <Filename Value="richmemo.pas"/>
         <AddToUsesPkgSection Value="False"/>
@@ -58,6 +58,11 @@
         <Filename Value="richmemopackage.lrs"/>
         <Type Value="LRS"/>
       </Item8>
+      <Item9>
+        <Filename Value="carbon\carbonrichmemo.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="carbonrichmemo"/>
+      </Item9>
     </Files>
     <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="2">