paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-20 12:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

Carbon intf: improved TextOut performance a little

Browse Source 
git-svn-id: trunk@13246 -
This commit is contained in:
tombo 2007-12-09 10:59:18 +00:00
parent 0f368555be
commit 4a1d394e7e
2 changed files with 76 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/synedit/synedit.pp
View File

@ -4111,6 +4111,7 @@ begin
rcToken := AClip;
rcToken.Top := (RowToScreenRow(LastLine)+1) * fTextHeight;
if (rcToken.Top < rcToken.Bottom) then begin
DebugLn('Draw To clip ' + ColorToString(colEditorBG));
SetBkColor(dc, ColorToRGB(colEditorBG));
InternalFillRect(dc, rcToken);
// Draw the right edge if necessary.

122
lcl/interfaces/carbon/carboncanvas.pp
View File

@ -83,6 +83,7 @@ type
FSavedDCList: TFPObjectList;
FTextFractional: Boolean;
FTextBuffer: WideString;
FTextLayout: ATSUTextLayout;
procedure SetBkColor(AValue: TColor);
procedure SetBkMode(const AValue: Integer);
@ -93,6 +94,8 @@ type
procedure SetROP2(const AValue: Integer);
procedure SetTextColor(AValue: TColor);
protected
procedure UpdateTextLayout;
procedure FreeTextLayout;
function GetSize: TPoint; virtual; abstract;
function SaveDCData: TCarbonDCData; virtual;
procedure RestoreDCData(const AData: TCarbonDCData); virtual;
@ -104,8 +107,8 @@ type
function SaveDC: Integer;
function RestoreDC(ASavedDC: Integer): Boolean;
function BeginTextRender(AStr: PChar; ACount: Integer; out ALayout: ATSUTextLayout): Boolean;
procedure EndTextRender(var ALayout: ATSUTextLayout);
function BeginTextRender(AStr: PChar; ACount: Integer): Boolean;
procedure EndTextRender;
procedure SetAntialiasing(AValue: Boolean);
function DrawCGImage(X, Y, Width, Height: Integer; CGImage: CGImageRef): Boolean;
@ -381,6 +384,44 @@ begin
TextBrush.SetColor(AValue, True);
end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.UpdateTextLayout
Updates text layout object
------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.UpdateTextLayout;
var
Tag: ATSUAttributeTag;
DataSize: ByteCount;
PValue: ATSUAttributeValuePtr;
const
SName = 'UpdateTextLayout';
begin
FreeTextLayout;
// create text layout
if OSError(ATSUCreateTextLayout(FTextLayout), Self, SName, 'ATSUCreateTextLayout') then Exit;
// set layout context
Tag := kATSUCGContextTag;
DataSize := SizeOf(CGContextRef);
PValue := @CGContext;
if OSError(ATSUSetLayoutControls(FTextLayout, 1, @Tag, @DataSize, @PValue),
Self, SName, 'ATSUSetLayoutControls', 'CGContext') then Exit;
end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.FreeTextLayout
Frees text layout object
------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.FreeTextLayout;
begin
if FTextLayout <> nil then
OSError(ATSUDisposeTextLayout(FTextLayout), Self, 'FreeTextLayout', 'ATSUDisposeTextLayout');
end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.Create
@ -404,6 +445,8 @@ begin
FCurrentRegion.Select;
FTextFractional := True;
FTextLayout := nil;
end;
{------------------------------------------------------------------------------
@ -413,6 +456,8 @@ end;
------------------------------------------------------------------------------}
destructor TCarbonDeviceContext.Destroy;
begin
FreeTextLayout;
BkBrush.Free;
TextBrush.Free;
@ -464,6 +509,8 @@ begin
// set initial pen, brush and font
CurrentPen := DefaultPen;
CurrentBrush := DefaultBrush;
UpdateTextLayout;
end;
end;
@ -595,20 +642,16 @@ end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.BeginTextRender
Params: AStr - UTF8 string to render
ACount - Count of chars to render
ALayout - ATSU layout
Params: AStr - UTF8 string to render
ACount - Count of chars to render
Returns: If the function suceeds
Creates the ATSU text layout for the specified text and manages the device
Sets the ATSU text layout for the specified text and manages the device
context to render the text.
NOTE: Coordination system is set upside-down!
------------------------------------------------------------------------------}
function TCarbonDeviceContext.BeginTextRender(AStr: PChar; ACount: Integer; out
ALayout: ATSUTextLayout): Boolean;
function TCarbonDeviceContext.BeginTextRender(AStr: PChar; ACount: Integer): Boolean;
var
TextStyle: ATSUStyle;
TextLength: LongWord;
S: String;
Tag: ATSUAttributeTag;
DataSize: ByteCount;
@ -626,27 +669,27 @@ begin
// change coordination system
CGContextScaleCTM(CGContext, 1, -1);
// convert UTF-8 string to UTF-16 string
if ACount < 0 then S := AStr
else S := Copy(AStr, 1, ACount);
// keep copy of text
FTextBuffer := UTF8ToUTF16(S);
TextStyle := CurrentFont.Style;
// set text
if OSError(ATSUSetTextPointerLocation(FTextLayout, ConstUniCharArrayPtr(@FTextBuffer[1]),
kATSUFromTextBeginning, kATSUToTextEnd, Length(FTextBuffer)),
Self, SName, 'ATSUSetTextPointerLocation') then Exit;
// set style
if OSError(ATSUSetRunStyle(FTextLayout, CurrentFont.Style, kATSUFromTextBeginning, kATSUToTextEnd),
Self, SName, 'ATSUSetRunStyle') then Exit;
// create text layout
TextLength := kATSUToTextEnd;
if OSError(ATSUCreateTextLayoutWithTextPtr(ConstUniCharArrayPtr(@FTextBuffer[1]),
kATSUFromTextBeginning, kATSUToTextEnd, Length(FTextBuffer), 1, @TextLength,
@TextStyle, ALayout), Self, SName, 'ATSUCreateTextLayoutWithTextPtr') then Exit;
// set layout line orientation
Tag := kATSULineRotationTag;
DataSize := SizeOf(Fixed);
PValue := @(CurrentFont.LineRotation);
if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
if OSError(ATSUSetLayoutControls(FTextLayout, 1, @Tag, @DataSize, @PValue),
Self, SName, 'ATSUSetLayoutControls', 'LineRotation') then Exit;
if not TextFractional then
@ -658,35 +701,23 @@ begin
Options := kATSLineFractDisable or kATSLineDisableAutoAdjustDisplayPos or
kATSLineDisableAllLayoutOperations or kATSLineUseDeviceMetrics;
PValue := @Options;
if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
if OSError(ATSUSetLayoutControls(FTextLayout, 1, @Tag, @DataSize, @PValue),
Self, SName, 'ATSUSetLayoutControls', 'LineLayoutOptions') then Exit;
end;
// set layout context
Tag := kATSUCGContextTag;
DataSize := SizeOf(CGContextRef);
PValue := @CGContext;
if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
Self, SName, 'ATSUSetLayoutControls', 'CGContext') then Exit;
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.EndTextRender
Params: ALayout - ATSU layout
Frees the ATSU text layout and manages the device
context to render ordinary graphic
Manages the device context to render ordinary graphic
------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.EndTextRender(var ALayout: ATSUTextLayout);
procedure TCarbonDeviceContext.EndTextRender;
begin
// restore context
CGContextRestoreGState(CGContext);
if ALayout <> nil then
OSError(ATSUDisposeTextLayout(ALayout), Self, 'EndTextRender', 'ATSUDisposeTextLayout');
FTextBuffer := '';
end;
@ -835,7 +866,6 @@ end;
function TCarbonDeviceContext.ExtTextOut(X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
var
TextLayout: ATSUTextLayout;
TextBefore, TextAfter, Ascent, Descent: ATSUTextMeasurement;
MX, MY: ATSUTextMeasurement;
A: Single;
@ -854,12 +884,12 @@ begin
//DebugLn('TCarbonDeviceContext.ExtTextOut fill ' + DbgS(Rect^));
end;
if not BeginTextRender(Str, Count, TextLayout) then Exit;
if not BeginTextRender(Str, Count) then Exit;
try
// get text ascent
if OSError(
ATSUGetUnjustifiedBounds(TextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
ATSUGetUnjustifiedBounds(FTextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
TextBefore, TextAfter, Ascent, Descent),
Self, SName, SGetUnjustifiedBounds) then Exit;
@ -888,12 +918,12 @@ begin
TextBrush.Apply(Self, False); // do not use ROP2
// finally draw the text
if OSError(ATSUDrawText(TextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
if OSError(ATSUDrawText(FTextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
X shl 16 - TextBefore + MX, -(Y shl 16) - Ascent + MY),
Self, SName, 'ATSUDrawText') then Exit;
Result := True;
finally
EndTextRender(TextLayout);
EndTextRender;
end;
end;
@ -974,7 +1004,6 @@ end;
function TCarbonDeviceContext.GetTextExtentPoint(Str: PChar; Count: Integer;
var Size: TSize): Boolean;
var
TextLayout: ATSUTextLayout;
TextBefore, TextAfter, Ascent, Descent: ATSUTextMeasurement;
const
SName = 'GetTextExtentPoint';
@ -983,10 +1012,10 @@ begin
Size.cx := 0;
Size.cy := 0;
if not BeginTextRender(Str, Count, TextLayout) then Exit;
if not BeginTextRender(Str, Count) then Exit;
try
// finally compute the text dimensions
if OSError(ATSUGetUnjustifiedBounds(TextLayout, kATSUFromTextBeginning,
if OSError(ATSUGetUnjustifiedBounds(FTextLayout, kATSUFromTextBeginning,
kATSUToTextEnd, TextBefore, TextAfter, Ascent, Descent),
Self, SName, SGetUnjustifiedBounds) then Exit;
@ -995,7 +1024,7 @@ begin
Result := True;
finally
EndTextRender(TextLayout);
EndTextRender;
end;
end;
@ -1012,7 +1041,6 @@ var
TextStyle: ATSUStyle;
M: ATSUTextMeasurement;
B: Boolean;
TextLayout: ATSUTextLayout;
TextBefore, TextAfter, Ascent, Descent: ATSUTextMeasurement;
const
SName = 'GetTextMetrics';
@ -1026,13 +1054,13 @@ begin
// According to the MSDN library, TEXTMETRIC:
// the average char width is generally defined as the width of the letter x
if not BeginTextRender('x', 1, TextLayout) then Exit;
if not BeginTextRender('x', 1) then Exit;
try
if OSError(ATSUGetUnjustifiedBounds(TextLayout, kATSUFromTextBeginning,
if OSError(ATSUGetUnjustifiedBounds(FTextLayout, kATSUFromTextBeginning,
kATSUToTextEnd, TextBefore, TextAfter, Ascent, Descent),
SName, SGetUnjustifiedBounds) then Exit
finally
EndTextRender(TextLayout);
EndTextRender;
end;
TM.tmAscent := RoundFixed(Ascent);