lazarus/lcl/lazfreetypeintfdrawer.pas
2021-07-22 12:16:14 +00:00

754 lines
22 KiB
ObjectPascal

unit LazFreeTypeIntfDrawer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FPimage,
// LazUtils
GraphType,
// FreeType
EasyLazFreeType,
// LCL
Graphics, IntfGraphics;
type
TLazIntfImageGetPixelAtProc = procedure(p: pointer; out Color: TFPColor);
TLazIntfImageSetPixelAtProc = procedure(p: pointer; const Color: TFPColor);
TLazIntfHorizLineProc = procedure(x1,y,x2: integer; const Color: TFPColor) of object;
{ TIntfFreeTypeDrawer }
TIntfFreeTypeDrawer = class(TFreeTypeDrawer)
private
FColor: TFPColor;
FDestination: TLazIntfImage;
FHasPixelAtProc: boolean;
FGetPixelAtProc: TLazIntfImageGetPixelAtProc;
FSetPixelAtProc: TLazIntfImageSetPixelAtProc;
FPixelSizeInBytes: longword;
FWidth, FHeight: integer;
procedure SetDestination(AValue: TLazIntfImage);
protected
procedure RenderDirectly(x, y, tx: integer; data: pointer);
procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer);
procedure InternalMergeColorOver(var merge: TFPColor; const c: TFPColor; calpha: word); inline;
procedure MergeColorOver(var merge: TFPColor; const c: TFPColor); inline;
procedure MergeColorOver(var merge: TFPColor; const c: TFPColor; ApplyOpacity: byte); inline;
procedure DrawPixelAt(p: pointer; const c: TFPColor);
procedure DrawPixelAt(p: pointer; const c: TFPColor; applyOpacity: byte);
procedure ClearTypePixelAt(p: pointer; Cr,Cg,Cb: byte; const Color: TFPColor);
function UnclippedGetPixelAddress(x, y: integer): pointer; inline;
function ClippedGetPixelAddress(x, y: integer): pointer; inline;
public
ClearTypeRGBOrder: boolean;
constructor Create(ADestination: TLazIntfImage);
procedure ClippedDrawPixel(x,y: integer; const c: TFPColor);
procedure UnclippedDrawPixel(x,y: integer; const c: TFPColor);
procedure ClippedClearTypePixel(x,y: integer; Cr,Cg,Cb: byte; const Color: TFPColor);
procedure UnclippedClearTypePixel(x,y: integer; Cr,Cg,Cb: byte; const Color: TFPColor);
procedure DrawVertLine(x,y1,y2: integer; const c: TFPColor);
procedure SetHorizLine(x1,y,x2: integer; const c: TFPColor);
procedure DrawHorizLine(x1,y,x2: integer; const c: TFPColor);
procedure FillRect(x,y,x2,y2: integer; const c: TFPColor; ASetPixels: boolean = True);
procedure FillPixels(const c: TFPColor; ASetPixels: boolean = True);
procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
property Destination: TLazIntfImage read FDestination write SetDestination;
destructor Destroy; override;
end;
implementation
type
PFPColorBytes = ^TFPColorBytes;
TFPColorBytes = record
{$ifdef ENDIAN_LITTLE}
Rl, Rh, Gl, Gh, Bl, Bh, Al, Ah: Byte;
{$else}
Rh, Rl, Gh, Gl, Bh, Bl, Ah, Al: Byte;
{$endif}
end;
PFourBytes = ^TFourBytes;
TFourBytes = record
B0, B1, B2, B3: Byte;
end;
{ TIntfFreeTypeDrawer }
function TIntfFreeTypeDrawer.ClippedGetPixelAddress(x, y: integer): pointer;
begin
if (x < 0) or (x >= Destination.Width) then
raise FPImageException.CreateFmt(ErrorText[StrInvalidIndex],[ErrorText[StrImageX],x]);
if (y < 0) or (y >= Destination.Height) then
raise FPImageException.CreateFmt(ErrorText[StrInvalidIndex],[ErrorText[StrImageY],y]);
result := pbyte(Destination.GetDataLineStart(y))+(x*FPixelSizeInBytes);
end;
procedure InternalGetPixelAtWithoutAlphaRGB(p: pointer; out Color: TFPColor);
begin
with PFourBytes(p)^ do
begin
TFPColorBytes(color).Rh := B0;
TFPColorBytes(color).Rl := B0;
TFPColorBytes(color).Gh := B1;
TFPColorBytes(color).Gl := B1;
TFPColorBytes(color).Bh := B2;
TFPColorBytes(color).Bl := B2;
color.alpha := $ffff;
end;
end;
procedure InternalSetPixelAtWithoutAlphaRGB(p: pointer; const Color: TFPColor);
begin
with PFourBytes(p)^ do
begin
B0 := TFPColorBytes(color).Rh;
B1 := TFPColorBytes(color).Gh;
B2 := TFPColorBytes(color).Bh;
end;
end;
procedure InternalGetPixelAtWithoutAlphaBGR(p: pointer; out Color: TFPColor);
{$IFDEF CPUI386} assembler; {$ASMMODE INTEL}
asm
mov cl, [eax+2]
mov [edx], cl
mov [edx+1], cl
mov cl, [eax+1]
mov [edx+2], cl
mov [edx+3], cl
mov cl, [eax]
mov [edx+4], cl
mov [edx+5], cl
xor ecx, ecx
not ecx
mov [edx+6], cx
end;
{$ELSE}
begin
with PFourBytes(p)^ do
begin
TFPColorBytes(color).Rh := B2;
TFPColorBytes(color).Rl := B2;
TFPColorBytes(color).Gh := B1;
TFPColorBytes(color).Gl := B1;
TFPColorBytes(color).Bh := B0;
TFPColorBytes(color).Bl := B0;
color.alpha := $ffff;
end;
end;
{$ENDIF}
procedure InternalSetPixelAtWithoutAlphaBGR(p: pointer; const Color: TFPColor);
{$IFDEF CPUI386} assembler; {$ASMMODE INTEL}
asm
mov cl, [edx+1]
mov [eax+2], cl
mov cl, [edx+3]
mov [eax+1], cl
mov cl, [edx+5]
mov [eax], cl
end;
{$ELSE}
begin
with PFourBytes(p)^ do
begin
B2 := TFPColorBytes(color).Rh;
B1 := TFPColorBytes(color).Gh;
B0 := TFPColorBytes(color).Bh;
end;
end;
{$ENDIF}
procedure InternalGetPixelAtWithAlphaRGBA(p: pointer; out Color: TFPColor);
begin
with PFourBytes(p)^ do
begin
TFPColorBytes(color).Rh := B0;
TFPColorBytes(color).Rl := B0;
TFPColorBytes(color).Gh := B1;
TFPColorBytes(color).Gl := B1;
TFPColorBytes(color).Bh := B2;
TFPColorBytes(color).Bl := B2;
TFPColorBytes(color).Ah := B3;
TFPColorBytes(color).Al := B3;
end;
end;
procedure InternalSetPixelAtWithAlphaRGBA(p: pointer; const Color: TFPColor);
begin
with PFourBytes(p)^ do
begin
B0 := TFPColorBytes(color).Rh;
B1 := TFPColorBytes(color).Gh;
B2 := TFPColorBytes(color).Bh;
B3 := TFPColorBytes(color).Ah;
end;
end;
procedure InternalGetPixelAtWithAlphaBGRA(p: pointer; out Color: TFPColor);
begin
with PFourBytes(p)^ do
begin
TFPColorBytes(color).Rh := B2;
TFPColorBytes(color).Rl := B2;
TFPColorBytes(color).Gh := B1;
TFPColorBytes(color).Gl := B1;
TFPColorBytes(color).Bh := B0;
TFPColorBytes(color).Bl := B0;
TFPColorBytes(color).Ah := B3;
TFPColorBytes(color).Al := B3;
end;
end;
procedure InternalSetPixelAtWithAlphaBGRA(p: pointer; const Color: TFPColor);
begin
with PFourBytes(p)^ do
begin
B2 := TFPColorBytes(color).Rh;
B1 := TFPColorBytes(color).Gh;
B0 := TFPColorBytes(color).Bh;
B3 := TFPColorBytes(color).Ah;
end;
end;
procedure TIntfFreeTypeDrawer.MergeColorOver(var merge: TFPColor; const c: TFPColor);
begin
InternalMergeColorOver(merge,c,c.alpha);
end;
procedure TIntfFreeTypeDrawer.MergeColorOver(var merge: TFPColor;
const c: TFPColor; ApplyOpacity: byte);
var
calpha: longword;
begin
calpha := c.alpha*applyOpacity div 255;
InternalMergeColorOver(merge,c,calpha);
end;
procedure TIntfFreeTypeDrawer.UnclippedDrawPixel(x, y: integer; const c: TFPColor);
var
merge: TFPColor;
begin
if c.alpha = 0 then exit;
if FHasPixelAtProc then
DrawPixelAt(UnclippedGetPixelAddress(x,y),c)
else
begin
if c.alpha = $ffff then
Destination.Colors[x,y] := c
else
begin
merge := Destination.Colors[x,y];
MergeColorOver(merge,c);
Destination.Colors[x,y] := merge;
end;
end;
end;
procedure TIntfFreeTypeDrawer.DrawPixelAt(p: pointer; const c: TFPColor; applyOpacity: byte);
var
merge: TFPColor;
calpha: longword;
begin
calpha := c.alpha*applyOpacity div 255;
if calpha = 0 then exit;
if calpha = $ffff then
FSetPixelAtProc(p, c)
else
begin
FGetPixelAtProc(p, merge);
InternalMergeColorOver(merge,c,calpha);
FSetPixelAtProc(p, merge);
end;
end;
procedure TIntfFreeTypeDrawer.DrawPixelAt(p: pointer; const c: TFPColor);
var
merge: TFPColor;
begin
if (c.alpha = 0) then exit;
if (c.alpha = $ffff) then
FSetPixelAtProc(p, c)
else
begin
FGetPixelAtProc(p, merge);
MergeColorOver(merge,c);
FSetPixelAtProc(p, merge);
end;
end;
procedure TIntfFreeTypeDrawer.ClippedClearTypePixel(x, y: integer; Cr, Cg,
Cb: byte; const Color: TFPColor);
begin
if (x < 0) or (y < 0) or (x >= Destination.Width) or (y >= Destination.Height) then exit;
UnclippedClearTypePixel(x,y,Cr,Cg,Cb,Color);
end;
procedure TIntfFreeTypeDrawer.DrawVertLine(x, y1, y2: integer; const c: TFPColor
);
var y: integer;
begin
if (x < 0) or (x >= Destination.Width) then exit;
if (y1 > y2) then
begin
y := y1;
y1:= y2;
y2 := y;
end;
if y1 < 0 then y1 := 0;
if y2 >= Destination.Height then y2 := Destination.Height-1;
for y := y1 to y2 do
UnclippedDrawPixel(x,y, c);
end;
procedure TIntfFreeTypeDrawer.SetHorizLine(x1, y, x2: integer; const c: TFPColor);
var i: integer;
pdest: pbyte;
step: longword;
begin
if (y < 0) or (y >= Destination.Height) then exit;
if (x1 > x2) then
begin
i := x1;
x1:= x2;
x2 := i;
end;
if x1 < 0 then x1 := 0;
if x2 >= Destination.Width then x2 := Destination.Width-1;
if FHasPixelAtProc then
begin
pdest := UnclippedGetPixelAddress(x1,y);
step := FPixelSizeInBytes;
i := x2-x1+1;
while i > 0 do
begin
FSetPixelAtProc(pdest,c);
inc(pdest,step);
dec(i);
end;
end else
for i := x1 to x2 do
Destination.Colors[i,y] := c;
end;
procedure TIntfFreeTypeDrawer.DrawHorizLine(x1, y, x2: integer;
const c: TFPColor);
var i: integer;
pdest: pbyte;
step: longword;
begin
if (y < 0) or (y >= Destination.Height) then exit;
if (x1 > x2) then
begin
i := x1;
x1:= x2;
x2 := i;
end;
if x1 < 0 then x1 := 0;
if x2 >= Destination.Width then x2 := Destination.Width-1;
if FHasPixelAtProc then
begin
pdest := UnclippedGetPixelAddress(x1,y);
step := FPixelSizeInBytes;
i := x2-x1+1;
while i > 0 do
begin
DrawPixelAt(pdest,c);
inc(pdest,step);
dec(i);
end;
end else
for i := x1 to x2 do
UnclippedDrawPixel(i,y,c);
end;
procedure TIntfFreeTypeDrawer.FillRect(x, y, x2, y2: integer;
const c: TFPColor; ASetPixels: boolean);
var yb,xb: integer;
HorizLineProc: TLazIntfHorizLineProc;
begin
if x2 < x then
begin
xb:= x;
x := x2;
x2 := xb;
end;
if x < 0 then x := 0;
if x2 > Destination.Width then x2 := Destination.Width;
if (x >= Destination.Width) or (x2 <= 0) then exit;
if y2 < y then
begin
yb := y;
y := y2;
y2 := yb;
end;
if y < 0 then y := 0;
if y2 > Destination.Height then y2 := Destination.Height;
if ASetPixels then HorizLineProc := @SetHorizLine else HorizLineProc := @DrawHorizLine;
for yb := y to y2-1 do
HorizLineProc(x,yb,x2-1,c);
end;
procedure TIntfFreeTypeDrawer.FillPixels(const c: TFPColor; ASetPixels: boolean = True);
var yb: integer;
HorizLineProc: TLazIntfHorizLineProc;
begin
if ASetPixels then HorizLineProc := @SetHorizLine else HorizLineProc := @DrawHorizLine;
for yb := 0 to Destination.Height-1 do
HorizLineProc(0,yb,Destination.Width-1,c);
end;
procedure TIntfFreeTypeDrawer.UnclippedClearTypePixel(x, y: integer; Cr, Cg, Cb: byte; const Color: TFPColor);
var merge,mergeClearType: TFPColor;
acc: longword;
keep,dont_keep: word;
begin
Cr := Cr*(color.alpha+1) shr 16;
Cg := Cg*(color.alpha+1) shr 16;
Cb := Cb*(color.alpha+1) shr 16;
acc := Cr+Cg+Cb;
if acc = 0 then exit;
merge := Destination.Colors[x,y];
mergeClearType.red := (merge.red * (not byte(Cr)) +
color.red * Cr + 128) div 255;
mergeClearType.green := (merge.green * (not byte(Cg)) +
color.green * Cg + 128) div 255;
mergeClearType.blue := (merge.blue * (not byte(Cb)) +
color.blue * Cb + 128) div 255;
mergeClearType.alpha := merge.alpha;
if (mergeClearType.alpha = $ffff) then
Destination.Colors[x,y]:= mergeClearType
else
begin
if Cg <> 0 then
MergeColorOver(merge,color,Cg);
dont_keep := mergeClearType.alpha shr 1;
if dont_keep > 0 then
begin
keep := 32767 - dont_keep;
merge.red := (merge.red * keep + mergeClearType.red * dont_keep) div 32767;
merge.green := (merge.green * keep + mergeClearType.green * dont_keep) div 32767;
merge.blue := (merge.blue * keep + mergeClearType.blue * dont_keep) div 32767;
merge.alpha := mergeClearType.alpha + ((not mergeClearType.alpha)*merge.alpha div 65535);
end;
Destination.Colors[x,y] := merge;
end;
end;
procedure TIntfFreeTypeDrawer.ClearTypePixelAt(p: pointer; Cr, Cg, Cb: byte;
const Color: TFPColor);
var merge,mergeClearType: TFPColor;
acc: longword;
keep,dont_keep: word;
begin
Cr := Cr*(color.alpha+1) shr 16;
Cg := Cg*(color.alpha+1) shr 16;
Cb := Cb*(color.alpha+1) shr 16;
acc := Cr+Cg+Cb;
if acc = 0 then exit;
FGetPixelAtProc(p, merge);
mergeClearType.red := (merge.red * (not byte(Cr)) +
color.red * Cr + 128) div 255;
mergeClearType.green := (merge.green * (not byte(Cg)) +
color.green * Cg + 128) div 255;
mergeClearType.blue := (merge.blue * (not byte(Cb)) +
color.blue * Cb + 128) div 255;
mergeClearType.alpha := merge.alpha;
if (mergeClearType.alpha = $ffff) then
FSetPixelAtProc(p, mergeClearType)
else
begin
if Cg <> 0 then
MergeColorOver(merge,color,Cg);
dont_keep := mergeClearType.alpha shr 1;
if dont_keep > 0 then
begin
keep := 32767 - dont_keep;
merge.red := (merge.red * keep + mergeClearType.red * dont_keep) div 32767;
merge.green := (merge.green * keep + mergeClearType.green * dont_keep) div 32767;
merge.blue := (merge.blue * keep + mergeClearType.blue * dont_keep) div 32767;
merge.alpha := mergeClearType.alpha + ((not mergeClearType.alpha)*merge.alpha div 65535);
end;
FSetPixelAtProc(p, merge);
end;
end;
function TIntfFreeTypeDrawer.UnclippedGetPixelAddress(x, y: integer): pointer;
begin
result := pbyte(Destination.GetDataLineStart(y))+(x*FPixelSizeInBytes);
end;
procedure TIntfFreeTypeDrawer.SetDestination(AValue: TLazIntfImage);
var CanBeOptimized: boolean;
RedShiftInBytes,GreenShiftInBytes,BlueShiftInBytes,AlphaShiftInBytes: integer;
begin
if FDestination=AValue then Exit;
FDestination := AValue;
FGetPixelAtProc := nil;
FSetPixelAtProc := nil;
if FDestination = nil then
begin
FWidth := 0;
FHeight := 0;
end else
begin
FWidth := FDestination.Width;
FHeight := FDestination.Height;
with Destination.DataDescription do
CanBeOptimized := (BitsPerPixel and 7 = 0) and
(Format = ricfRGBA) and (RedPrec = 8) and (GreenPrec = 8) and (BluePrec = 8) and
(RedShift and 7 = 0) and (GreenPrec and 7 = 0) and (BluePrec and 7 = 0) and
(((AlphaPrec = 8) and (AlphaShift and 7 = 0)) or (AlphaPrec = 0));
if CanBeOptimized then
begin
FPixelSizeInBytes := Destination.DataDescription.BitsPerPixel div 8;
RedShiftInBytes := Destination.DataDescription.RedShift div 8;
GreenShiftInBytes := Destination.DataDescription.GreenShift div 8;
BlueShiftInBytes := Destination.DataDescription.BlueShift div 8;
AlphaShiftInBytes := Destination.DataDescription.AlphaShift div 8;
if Destination.DataDescription.ByteOrder = riboMSBFirst then
begin
RedShiftInBytes := FPixelSizeInBytes-1 - RedShiftInBytes;
GreenShiftInBytes := FPixelSizeInBytes-1 - GreenShiftInBytes;
BlueShiftInBytes := FPixelSizeInBytes-1 - BlueShiftInBytes;
AlphaShiftInBytes := FPixelSizeInBytes-1 - AlphaShiftInBytes;
end;
if Destination.DataDescription.AlphaPrec = 0 then
begin
if (RedShiftInBytes = 0) and (GreenShiftInBytes = 1) and
(BlueShiftInBytes = 2) then
begin
FGetPixelAtProc := @InternalGetPixelAtWithoutAlphaRGB;
FSetPixelAtProc := @InternalSetPixelAtWithoutAlphaRGB;
end else
if (RedShiftInBytes = 2) and (GreenShiftInBytes = 1) and
(BlueShiftInBytes = 0) then
begin
FGetPixelAtProc := @InternalGetPixelAtWithoutAlphaBGR;
FSetPixelAtProc := @InternalSetPixelAtWithoutAlphaBGR;
end;
end else
begin
if (RedShiftInBytes = 0) and (GreenShiftInBytes = 1) and
(BlueShiftInBytes = 2) then
begin
FGetPixelAtProc := @InternalGetPixelAtWithAlphaRGBA;
FSetPixelAtProc := @InternalSetPixelAtWithAlphaRGBA;
end else
if (RedShiftInBytes = 2) and (GreenShiftInBytes = 1) and
(BlueShiftInBytes = 0) then
begin
FGetPixelAtProc := @InternalGetPixelAtWithAlphaBGRA;
FSetPixelAtProc := @InternalSetPixelAtWithAlphaBGRA;
end;
end;
end;
end;
FHasPixelAtProc := (FGetPixelAtProc<>nil) and (FSetPixelAtProc <> nil);
end;
procedure TIntfFreeTypeDrawer.RenderDirectly( x,y,tx: integer;
data: pointer );
var psrc: pbyte;
c: TFPColor;
pdest: pbyte;
step: longword;
tempValue: byte;
begin
if Destination <> nil then
begin
//ensure rendering in bounds
if (y < 0) or (y >= Destination.height) or (x < 0) or (x > Destination.width-tx) then exit;
c := FColor;
psrc := pbyte(data);
if FHasPixelAtProc then
begin
step := FPixelSizeInBytes;
pdest := UnclippedGetPixelAddress(x,y);
inc(psrc,tx);
while tx > 0 do
begin
tempValue := (psrc-tx)^;
if tempValue <> 0 then
DrawPixelAt(pdest,c,tempValue);
inc(pdest,step);
dec(tx);
end;
end else
while tx > 0 do
begin
tempValue := psrc^;
if tempValue <> 0 then
begin
c.alpha:= FColor.alpha * tempValue div 255;
UnclippedDrawPixel(x,y,c);
end;
inc(psrc);
inc(x);
dec(tx);
end;
end;
end;
procedure TIntfFreeTypeDrawer.RenderDirectlyClearType(x, y, tx: integer; data: pointer);
var xb: integer;
psrc: pbyte;
Cr,Cg,Cb: byte;
pdest: pbyte;
step: longword;
begin
if Destination <> nil then
begin
//ClearType position in third of pixels horizontally (multiple of 3)
x := x div 3;
tx := tx div 3;
//ensure rendering in bounds
if (y < 0) or (y >= Destination.height) or (x < 0) or (x > Destination.width-tx) then exit;
if tx=0 then exit;
psrc := pbyte(data);
Cr := (psrc^ + psrc^ + (psrc+1)^) div 3;
Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
if tx > 1 then
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3
else
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
if FHasPixelAtProc then
begin
step := FPixelSizeInBytes;
pdest := UnclippedGetPixelAddress(x,y);
if Cr+Cg+Cb <> 0 then
ClearTypePixelAt(pdest,Cr,Cg,Cb, FColor);
inc(pdest,step);
inc(psrc,3);
for xb := 1 to tx-2 do
begin
Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3;
if Cr+Cg+Cb <> 0 then
ClearTypePixelAt(pdest,Cr,Cg,Cb, FColor);
inc(pdest,step);
inc(psrc,3);
end;
if tx > 1 then
begin
Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
if Cr+Cg+Cb <> 0 then
ClearTypePixelAt(pdest,Cr,Cg,Cb, FColor);
end;
end else
begin
if Cr+Cg+Cb <> 0 then
UnclippedClearTypePixel(x,y,Cr,Cg,Cb, FColor);
inc(x);
inc(psrc,3);
for xb := 1 to tx-2 do
begin
Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3;
if Cr+Cg+Cb <> 0 then
UnclippedClearTypePixel(x,y,Cr,Cg,Cb, FColor);
inc(x);
inc(psrc,3);
end;
if tx > 1 then
begin
Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
if Cr+Cg+Cb <> 0 then
UnclippedClearTypePixel(x,y,Cr,Cg,Cb, FColor);
end;
end;
end;
end;
procedure TIntfFreeTypeDrawer.InternalMergeColorOver(var merge: TFPColor;
const c: TFPColor; calpha: word);
var
a1f, a2f, a12, a12m: cardinal;
begin
if calpha = 0 then exit;
a12 := 65534 - ((not merge.alpha) * (not calpha) shr 16);
a12m := a12 shr 1;
a1f := merge.alpha * (not calpha) shr 16;
a2f := calpha - (calpha shr 15);
merge.red := (merge.red * a1f + c.red * a2f + a12m) div a12;
merge.green := (merge.green * a1f + c.green * a2f + a12m) div a12;
merge.blue := (merge.blue * a1f + c.blue * a2f + a12m) div a12;
merge.alpha := a12 + (a12 shr 15);
end;
constructor TIntfFreeTypeDrawer.Create(ADestination: TLazIntfImage);
begin
Destination := ADestination;
ClearTypeRGBOrder:= true;
end;
procedure TIntfFreeTypeDrawer.ClippedDrawPixel(x, y: integer; const c: TFPColor
);
begin
if (x < 0) or (y < 0) or (x >= Destination.Width) or (y >= Destination.Height) then exit;
UnclippedDrawPixel(x,y,c);
end;
procedure TIntfFreeTypeDrawer.DrawText(AText: string; AFont: TFreeTypeRenderableFont; x, y: single;
AColor: TFPColor);
begin
FColor := AColor;
if AFont.ClearType then
AFont.RenderText(AText, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectlyClearType)
else
AFont.RenderText(AText, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectly);
end;
procedure TIntfFreeTypeDrawer.DrawGlyph(AGlyph: integer;
AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor);
var f: TFreeTypeFont;
begin
if AFont is TFreeTypeFont then
begin
f := TFreeTypeFont(AFont);
FColor := AColor;
if AFont.ClearType then
f.RenderGlyph(AGlyph, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectlyClearType)
else
f.RenderGlyph(AGlyph, x, y, rect(0,0,Destination.Width,Destination.Height), @RenderDirectly);
end;
end;
destructor TIntfFreeTypeDrawer.Destroy;
begin
inherited Destroy;
end;
end.