mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-04 19:40:20 +02:00
cocoa: implementing lines, polygons and text drawing
git-svn-id: trunk@27253 -
This commit is contained in:
dmitry
parent
4f5b4d81da
commit
fb61563630
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -4748,6 +4748,7 @@ lcl/interfaces/cocoa/cocoagdiobjects.pas svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoaint.pas svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoaobject.inc svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoaprivate.pp svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoatextlayout.pas svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoatrayicon.inc svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoautils.pas svneol=native#text/plain
|
||||
lcl/interfaces/cocoa/cocoawinapi.inc svneol=native#text/plain
|
||||
|
||||
@ -45,25 +45,91 @@ type
|
||||
{ TCocoaBrush }
|
||||
|
||||
TCocoaBrush = class(TCocoaGDIObject)
|
||||
|
||||
R,G,B : Single;
|
||||
procedure Apply(cg: CGContextRef);
|
||||
end;
|
||||
|
||||
{ TCocoaPen }
|
||||
|
||||
TCocoaPen = class(TCocoaGDIObject);
|
||||
TCocoaPen = class(TCocoaGDIObject)
|
||||
public
|
||||
Style : Integer;
|
||||
Width : Integer;
|
||||
R,G,B : Single;
|
||||
procedure Apply(cg: CGContextRef);
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TCocoaFont }
|
||||
|
||||
TCocoaFontStyle = set of (cfs_Bold, cfs_Italic, cfs_Underline, cfs_Strikeout);
|
||||
|
||||
TCocoaFont = class(TCocoaGDIObject)
|
||||
Name : AnsiString;
|
||||
Size : Integer;
|
||||
Style : TCocoaFontStyle;
|
||||
R,G,B : Single;
|
||||
Antialiased: Boolean;
|
||||
end;
|
||||
|
||||
{ TCocoaBitmap }
|
||||
|
||||
TCocoaBitmap = class(TCocoaGDIObject);
|
||||
|
||||
{ TCocoaTextLayout }
|
||||
|
||||
TCocoaTextLayout = class(TObject)
|
||||
public
|
||||
constructor Create; virtual;
|
||||
procedure SetFont(AFont: TCocoaFont); virtual; abstract;
|
||||
procedure SetText(UTF8Text: PChar; ByteSize: Integer); virtual; abstract;
|
||||
function GetSize: TSize; virtual; abstract;
|
||||
|
||||
procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger; DXCount: Integer); virtual; abstract;
|
||||
end;
|
||||
TCocoaTextLayoutClass = class of TCocoaTextLayout;
|
||||
|
||||
{ TCocoaContext }
|
||||
|
||||
TCocoaContext = class(TObject)
|
||||
private
|
||||
fText : TCocoaTextLayout;
|
||||
fBrush : TCocoaBrush;
|
||||
fPen : TCocoaPen;
|
||||
fFont : TCocoaFont;
|
||||
fRegion : TCocoaRegion;
|
||||
fBitmap : TCocoaBitmap;
|
||||
procedure SetBitmap(const AValue: TCocoaBitmap);
|
||||
procedure SetBrush(const AValue: TCocoaBrush);
|
||||
procedure SetFont(const AValue: TCocoaFont);
|
||||
procedure SetPen(const AValue: TCocoaPen);
|
||||
procedure SetRegion(const AValue: TCocoaRegion);
|
||||
protected
|
||||
ContextSize : TSize;
|
||||
public
|
||||
ctx : NSGraphicsContext;
|
||||
PenPos : TPoint;
|
||||
ctx : NSGraphicsContext;
|
||||
PenPos : TPoint;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function InitDraw(width, height: Integer): Boolean;
|
||||
procedure MoveTo(x,y: Integer);
|
||||
procedure LineTo(x,y: Integer);
|
||||
procedure Polygon(const Points: array of TPoint; NumPts: Integer; Winding: boolean);
|
||||
procedure Polyline(const Points: array of TPoint; NumPts: Integer);
|
||||
procedure Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
|
||||
procedure Ellipse(X1, Y1, X2, Y2: Integer);
|
||||
procedure TextOut(X,Y: Integer; UTF8Chars: PChar; Count: Integer; CharsDelta: PInteger);
|
||||
function CGContext: CGContextRef; virtual;
|
||||
property Brush: TCocoaBrush read fBrush write SetBrush;
|
||||
property Pen: TCocoaPen read fPen write SetPen;
|
||||
property Font: TCocoaFont read fFont write SetFont;
|
||||
property Region: TCocoaRegion read fRegion write SetRegion;
|
||||
property Bitmap: TCocoaBitmap read fBitmap write SetBitmap;
|
||||
end;
|
||||
|
||||
var
|
||||
TextLayoutClass : TCocoaTextLayoutClass = nil;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCocoaContext }
|
||||
@ -73,6 +139,44 @@ begin
|
||||
Result:=CGContextRef(ctx.graphicsPort);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.SetBitmap(const AValue: TCocoaBitmap);
|
||||
begin
|
||||
fBitmap:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.SetBrush(const AValue: TCocoaBrush);
|
||||
begin
|
||||
fBrush:=AValue;
|
||||
if Assigned(fBrush) then fBrush.Apply(CGContext);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.SetFont(const AValue: TCocoaFont);
|
||||
begin
|
||||
fFont:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.SetPen(const AValue: TCocoaPen);
|
||||
begin
|
||||
fPen:=AValue;
|
||||
if Assigned(fPen) then fPen.Apply(CGContext);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.SetRegion(const AValue: TCocoaRegion);
|
||||
begin
|
||||
fRegion:=AValue;
|
||||
end;
|
||||
|
||||
constructor TCocoaContext.Create;
|
||||
begin
|
||||
fText:=TextLayoutClass.Create;
|
||||
end;
|
||||
|
||||
destructor TCocoaContext.Destroy;
|
||||
begin
|
||||
fText.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TCocoaContext.InitDraw(width,height:Integer): Boolean;
|
||||
var
|
||||
cg : CGContextRef;
|
||||
@ -81,6 +185,9 @@ begin
|
||||
Result:=Assigned(cg);
|
||||
if not Result then Exit;
|
||||
|
||||
ContextSize.cx:=width;
|
||||
ContextSize.cy:=height;
|
||||
|
||||
CGContextTranslateCTM(cg, 0, height);
|
||||
CGContextScaleCTM(cg, 1, -1);
|
||||
PenPos.x:=0;
|
||||
@ -138,6 +245,7 @@ begin
|
||||
p[1].x:=tx;
|
||||
p[1].y:=ty;
|
||||
|
||||
CGContextBeginPath(cg);
|
||||
CGContextAddLines(cg, @p, 2);
|
||||
CGContextStrokePath(cg);
|
||||
|
||||
@ -145,6 +253,119 @@ begin
|
||||
PenPos.y := Y;
|
||||
end;
|
||||
|
||||
procedure CGContextAddLCLPoints(cg: CGContextRef; const Points: array of TPoint;NumPts:Integer);
|
||||
var
|
||||
cp : array of CGPoint;
|
||||
i : Integer;
|
||||
begin
|
||||
SetLength(cp, NumPts);
|
||||
for i:=0 to NumPts-1 do begin
|
||||
cp[i].x:=Points[i].X+0.5;
|
||||
cp[i].y:=Points[i].Y+0.5;
|
||||
end;
|
||||
CGContextAddLines(cg, @cp[0], NumPts);
|
||||
end;
|
||||
|
||||
procedure CGContextAddLCLRect(cg: CGContextRef; x1, y1, x2, y2: Integer); overload;
|
||||
var
|
||||
r : CGRect;
|
||||
begin
|
||||
r.origin.x:=x1+0.5;
|
||||
r.origin.y:=y1+0.5;
|
||||
r.size.width:=x2-x1-1;
|
||||
r.size.height:=y2-y1-1;
|
||||
CGContextAddRect(cg, r);
|
||||
end;
|
||||
|
||||
procedure CGContextAddLCLRect(cg: CGContextRef; const R: TRect); overload;
|
||||
begin
|
||||
CGContextAddLCLRect(cg, r.Left, r.Top, r.Right, r.Bottom);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.Polygon(const Points:array of TPoint;NumPts:Integer;
|
||||
Winding:boolean);
|
||||
var
|
||||
cg : CGContextRef;
|
||||
begin
|
||||
cg:=CGContext;
|
||||
if not Assigned(cg) or (NumPts<=0) then Exit;
|
||||
|
||||
CGContextBeginPath(cg);
|
||||
CGContextAddLCLPoints(cg, Points, NumPts);
|
||||
CGContextClosePath(cg);
|
||||
|
||||
if Winding then
|
||||
CGContextDrawPath(cg, kCGPathFillStroke)
|
||||
else
|
||||
CGContextDrawPath(cg, kCGPathEOFillStroke);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.Polyline(const Points: array of TPoint; NumPts: Integer);
|
||||
var
|
||||
cg : CGContextRef;
|
||||
begin
|
||||
cg:=CGContext;
|
||||
if not Assigned(cg) or (NumPts<=0) then Exit;
|
||||
|
||||
CGContextBeginPath(cg);
|
||||
CGContextAddLCLPoints(cg, Points, NumPts);
|
||||
CGContextStrokePath(cg);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.Rectangle(X1,Y1,X2,Y2:Integer;FillRect:Boolean; UseBrush: TCocoaBrush);
|
||||
var
|
||||
cg : CGContextRef;
|
||||
begin
|
||||
cg:=CGContext;
|
||||
if not Assigned(cg) then Exit;
|
||||
|
||||
CGContextBeginPath(cg);
|
||||
CGContextAddLCLRect(cg, X1,Y1,X2,Y2);
|
||||
if FillRect then begin
|
||||
//using the brush
|
||||
if Assigned(UseBrush) then UseBrush.Apply(cg);
|
||||
CGContextFillPath(cg);
|
||||
//restore the brush
|
||||
if Assigned(UseBrush) and Assigned(fBrush) then fBrush.Apply(cg);
|
||||
end else
|
||||
CGContextStrokePath(cg);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.Ellipse(X1,Y1,X2,Y2:Integer);
|
||||
var
|
||||
cg : CGContextRef;
|
||||
r : CGRect;
|
||||
begin
|
||||
cg:=CGContext;
|
||||
if not Assigned(cg) then Exit;
|
||||
r.origin.x:=x1+0.5;
|
||||
r.origin.y:=y1+0.5;
|
||||
r.size.width:=x2-x1-1;
|
||||
r.size.height:=y2-y1-1;
|
||||
CGContextBeginPath(CGContext);
|
||||
CGContextAddEllipseInRect(CGContext, R);
|
||||
CGContextDrawPath(CGContext, kCGPathFillStroke);
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.TextOut(X,Y:Integer;UTF8Chars:PChar;Count:Integer;
|
||||
CharsDelta:PInteger);
|
||||
var
|
||||
cg : CGContextRef;
|
||||
transf : CGAffineTransform;
|
||||
begin
|
||||
cg:=CGContext;
|
||||
if not Assigned(cg) then Exit;
|
||||
|
||||
CGContextScaleCTM(cg, 1, -1);
|
||||
CGContextTranslateCTM(cg, 0, -ContextSize.cy);
|
||||
|
||||
fText.SetText(UTF8Chars, Count);
|
||||
fText.Draw(cg, X, ContextSize.cy-Y, CharsDelta, Count);
|
||||
|
||||
CGContextTranslateCTM(cg, 0, ContextSize.cy);
|
||||
CGContextScaleCTM(cg, 1, -1);
|
||||
end;
|
||||
|
||||
|
||||
{ TCocoaRegion }
|
||||
|
||||
@ -315,6 +536,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCocoaRegion.Apply(cg: CGContextRef);
|
||||
begin
|
||||
exit;
|
||||
if not Assigned(cg) then Exit;
|
||||
if HIShapeIsEmpty(FShape) or (HIShapeReplacePathInCGContext(FShape, cg)<>noErr) then
|
||||
Exit;
|
||||
@ -409,5 +631,34 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TCocoaPen }
|
||||
|
||||
procedure TCocoaPen.Apply(cg:CGContextRef);
|
||||
begin
|
||||
if not Assigned(cg) then Exit;
|
||||
CGContextSetRGBStrokeColor(cg, r, g, b, 1);
|
||||
CGContextSetLineWidth(cg, Width);
|
||||
//todo: style
|
||||
end;
|
||||
|
||||
constructor TCocoaPen.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Width:=1;
|
||||
end;
|
||||
|
||||
{ TCocoaBrush }
|
||||
|
||||
procedure TCocoaBrush.Apply(cg:CGContextRef);
|
||||
begin
|
||||
CGContextSetRGBFillColor(cg, R,G,B, 1);
|
||||
end;
|
||||
|
||||
{ TCocoaTextLayout }
|
||||
|
||||
constructor TCocoaTextLayout.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -37,7 +37,7 @@ uses
|
||||
// interfacebase
|
||||
InterfaceBase, GraphType,
|
||||
// private
|
||||
CocoaAll, CocoaPrivate, CocoaUtils, CocoaGDIObjects,
|
||||
CocoaAll, CocoaPrivate, CocoaUtils, CocoaGDIObjects, CocoaTextLayout,
|
||||
// LCL
|
||||
LCLStrConsts, LMessages, LCLMessageGlue, LCLProc, LCLIntf, LCLType,
|
||||
CocoaWSFactory;
|
||||
@ -106,12 +106,18 @@ var
|
||||
|
||||
implementation
|
||||
|
||||
//todo: a better check!
|
||||
|
||||
function CheckDC(dc: HDC): TCocoaContext;
|
||||
begin
|
||||
//todo: a better check!
|
||||
Result:=TCocoaContext(dc);
|
||||
end;
|
||||
|
||||
function CheckGDIOBJ(obj: HGDIOBJ): TCocoaGDIObject;
|
||||
begin
|
||||
Result:=TCocoaGDIObject(obj);
|
||||
end;
|
||||
|
||||
|
||||
// the implementation of the winapi compatibility methods
|
||||
{$I cocoawinapi.inc}
|
||||
|
||||
218
lcl/interfaces/cocoa/cocoatextlayout.pas
Normal file
218
lcl/interfaces/cocoa/cocoatextlayout.pas
Normal file
@ -0,0 +1,218 @@
|
||||
unit CocoaTextLayout;
|
||||
|
||||
interface
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
MacOSAll, CocoaAll,
|
||||
Types, SysUtils, LCLType, CocoaGDIObjects;
|
||||
|
||||
type
|
||||
{ TASTUITextLayout }
|
||||
|
||||
// legacy layout used for Mac OS X 10.4
|
||||
TASTUITextLayout = class(TCocoaTextLayout)
|
||||
private
|
||||
fBuffer : WideString;
|
||||
fUTF8 : String;
|
||||
FLayout : ATSUTextLayout;
|
||||
FStyle : ATSUStyle;
|
||||
|
||||
FTextBefore : ATSUTextMeasurement;
|
||||
FTextAfter : ATSUTextMeasurement;
|
||||
FAscent : ATSUTextMeasurement;
|
||||
FDescent : ATSUTextMeasurement;
|
||||
|
||||
FValidSize : Boolean;
|
||||
procedure RecountSize;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
procedure SetFont(AFont: TCocoaFont); override;
|
||||
procedure SetText(UTF8Text: PChar; ByteSize: Integer); override;
|
||||
function GetSize: TSize; override;
|
||||
procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger; DXCount: Integer); override;
|
||||
end;
|
||||
|
||||
{ TCoreTextLayout }
|
||||
|
||||
//todo: use CoreText for newer OSes
|
||||
//TCoreTextLayout = class(TCocoaTextLayout);
|
||||
|
||||
implementation
|
||||
|
||||
{ TASTUITextLayout }
|
||||
|
||||
function IntToFix(i: integer): Integer; inline;
|
||||
begin
|
||||
Result:=i shl 16;
|
||||
end;
|
||||
|
||||
function FixToInt(f: Integer): Integer; inline;
|
||||
begin
|
||||
Result:=Round(Fix2X(F));
|
||||
end;
|
||||
|
||||
procedure TASTUITextLayout.RecountSize;
|
||||
begin
|
||||
ATSUGetUnjustifiedBounds(FLayout, kATSUFromTextBeginning, kATSUToTextEnd,
|
||||
FTextBefore, FTextAfter, FAscent, FDescent);
|
||||
end;
|
||||
|
||||
constructor TASTUITextLayout.Create;
|
||||
begin
|
||||
// create text layout
|
||||
ATSUCreateTextLayout(FLayout);
|
||||
SetText(#0, 1);
|
||||
ATSUSetTextLayoutRefCon(FLayout, URefCon(Self));
|
||||
|
||||
ATSUCreateStyle(FStyle);
|
||||
|
||||
// allow font substitution for exotic glyphs
|
||||
ATSUSetTransientFontMatching(FLayout, True);
|
||||
end;
|
||||
|
||||
destructor TASTUITextLayout.Destroy;
|
||||
begin
|
||||
ATSUDisposeTextLayout(FLayout);
|
||||
ATSUDisposeStyle(FStyle);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
const
|
||||
DefaultFont = 'Lucida Grande';
|
||||
DefaultSize = 13;
|
||||
|
||||
function FindATSUFontID(const FontName: String): ATSUFontID;
|
||||
var
|
||||
fn : String;
|
||||
begin
|
||||
Result := 0;
|
||||
if CompareText(FontName, 'default')=0 then fn:=DefaultFont else fn:=FontName;
|
||||
if (fn <> '') then
|
||||
ATSUFindFontFromName(@fn[1], Length(fn),
|
||||
kFontFullName, kFontMacintoshPlatform, kFontRomanScript,
|
||||
kFontEnglishLanguage, Result);
|
||||
end;
|
||||
|
||||
procedure TASTUITextLayout.SetFont(AFont:TCocoaFont);
|
||||
var
|
||||
Attr: ATSUAttributeTag;
|
||||
M: ATSUTextMeasurement;
|
||||
O: ATSStyleRenderingOptions;
|
||||
B: Boolean;
|
||||
S: ByteCount;
|
||||
A: ATSUAttributeValuePtr;
|
||||
ID: ATSUFontID;
|
||||
const
|
||||
ATSStyleRenderingOption: array [Boolean] of ATSStyleRenderingOptions =
|
||||
(kATSStyleNoAntiAliasing, kATSStyleApplyAntiAliasing);
|
||||
begin
|
||||
if not Assigned(AFont) then Exit;
|
||||
|
||||
ID := FindATSUFontID(AFont.Name);
|
||||
|
||||
if ID <> 0 then
|
||||
begin
|
||||
Attr := kATSUFontTag;
|
||||
A := @ID;
|
||||
S := SizeOf(ID);
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
end;
|
||||
|
||||
Attr := kATSUSizeTag;
|
||||
M := IntToFix(Abs(AFont.Size));
|
||||
A := @M;
|
||||
S := SizeOf(M);
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
|
||||
S := SizeOf(B);
|
||||
Attr := kATSUQDBoldfaceTag;
|
||||
B := cfs_Bold in AFont.Style;
|
||||
A := @B;
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
|
||||
Attr := kATSUQDItalicTag;
|
||||
B := cfs_Italic in AFont.Style;
|
||||
A := @B;
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
|
||||
Attr := kATSUQDUnderlineTag;
|
||||
B := cfs_Underline in AFont.Style;
|
||||
A := @B;
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
|
||||
Attr := kATSUStyleStrikeThroughTag;
|
||||
B := cfs_Strikeout in AFont.Style;
|
||||
A := @B;
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
|
||||
Attr := kATSUStyleRenderingOptionsTag;
|
||||
O := ATSStyleRenderingOption[AFont.Antialiased];
|
||||
A := @O;
|
||||
S := SizeOf(O);
|
||||
ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
|
||||
|
||||
FValidSize:=False;
|
||||
end;
|
||||
|
||||
procedure TASTUITextLayout.SetText(UTF8Text: PChar; ByteSize: Integer);
|
||||
begin
|
||||
if (ByteSize=length(fUTF8)) and (fUTF8<>'') and
|
||||
(CompareChar(UTF8Text^, fUTF8[1], ByteSize)=0) then Exit; // same buffer, nothing to change!
|
||||
|
||||
SetLength(fUTF8, ByteSize);
|
||||
if ByteSize>0 then
|
||||
System.Move(UTF8Text^, fUTF8[1], ByteSize)
|
||||
else
|
||||
fUTF8:='';
|
||||
|
||||
fBuffer:=UTF8Decode(fUTF8);
|
||||
if fBuffer='' then fBuffer:=#0;
|
||||
ATSUSetTextPointerLocation(FLayout, @fBuffer[1], 0, length(fBuffer), length(fBuffer));
|
||||
ATSUSetRunStyle(FLayout, FStyle, kATSUFromTextBeginning, kATSUToTextEnd);
|
||||
|
||||
FValidSize:=False;
|
||||
end;
|
||||
|
||||
function TASTUITextLayout.GetSize:TSize;
|
||||
begin
|
||||
if not FValidSize then RecountSize;
|
||||
Result.cx := FixToInt(FTextAfter - FTextBefore);
|
||||
Result.cy := FixToInt(FDescent + FAscent);
|
||||
end;
|
||||
|
||||
procedure TASTUITextLayout.Draw(cg:CGContextRef;X,Y:Integer;DX:PInteger;DXCount: Integer);
|
||||
var
|
||||
MX, MY : Integer;
|
||||
|
||||
Tag : ATSUAttributeTag;
|
||||
DataSize : ByteCount;
|
||||
PValue : ATSUAttributeValuePtr;
|
||||
begin
|
||||
if not Assigned(cg) then Exit;
|
||||
if not FValidSize then RecountSize;
|
||||
|
||||
MX:=0;
|
||||
MY:=0;
|
||||
Tag := kATSUCGContextTag;
|
||||
DataSize := sizeOf(CGContextRef);
|
||||
PValue := @cg;
|
||||
ATSUSetLayoutControls(FLayout, 1, @Tag, @DataSize, @PValue);
|
||||
|
||||
ATSUDrawText(FLayout, kATSUFromTextBeginning, kATSUToTextEnd,
|
||||
IntToFix(X)- FTextBefore + MX, IntToFix(Y) - FAscent + MY);
|
||||
end;
|
||||
|
||||
|
||||
procedure InitTextLayout;
|
||||
begin
|
||||
if not Assigned(TextLayoutClass) then
|
||||
TextLayoutClass:=TASTUITextLayout;
|
||||
end;
|
||||
|
||||
initialization
|
||||
InitTextLayout;
|
||||
|
||||
end.
|
||||
@ -39,7 +39,7 @@
|
||||
function TCocoaWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
|
||||
begin
|
||||
{$ifdef VerboseCocoaWinAPI}
|
||||
WriteLn('[WinAPI ShowWindow]');
|
||||
DebugLn('TCocoaWidgetSet.ShowWindow');
|
||||
{$endif}
|
||||
|
||||
case nCmdShow of
|
||||
@ -73,6 +73,13 @@ begin
|
||||
{todo: GetNSViewFrame(NSView(Handle), ARect)};
|
||||
end;
|
||||
|
||||
{--------------------------------- DRAWING ------------------------------------}
|
||||
|
||||
|
||||
type
|
||||
TPointArray = array [word] of TPoint;
|
||||
PPointArray = ^TPointArray;
|
||||
|
||||
function TCocoaWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
@ -81,7 +88,7 @@ begin
|
||||
Result:=Assigned(ctx);
|
||||
if not Result then Exit;
|
||||
|
||||
ctx.MoveTo(x,y);
|
||||
ctx.LineTo(x,y);
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
|
||||
@ -93,10 +100,68 @@ begin
|
||||
if not Result then Exit;
|
||||
|
||||
if Assigned(OldPoint) then OldPoint^:=ctx.PenPos;
|
||||
ctx.LineTo(x,y);
|
||||
ctx.MoveTo(x,y);
|
||||
end;
|
||||
|
||||
{-------------------------- REGION ROUTINES -----------------------------------}
|
||||
function TCocoaWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
begin
|
||||
ctx:=CheckDC(DC);
|
||||
Result:=Assigned(ctx) and Assigned(Points) and (NumPts>=2);
|
||||
if not Result then Exit;
|
||||
|
||||
ctx.Polygon(PPointArray(Points)^, NumPts, Winding);
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
begin
|
||||
ctx:=CheckDC(DC);
|
||||
Result:=Assigned(ctx) and Assigned(Points) and (NumPts>0);
|
||||
if not Result then Exit;
|
||||
|
||||
ctx.Polyline(PPointArray(Points)^, NumPts);
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
begin
|
||||
ctx:=CheckDC(DC);
|
||||
Result:=Assigned(ctx);
|
||||
if not Result then Exit;
|
||||
ctx.Rectangle(X1, Y1, X2, Y2, False, nil);
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
br : TCocoaGDIObject;
|
||||
begin
|
||||
ctx:=CheckDC(DC);
|
||||
br:=CheckGDIOBJ(Brush);
|
||||
Result:=Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
|
||||
if not Result then Exit;
|
||||
with Rect do
|
||||
ctx.Rectangle(Left, Top, Right, Bottom, True, TCocoaBrush(br));
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
begin
|
||||
ctx:=CheckDC(DC);
|
||||
Result:=Assigned(ctx);
|
||||
if not Result then Exit;
|
||||
ctx.Ellipse(x1, y1, x2, y2);
|
||||
end;
|
||||
|
||||
{----------------------------------- REGION -----------------------------------}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: CreatePolygonRgn
|
||||
@ -111,7 +176,7 @@ function TCocoaWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
|
||||
FillMode: integer): HRGN;
|
||||
begin
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.CreatePolygonRgn NumPts: ' + DbgS(NumPts) +
|
||||
DebugLn('TCocoaWidgetSet.CreatePolygonRgn NumPts: ' + DbgS(NumPts) +
|
||||
' FillMode: ' + DbgS(FillMode));
|
||||
{$ENDIF}
|
||||
|
||||
@ -146,7 +211,7 @@ end;
|
||||
function TCocoaWidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
|
||||
begin
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.CreateRectRgn R: ' + DbgS(Classes.Rect(X1, Y1, X2, Y2)));
|
||||
DebugLn('TCocoaWidgetSet.CreateRectRgn R: ' + DbgS(Classes.Rect(X1, Y1, X2, Y2)));
|
||||
{$ENDIF}
|
||||
|
||||
Result := HRGN(TCocoaRegion.Create(X1, Y1, X2, Y2));
|
||||
@ -157,5 +222,117 @@ end;
|
||||
//begin
|
||||
//end;
|
||||
|
||||
{---------------------------- PEN AND BRUSH -----------------------------------}
|
||||
|
||||
function TCocoaWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
|
||||
var
|
||||
p : TCocoaPen;
|
||||
cl : DWORD;
|
||||
begin
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCocoaWidgetSet.CreatePenIndirect');
|
||||
{$ENDIF}
|
||||
p:=TCocoaPen.Create;
|
||||
if LogPen.lopnWidth.x>0 then p.Width:=LogPen.lopnWidth.x;
|
||||
p.Style:=LogPen.lopnStyle;
|
||||
if LogPen.lopnColor and $8000000 > 0 then cl:=GetSysColor(LogPen.lopnColor)
|
||||
else cl:=LogPen.lopnColor;
|
||||
//todo:!
|
||||
p.R:=(cl and $FF) / $FF;
|
||||
p.G:=((cl shr 8) and $FF) / $FF;
|
||||
p.B:=((cl shr 16) and $FF) / $FF;
|
||||
Result := HPEN(p);//TCocoaPen.Create(LogPen));
|
||||
end;
|
||||
|
||||
{------------------------------- DEVICE CONTEXT -------------------------------}
|
||||
|
||||
function TCocoaWidgetSet.SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
|
||||
var
|
||||
dc: TCocoaContext;
|
||||
gdi: TCocoaGDIObject;
|
||||
const
|
||||
SName = 'TCarbonWidgetSet.SelectObject';
|
||||
begin
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCocoaWidgetSet.SelectObject DC: ' + DbgS(DC) + ' GDIObj: ' + DbgS(GDIObj));
|
||||
{$ENDIF}
|
||||
Result := 0;
|
||||
|
||||
dc:=CheckDC(ADC);
|
||||
gdi:=CheckGDIOBJ(GDIObj);
|
||||
if not Assigned(dc) then Exit;
|
||||
|
||||
if gdi is TCocoaBrush then begin // select brush
|
||||
Result := HBRUSH(dc.Brush);
|
||||
dc.Brush := TCocoaBrush(gdi);
|
||||
end else if gdi is TCocoaPen then begin // select pen
|
||||
Result := HPEN(dc.Pen);
|
||||
dc.Pen := TCocoaPen(gdi);
|
||||
end else if gdi is TCocoaFont then begin // select font
|
||||
Result := HFONT(dc.Font);
|
||||
dc.Font := TCocoaFont(gdi);
|
||||
end else if gdi is TCocoaRegion then begin // select region
|
||||
Result := HBRUSH(dc.Region);
|
||||
dc.Region := TCocoaRegion(gdi);
|
||||
end else if gdi is TCocoaBitmap then begin // select bitmap
|
||||
{if not (ADC is TCarbonBitmapContext) then
|
||||
begin
|
||||
DebugLn(SName + ' Error - The specified device context is not bitmap context!');
|
||||
Exit;
|
||||
end;}
|
||||
Result := HBITMAP(dc.Bitmap);
|
||||
dc.Bitmap:=TCocoaBitmap(gdi);
|
||||
//TCarbonBitmapContext(ADC).Bitmap := TCarbonBitmap(GDIObj);
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCocoaWidgetSet.SelectObject Result: ' + DbgS(Result));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.RectVisible(DC: HDC; const ARect: TRect): Boolean;
|
||||
var
|
||||
ClipBox: CGRect;
|
||||
ctx : TCocoaContext;
|
||||
R: TRect;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.RectVisible DC: ' + DbgS(DC) + ' R: ' + DbgS(ARect));
|
||||
{$ENDIF}
|
||||
|
||||
ctx:=CheckDC(DC);
|
||||
if not Assigned(ctx) or (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then Exit;
|
||||
|
||||
// In Quartz 2D there is no direct access to clipping path of CGContext,
|
||||
// therefore we can only test bounding box of the clipping path.
|
||||
|
||||
ClipBox := CGContextGetClipBoundingBox(ctx.CGContext);
|
||||
Result := IntersectRect(R, ARect, CGRectToRect(ClipBox));
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.RectVisible Result: ' + DbgS(Result) + ' Clip: ' + DbgS(CGRectToRect(ClipBox)));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------ TEXT ------------------------------------}
|
||||
|
||||
function TCocoaWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
|
||||
var
|
||||
ctx : TCocoaContext;
|
||||
begin
|
||||
ctx:=CheckDC(DC);
|
||||
Result:=Assigned(ctx);
|
||||
if not Assigned(ctx) then Exit;
|
||||
|
||||
ctx.TextOut(X,Y, Str, Count, Dx);
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
|
||||
begin
|
||||
Result:=ExtTextOut(DC, X, Y, 0, nil, Str, Count, nil);
|
||||
end;
|
||||
|
||||
|
||||
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
|
||||
|
||||
@ -57,8 +57,8 @@ function CreateCompatibleDC(DC: HDC): HDC; override;
|
||||
function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;
|
||||
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
|
||||
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
|
||||
function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
|
||||
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;}
|
||||
function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;}
|
||||
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
|
||||
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
|
||||
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
|
||||
{
|
||||
@ -70,20 +70,20 @@ function DestroyIcon(Handle: HICON): Boolean; override;
|
||||
function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; override;
|
||||
function DrawFocusRect(DC: HDC; const Rect: TRect): boolean; override;
|
||||
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
|
||||
function DrawText(DC: HDC; Str: PChar; Count: Integer; var ARect: TRect; Flags: Cardinal): Integer; override;
|
||||
function DrawText(DC: HDC; Str: PChar; Count: Integer; var ARect: TRect; Flags: Cardinal): Integer; override;}
|
||||
|
||||
function Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; override;
|
||||
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;
|
||||
{function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;
|
||||
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
|
||||
function EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; override;
|
||||
procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
|
||||
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
|
||||
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
|
||||
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;
|
||||
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;}
|
||||
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
|
||||
|
||||
function FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; override;
|
||||
function FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; override;
|
||||
{function FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; override;
|
||||
function Frame(DC: HDC; const ARect: TRect): Integer; override;
|
||||
function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TBevelCut): Boolean; override;
|
||||
function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; override;
|
||||
@ -142,23 +142,23 @@ function LineTo(DC: HDC; X, Y: Integer): Boolean; override;
|
||||
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
|
||||
|
||||
{function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; override;
|
||||
function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuous: boolean): boolean; override;
|
||||
function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuous: boolean): boolean; override;}
|
||||
function Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean; override;
|
||||
function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean; override;
|
||||
function PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; lParam: LParam): Boolean; override;
|
||||
{function PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; lParam: LParam): Boolean; override;}
|
||||
|
||||
function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; override;
|
||||
function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
|
||||
function ReleaseCapture : Boolean; override;
|
||||
{function ReleaseCapture : Boolean; override;
|
||||
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;
|
||||
function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
|
||||
function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; override;
|
||||
|
||||
function SaveDC(DC: HDC): Integer; override;
|
||||
function ScreenToClient(Handle : HWND; var P : TPoint) : Integer; override;
|
||||
function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;
|
||||
function SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; override;
|
||||
function SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; override;
|
||||
function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;}
|
||||
function SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; override;
|
||||
{function SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; override;
|
||||
function SetActiveWindow(Handle: HWND): HWND; override;
|
||||
function SetBKColor(DC: HDC; Color: TColorRef): TColorRef; override;
|
||||
function SetBkMode(DC: HDC; bkMode : Integer) : Integer; override;
|
||||
@ -182,10 +182,10 @@ function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
|
||||
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
|
||||
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
|
||||
XMask, YMask: Integer; Rop: DWORD): Boolean; override;
|
||||
function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
|
||||
function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;}
|
||||
|
||||
function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
|
||||
function UpdateWindow(Handle: HWND): Boolean; override;
|
||||
{function UpdateWindow(Handle: HWND): Boolean; override;
|
||||
function WindowFromPoint(Point: TPoint): HWND; override;}
|
||||
|
||||
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
|
||||
|
||||
@ -286,7 +286,6 @@ begin
|
||||
|
||||
{todo:}
|
||||
GetViewFrame( NSWindow(AWinControl.Handle).contentView, ARect );
|
||||
writeln('GetClientRect ... ', ARect.Left, ' ',ARect.Top);
|
||||
end;
|
||||
|
||||
class procedure TCocoaWSCustomForm.SetBounds(const AWinControl: TWinControl;
|
||||
@ -298,7 +297,6 @@ begin
|
||||
{todo: setFrame_display(, true)? }
|
||||
sf:=NSScreen.mainScreen.frame;
|
||||
|
||||
writeln('SetBounds: ', ALeft, ' ',ATop, ' ',AWidth,' ',AHeight);
|
||||
LCLToCocoaRect( GetNSRect(ALeft,ATop,AWidth,AHeight), sf, wf);
|
||||
|
||||
NSWindow(AWinControl.Handle).setFrame_display(wf, false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user