added setting style for carbon richmemo

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@822 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2009-06-05 17:04:00 +00:00
parent 69d6ecc34e
commit d48379d957
3 changed files with 107 additions and 11 deletions

View File

@ -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;
memo := TCarbonMemo.Create(AWinControl.Handle);
if not Assigned(AWinControl) or (AWinControl.Handle = 0) then Exit;
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(
const AWinControl: TWinControl; AHideSelection: Boolean);
class procedure TCarbonWSCustomRichMemo.SetHideSelection(const AWinControl: TWinControl;
AHideSelection: Boolean);
begin
end;
{ TCarbonRichEdit }
function TCarbonRichEdit.GetCreationOptions: TXNFrameOptions;
begin
Result := kOutputTextInUnicodeEncodingMask;
end;
end.

View File

@ -7,8 +7,9 @@ interface
uses
WSLCLClasses,
RichMemo,
{$ifdef LCLWin32}Win32RichMemo{$endif}
RichMemo
{$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;

View File

@ -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">