You've already forked lazarus-ccr
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:
@ -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.
|
||||
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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">
|
||||
|
Reference in New Issue
Block a user