From 7ae85c5538a9bfb4a39dab10c3e010aeef5d214d Mon Sep 17 00:00:00 2001 From: skalogryz Date: Sat, 6 Jun 2009 08:21:08 +0000 Subject: [PATCH] implemented GetTextAttribs for carbon git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@823 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/richmemo/carbon/carbonrichmemo.pas | 140 ++++++++++++++++-- 1 file changed, 125 insertions(+), 15 deletions(-) diff --git a/components/richmemo/carbon/carbonrichmemo.pas b/components/richmemo/carbon/carbonrichmemo.pas index d8454f290..b5f7c4c0c 100644 --- a/components/richmemo/carbon/carbonrichmemo.pas +++ b/components/richmemo/carbon/carbonrichmemo.pas @@ -1,4 +1,4 @@ -unit carbonrichmemo; +unit CarbonRichMemo; {$mode objfpc}{$H+} @@ -22,6 +22,11 @@ type TCarbonRichEdit = class(TCarbonMemo) protected function GetCreationOptions: TXNFrameOptions; override; + public + function GetContinuousTypeAttributes(var oContinuousFlags: TXNContinuousFlags; + iCount: ItemCount; var ioTypeAttributes: array of TXNTypeAttributes): Boolean; + function SetTypeAttributes(iCount: ItemCount; const iTypeAttributes: array of TXNTypeAttributes; + StartOffset, EndOffset: Integer): Boolean; end; { TCarbonWSCustomRichMemo } @@ -40,6 +45,62 @@ implementation const TXNAttributesMax = 10; +function GetATSUFontName(AStyle: ATSUStyle): String; +var + fontid: ATSUFontID; +begin + ATSUGetAttribute(AStyle, kATSUFontTag, sizeof(ATSUFontID), @fontid, nil); + Result := CarbonFontIDToFontName(fontid); +end; + +function GetATSUFontSize(ASTyle: ATSUStyle): Integer; +var + sz : fixed; +begin + ATSUGetAttribute(AStyle, kATSUSizeTag, sizeof(fixed), @sz, nil); + Result := Fix2Long(sz); +end; + +procedure GetATSUFontRGBAColor(AStyle: ATSUStyle; var r,g,b,a: Byte); +var + rgba : ATSURGBAlphaColor; +begin + ATSUGetAttribute(AStyle, kATSURGBAlphaColorTag, sizeof(Boolean), @rgba, nil); + r := Round(rgba.red*255); + g := Round(rgba.green*255); + b := Round(rgba.blue*255); + a := Round(rgba.alpha*255); +end; + +function GetATSUFontColor(AStyle: ATSUStyle): TColor; +var + r,g,b,a: Byte; +begin + GetATSUFontRGBAColor(AStyle, r,g,b,a); + Result := (b shl 16) or (g shl 8) or r; +end; + +function GetATSUFontStyles(AStyle: ATSUStyle): TFontStyles; +var + b : Boolean; +begin + b:=false; + Result := []; + ATSUGetAttribute(AStyle, kATSUQDBoldfaceTag, sizeof(Boolean), @b, nil); + if b then Include(Result, fsBold); + ATSUGetAttribute(AStyle, kATSUQDItalicTag, sizeof(Boolean), @b, nil); + if b then Include(Result, fsItalic); + ATSUGetAttribute(AStyle, kATSUQDUnderlineTag, sizeof(Boolean), @b, nil); + if b then Include(Result, fsUnderline); + ATSUGetAttribute(AStyle, kATSUStyleStrikeThroughTag , sizeof(Boolean), @b, nil); + if b then Include(Result, fsStrikeOut); +end; + +function IsValidControlHandle(AWinControl: TWinControl): Boolean; +begin + Result := Assigned(AWinControl) and (AWinControl.Handle<>0); +end; + procedure AttrSetFontName(const FontName: String; var Attr: TXNTypeAttributes); begin Attr.tag := kATSUFontTag; @@ -65,12 +126,14 @@ procedure AttrSetStyle(FontStyle: TFontStyles; var Attr: TXNTypeAttributes); begin Attr.tag := kTXNQDFontStyleAttribute; Attr.size := kTXNQDFontStyleAttributeSize; - Attr.data.dataValue := normal; + Attr.data.dataValue := FontStyleToQDStyle(FontStyle) +end; - 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 +procedure AttrSetATSUStyle(AStyle: ATSUStyle; var Attr: TXNTypeAttributes); +begin + Attr.tag := kTXNATSUIStyle; + Attr.size := kTXNATSUIStyleSize; + Attr.data.dataPtr := astyle; end; procedure ParamsToTXNAttribs(ParamsMask: TTextStyleMask; const Params: TFontParams; @@ -111,26 +174,57 @@ end; class function TCarbonWSCustomRichMemo.GetTextAttributes(const AWinControl: TWinControl; TextStart: Integer; var Params: TFontParams): Boolean; +var + memo : TCarbonRichEdit; + attr : array [0..1] of TXNTypeAttributes; + sstart : Integer; + slen : Integer; + flags : TXNContinuousFlags; + + astyle : ATSUStyle; + begin - Result:=false; + Result := IsValidControlHandle(AWinControl); + if not Result then Exit; + memo := TCarbonRichEdit(AWinControl.Handle); + + memo.GetSelStart(sstart); + memo.GetSelLength(slen); + + memo.SetSelStart(TextStart); + memo.SetSelLength(1); + + ATSUCreateStyle(astyle); + AttrSetATSUStyle(astyle, attr[0]); + AttrSetStyle([], attr[1]); + + Result := memo.GetContinuousTypeAttributes(flags, 2, attr); + Params.Name := GetATSUFontName(astyle); + Params.Color := GetATSUFontColor(astyle); + Params.Style := GetATSUFontStyles(astyle) + QDStyleToFontStyle(attr[1].data.dataValue); + Params.Size := GetATSUFontSize(astyle); + + ATSUDisposeStyle(astyle); + + memo.SetSelLength(sstart); + memo.SetSelLength(slen); end; class procedure TCarbonWSCustomRichMemo.SetTextAttributes(const AWinControl: TWinControl; TextStart, TextLen: Integer; Mask: TTextStyleMask; const Params: TFontParams); var - memo : TCarbonMemo; - attr : array [0..TXNAttributesMax-1] of TXNTypeAttributes; - attrcount : Integer; + memo : TCarbonRichEdit; + Attr : array [0..TXNAttributesMax-1] of TXNTypeAttributes; + Count : Integer; maccolor : RGBColor; begin - if not Assigned(AWinControl) or (AWinControl.Handle = 0) then Exit; - memo := TCarbonMemo(AWinControl.Handle); + if not IsValidControlHandle(AWinControl) then Exit; + memo := TCarbonRichEdit(AWinControl.Handle); - ParamsToTXNAttribs(Mask, Params, attr, attrcount, maccolor); + ParamsToTXNAttribs(Mask, Params, attr, Count, maccolor); - TXNSetTypeAttributes(HITextViewGetTXNObject(ControlRef(memo.Widget)), attrcount, @Attr[0], - TextStart, TextStart+TextLen); + memo.SetTypeAttributes(Count, Attr, TextStart, TextStart+TextLen); end; class procedure TCarbonWSCustomRichMemo.SetHideSelection(const AWinControl: TWinControl; @@ -146,5 +240,21 @@ begin Result := kOutputTextInUnicodeEncodingMask; end; +function TCarbonRichEdit.GetContinuousTypeAttributes( + var oContinuousFlags: TXNContinuousFlags; iCount: ItemCount; + var ioTypeAttributes: array of TXNTypeAttributes): Boolean; +begin + Result := TXNGetContinuousTypeAttributes(HITextViewGetTXNObject(Widget), + oContinuousFlags, iCount, @ioTypeAttributes[0]) = noErr; +end; + +function TCarbonRichEdit.SetTypeAttributes(iCount: ItemCount; + const iTypeAttributes: array of TXNTypeAttributes; StartOffset, + EndOffset: Integer): Boolean; +begin + Result := TXNSetTypeAttributes(HITextViewGetTXNObject(Widget), iCount, + @iTypeAttributes[0], StartOffset, EndOffset) = noErr; +end; + end.